"{ Package: 'stx:goodies/xmlsuite/relaxng' }"

"{ NameSpace: RNG }"

Pattern subclass:#ListPattern
	instanceVariableNames:'itemPatterns repeat'
	classVariableNames:''
	poolDictionaries:''
	category:'Relax NG-Patterns'
!


!ListPattern methodsFor:'accessing'!

charactersFromObject:aCollection 

    | s |
    s := String new writeStream.

    self patternsAndObjects:aCollection
        do:[:pattern :object|
            s nextPutAll:(pattern charactersFromObject:object); space.
        ].
    ^s contents trimSeparators.

    "Created: / 16-05-2005 / 13:41:52 / masca"
!

name
    ^'#pcdata'

    "Created: / 14-05-2005 / 18:26:57 / janfrog"
    "Modified: / 19-05-2005 / 09:57:26 / masca"
!

objectFromCharacters:aString 
    |s|

    s := Set new.
    self patternsAndObjects:aString asArrayOfSubstrings
        do:[:pattern :string | s add:(pattern objectFromCharacters:string) ].
    ^ s

    "Created: / 14-05-2005 / 18:27:14 / janfrog"
    "Modified: / 14-05-2005 / 22:15:13 / janfrog"
    "Modified: / 16-05-2005 / 13:42:27 / masca"
! !

!ListPattern methodsFor:'initialization'!

postParseFor:aSchema

    itemPatterns := self node firstChild isRepeatingNode
        ifTrue:[
            repeat := true.
            self node firstChild children collect:[:c|c pattern]]
        ifFalse:[
            repeat := false.
            self node children collect:[:c|c pattern]]

    "Created: / 14-05-2005 / 21:26:26 / janfrog"
! !

!ListPattern methodsFor:'printing'!

nameForPrint

    ^'#pcdata:list'

    "Created: / 19-05-2005 / 09:55:30 / masca"
! !

!ListPattern methodsFor:'private'!

patternsAndObjects:strings do:block 
    |idx|

    idx := 0.
    strings do:[:str | 
        (idx := idx + 1) = (itemPatterns size + 1) ifTrue:[
            self error:'No more patterns'
        ].
        block value:(itemPatterns at:idx) value:str.
        (repeat and:[ idx = itemPatterns size ]) ifTrue:[
            idx := 0
        ].
    ].
    repeat ifTrue:[
        idx = 0 ifFalse:[
            self error:'Not enough items'
        ]
    ] ifFalse:[
        idx = itemPatterns size ifFalse:[
            self error:'Not enough items'
        ]
    ]

    "Created: / 16-05-2005 / 13:42:27 / masca"
! !

!ListPattern methodsFor:'testing'!

isListPattern
    ^ true

    "Created: / 14-05-2005 / 20:34:31 / janfrog"
!

isPCDataPattern

    ^true

    "Created: / 14-05-2005 / 18:27:29 / janfrog"
! !

!ListPattern methodsFor:'validation support'!

validate:aString for:validator 
    |idx strings|

    idx := 1.
    strings := aString asArrayOfSubstrings.
    (strings isEmpty and:[ self node firstChild isOneOrMoreNode ]) ifTrue:[
        ^ validator validationError:'Empty list'
    ].
    [
        self patternsAndObjects:strings
            do:[:pattern :string | 
                pattern validate:string for:validator.
                idx := idx + 1.
            ]
    ] on:Smalltalk::Error
            do:[:ex | 
        validator 
            validationError:'Cannot validate list item ' , idx printString , ': ' 
                    , ex errorString.
        ^ false
    ].
    ^ true

    "Created: / 14-05-2005 / 18:27:34 / janfrog"
    "Modified: / 14-05-2005 / 22:10:57 / janfrog"
    "Modified: / 16-05-2005 / 13:42:27 / masca"
! !

!ListPattern class methodsFor:'documentation'!

version
    ^ '$Header: /opt/data/cvs/stx/goodies/xmlsuite/relaxng/RNG__ListPattern.st,v 1.1.1.1 2005-11-01 22:07:13 vranyj1 Exp $'
! !