'From Squeak2.9alpha of 13 June 2000 [latest update: #2774] on 24 October 2000 at 5:16:56 pm'! "Change Set: XML Date: 24 October 2000 Author: Duane Maxwell, Andres Valloud/exobox XML Parser & associated utilities Submitted by Duane Maxwell/exobox"! Collection subclass: #SequenceableCollection instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Abstract'! Object subclass: #StringToXMLTranslator instanceVariableNames: 'buffer input ' classVariableNames: '' poolDictionaries: '' category: 'LP-Utilities'! !StringToXMLTranslator commentStamp: 'DSM 10/24/2000 16:19' prior: 0! This is a utilitie class that assists in the replcement of "illegal" XML characters by appropriate entities Submitted by Duane Maxwell/exobox! StringToXMLTranslator class instanceVariableNames: 'default '! Object subclass: #XMLNode instanceVariableNames: 'contents ' classVariableNames: 'EmptyArray EmptyDictionary EmptyString ' poolDictionaries: '' category: 'LP-Utilities-XMLParser'! !XMLNode commentStamp: 'DSM 10/24/2000 16:11' prior: 0! This abstract class implements the basic functionality of a node in a parsed XML data tree. Stucture: contents Collection -- the data contained by this node It is has three subclasses - XMLTagNode, XMLRootNode and XMLTextNode Submitted by Duane Maxwell/exobox! XMLNode class instanceVariableNames: ''! Object subclass: #XMLParser instanceVariableNames: 'stream ch entities entityReplacementBuffer ' classVariableNames: '' poolDictionaries: '' category: 'LP-Utilities-XMLParser'! !XMLParser commentStamp: 'DSM 10/24/2000 16:07' prior: 0! This class implements a parser for the eXtensible Markup Language (XML). Structure: stream {Some}Stream -- the stream of incoming XML text ch Character -- the last character read from the stream entities Dictionary -- the values for ampersand escape sequences entityReplacementBuffer String -- a buffer used to speed up entity substitutions This class simply parses the input stream, but does nothing with the data it finds. You should subclass this in order to process the data or build some DOM-like structure. An example of such a subclass is XMLReader, which builds a tree from the data. When you subclass, you generally override the methods in the "callbacks" category. Submitted by Duane Maxwell/exobox! XMLParser class instanceVariableNames: ''! XMLParser subclass: #XMLReader instanceVariableNames: 'stack root current ' classVariableNames: '' poolDictionaries: '' category: 'LP-Utilities-XMLParser'! !XMLReader commentStamp: 'DSM 10/24/2000 16:07' prior: 0! This subclass of XMLParser constructs a tree of data parsed from an XML text stream. example: XMLReader example explore Structure: stack OrderedCollection -- stack of nodes used during parsing root XMLRootNode -- the root of the xml tree current XMLNode -- the node being built Submitted by Duane Maxwell/exobox ! XMLReader class instanceVariableNames: ''! XMLNode subclass: #XMLRootNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LP-Utilities-XMLParser'! !XMLRootNode commentStamp: 'DSM 10/24/2000 16:19' prior: 0! This subclass of XMLNode is a node whose contents are an entire XML data tree. Typically it has two elements, both XMLTagNodes, the first being the declaration node, and the second being the rest of the data. It's the node returned as a result of parsing using XMLParser. Submitted by Duane Maxwell/exobox! XMLRootNode class instanceVariableNames: ''! XMLNode subclass: #XMLTagNode instanceVariableNames: 'tag attributes isProcessingInstruction ' classVariableNames: '' poolDictionaries: '' category: 'LP-Utilities-XMLParser'! !XMLTagNode commentStamp: 'DSM 10/24/2000 16:15' prior: 0! This subclass of XMLNode implements the type of node delimited by angle brackets, of the form: '<' {tag} [{attribute name} '=' {attribute value}]* '>' {contents} '<' '/' {tag} '>' Structure: tag Symbol -- the tag of the node attributes Dictionary -- Symbol/String pairs of the attributes isProcessingInstruction Boolean -- indicates node of type Submitted by Duane Maxwell/exobox! XMLTagNode class instanceVariableNames: ''! XMLNode subclass: #XMLTextNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LP-Utilities-XMLParser'! !XMLTextNode commentStamp: 'DSM 10/24/2000 16:16' prior: 0! This subclass of XMLNode implements nodes containing PCDATA. Submitted by Duane Maxwell/exobox! XMLTextNode class instanceVariableNames: ''! !SequenceableCollection methodsFor: 'accessing' stamp: 'SqR 6/26/2000 19:43'! at: anIndex putAll: aCollection self replaceFrom: anIndex to: anIndex + aCollection size - 1 with: aCollection startingAt: 1! ! !String methodsFor: 'converting' stamp: 'SqR 10/24/2000 10:14'! asXML "Do the basic character conversion for XML" ^StringToXMLTranslator new translate: self! ! !StringToXMLTranslator methodsFor: 'translating' stamp: 'SqR 10/24/2000 13:06'! ensureAtLeast: anInteger (input isNil or: [anInteger > input size]) ifTrue: [ input _ ByteArray new: anInteger. buffer _ ByteArray new: anInteger * 6 ]! ! !StringToXMLTranslator methodsFor: 'translating' stamp: 'len 10/10/2000 14:49'! translate: aString "Do the basic character conversion for XML" | top each outIndex | aString isEmpty ifTrue: [^ aString]. top _ aString size. self ensureAtLeast: top. input replaceFrom: 1 to: top with: aString startingAt: 1. outIndex _ 1. 1 to: top do: [:index | (each _ input at: index) > 62 "$>" ifTrue: [buffer at: outIndex put: each. outIndex _ outIndex + 1] ifFalse: [each < 34 "$""" ifTrue: [buffer at: outIndex put: each. outIndex _ outIndex + 1] ifFalse: [each < 40 ifTrue: [ each == 34 "$""" ifTrue: [buffer at: outIndex putAll: '"'. outIndex _ outIndex + 6] ifFalse: [each == 38 "$&" ifTrue: [buffer at: outIndex putAll: '&'. outIndex _ outIndex + 5] ifFalse: [each == 39 "$'" ifTrue: [buffer at: outIndex putAll: '''. outIndex _ outIndex + 6] ifFalse: [buffer at: outIndex put: each. outIndex _ outIndex + 1]]] ] ifFalse: [each > 59 ifTrue: [ each == 60 "$<" ifTrue: [buffer at: outIndex putAll: '<'. outIndex _ outIndex + 4] ifFalse: [each == 62 "$>" ifTrue: [buffer at: outIndex putAll: '>'. outIndex _ outIndex + 4] ifFalse: [buffer at: outIndex put: each. outIndex _ outIndex + 1]] ] ifFalse: [buffer at: outIndex put: each. outIndex _ outIndex + 1]]]] ]. ^(String new: outIndex - 1) replaceFrom: 1 to: outIndex - 1 with: buffer startingAt: 1! ! !StringToXMLTranslator class methodsFor: 'initializing' stamp: 'SqR 10/24/2000 13:04'! initialize default _ self new! ! !StringToXMLTranslator class methodsFor: 'initializing' stamp: 'SqR 10/24/2000 13:04'! release " ^ void Release any resource I may have." "StringToXMLTranslator release" default _ nil! ! !StringToXMLTranslator class methodsFor: 'translating' stamp: 'SqR 7/1/2000 21:01'! translate: aString default ifNil: [self initialize]. ^default translate: aString! ! !XMLNode methodsFor: 'accessing' stamp: 'SqR 7/2/2000 16:08'! addNode: aNode contents _ self contents copyWith: aNode! ! !XMLNode methodsFor: 'accessing' stamp: 'SqR 7/2/2000 15:55'! contents ^contents ifNil: [EmptyArray]! ! !XMLNode methodsFor: 'accessing' stamp: 'DSM 3/30/1999 23:01'! contents: someStuff contents _ someStuff! ! !XMLNode methodsFor: 'accessing' stamp: 'SqR 7/2/2000 15:59'! contentsDo: aBlock contents ifNotNil: [contents do: aBlock]! ! !XMLNode methodsFor: 'accessing' stamp: 'SqR 7/3/2000 15:01'! removeFirst contents _ contents allButFirst! ! !XMLNode methodsFor: 'accessing'! tag "return nil -- only tag nodes have tags" ^nil! ! !XMLNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 15:59'! firstTagNamed: aSymbol "Return the first encountered node with the specified tag. Pass the message on" | answer | self contentsDo: [:node | (answer _ node firstTagNamed: aSymbol) ifNotNil: [^answer]]. ^nil! ! !XMLNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 15:59'! firstTagNamed: aSymbol with: aBlock "Return the first encountered node with the specified tag that allows the block to evaluate to true. Pass the message on" | answer | self contentsDo: [:node | (answer _ node firstTagNamed: aSymbol with: aBlock) ifNotNil: [^answer]]. ^nil! ! !XMLNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 15:59'! tagsNamed: aSymbol childrenDo: aOneArgumentBlock "Recurse all children" self contentsDo: [:each | each tagsNamed: aSymbol ifReceiverDo: aOneArgumentBlock]! ! !XMLNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 15:59'! tagsNamed: aSymbol childrenDoAndRecurse: aOneArgumentBlock "Recurse all children" self contentsDo: [:each | each tagsNamed: aSymbol childrenDoAndRecurse: aOneArgumentBlock]! ! !XMLNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:00'! tagsNamed: aSymbol contentsDo: aBlock "Evaluate aBlock for all of the contents of the receiver. The receiver has no tag, so pass the message on" self contentsDo: [:each | each tagsNamed: aSymbol contentsDo: aBlock]! ! !XMLNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:00'! tagsNamed: aSymbol do: aOneArgumentBlock "Search for nodes with tag aSymbol. When encountered evaluate aOneArgumentBlock" self contentsDo: [:each | each tagsNamed: aSymbol do: aOneArgumentBlock]! ! !XMLNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 15:58'! tagsNamed: aSymbol ifReceiverDo: aOneArgumentBlock "Handled only by XMLTagNode subclass" ! ! !XMLNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:00'! tagsNamed: aSymbol ifReceiverDoAndRecurse: aOneArgumentBlock "Recurse all children" self contentsDo: [:each | each tagsNamed: aSymbol ifReceiverDoAndRecurse: aOneArgumentBlock]! ! !XMLNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:00'! tagsNamed: aSymbol ifReceiverOrChildDo: aOneArgumentBlock "Recurse all children" self contentsDo: [:each | each tagsNamed: aSymbol ifReceiverDo: aOneArgumentBlock]! ! !XMLNode methodsFor: 'testing' stamp: 'SqR 7/2/2000 16:00'! isTag ^false! ! !XMLNode methodsFor: 'testing' stamp: 'SqR 7/2/2000 16:00'! isText ^false! ! !XMLNode methodsFor: 'private' stamp: 'SqR 7/2/2000 19:53'! initialize "Nop"! ! !XMLNode class methodsFor: 'services' stamp: 'DSM 10/24/2000 17:16'! getXML: completeURL "return an XMLRootNode representing the response to completeURL" | responseDocument | responseDocument := HTTPSocket httpGet: completeURL. ^(responseDocument isKindOf: String) ifTrue: [ "Bob say: 'http error ',completeURL,' : ',responseDocument." nil ] ifFalse: [ XMLReader fromStream: responseDocument ] ! ! !XMLNode class methodsFor: 'services' stamp: 'DSM 10/24/2000 17:16'! getXML: urlSuffix fromServer: urlDomain "return an XMLRootNode representing the response to urlSuffix on server urlDomain" | url socket | url := urlDomain,urlSuffix. socket := HTTPSocket httpGet: url. ^(socket isKindOf: String) ifTrue: [ "Bob say: 'http error ',urlDomain,urlSuffix,' : ',socket." nil] ifFalse: [ XMLReader fromStream: socket] ! ! !XMLNode class methodsFor: 'services' stamp: 'len 10/4/2000 16:09'! initialize EmptyArray _ Array new. EmptyDictionary _ Dictionary new. EmptyString _ String new! ! !XMLNode class methodsFor: 'services' stamp: 'SqR 7/2/2000 19:53'! new ^super new initialize! ! !XMLParser methodsFor: 'callbacks' stamp: 'SqR 7/2/2000 16:51'! attribute: aSymbol value: aString "This method is called for each attribute/value pair in a start tag" ^self subclassResponsibility! ! !XMLParser methodsFor: 'callbacks' stamp: 'SqR 7/2/2000 16:52'! beginStartTag: aSymbol asPI: aBoolean "This method is called for at the beginning of a start tag. The asPI parameter defines whether or not the tag is a 'processing instruction' rather than a 'normal' tag." ^self subclassResponsibility! ! !XMLParser methodsFor: 'callbacks' stamp: 'SqR 7/2/2000 16:52'! endStartTag: aSymbol "This method is called at the end of the start tag after all of the attributes have been processed" ^self subclassResponsibility! ! !XMLParser methodsFor: 'callbacks' stamp: 'SqR 7/2/2000 16:52'! endTag: aSymbol "This method is called when the parser encounters either an end tag or the end of a unary tag" ^self subclassResponsibility! ! !XMLParser methodsFor: 'callbacks' stamp: 'SqR 7/2/2000 16:52'! text: aString "This method is called for the blocks of text between tags. It preserves whitespace, but has all of the enclosed entities expanded" ^self subclassResponsibility! ! !XMLParser methodsFor: 'entities' stamp: 'SqR 7/2/2000 16:37'! addEntity: aSymbol value: aString entities at: aSymbol put: aString! ! !XMLParser methodsFor: 'entities' stamp: 'SqR 7/3/2000 14:20'! lookupEntity: entity (entity at: 1) == $# ifTrue: [ (entity at: 2) == $x ifTrue: [^Character value: (Integer readFrom: (ReadStream on: (entity copyFrom: 3 to: entity size)) base: 16)] ifFalse: [^Character value: (entity copyFrom: 2 to: entity size) asNumber] ] ifFalse: [^entities at: entity asSymbol ifAbsent: []]! ! !XMLParser methodsFor: 'entities' stamp: 'SqR 7/2/2000 16:51'! replaceEntities: aString | pos outPos newOutPos ampIndex scIndex entity aStringSize | aStringSize _ aString size. self ensureEntityReplacementBuffer: aStringSize. outPos _ 0. pos _ 1. [pos <= aStringSize] whileTrue: ["find the ampersand" ampIndex _ aString indexOf: $& startingAt: pos ifAbsent: [pos = 1 ifTrue: [^aString] ifFalse: [aStringSize + 1]]. newOutPos _ outPos + ampIndex - pos. entityReplacementBuffer replaceFrom: outPos + 1 to: newOutPos with: aString startingAt: pos. outPos _ newOutPos. pos _ ampIndex. ampIndex <= aStringSize ifTrue: ["find the trailing semicolon" scIndex _ aString indexOf: $; startingAt: ampIndex ifAbsent: [aStringSize + 1]. entity _ self lookupEntity: (aString copyFrom: ampIndex + 1 to: scIndex - 1). entity ifNil: [ scIndex > aStringSize ifTrue: [scIndex _ aStringSize]. newOutPos _ outPos + scIndex - ampIndex + 1. entityReplacementBuffer replaceFrom: outPos + 1 to: newOutPos with: aString startingAt: ampIndex. outPos _ newOutPos ] ifNotNil: [ outPos _ outPos + 1. entityReplacementBuffer at: outPos put: entity ]. pos _ scIndex + 1 ] ]. ^entityReplacementBuffer copyFrom: 1 to: outPos! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 17:22'! errorAsteriskExpectedInElement ^self error: 'XML asterisk expected in ELEMENT'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 17:39'! errorCdataExpected ^self error: 'XML CDATA expected'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 17:16'! errorExpectedPCDataInElement ^self error: 'XML expected PCDATA in ELEMENT'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 17:22'! errorIdentifierExpected ^self error: 'XML identifier expected'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 17:22'! errorIdentifierExpectedInElement ^self error: 'XML identifier expected in ELEMENT'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 17:40'! errorInvalidDeclaration ^self error: 'XML invalid declaration'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 17:07'! errorLeftAngleBracketExpected ^self error: 'XML left angle bracket expected'! ! !XMLParser methodsFor: 'errors' stamp: 'DSM 10/16/2000 12:23'! errorLeftParenthesisExpected ^self error: 'XML left parenthesis expected'! ! !XMLParser methodsFor: 'errors' stamp: 'DSM 10/16/2000 12:55'! errorNDATAExpected ^self error: 'XML NDATA expected'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 16:22'! errorPoorlyFormedComment ^self error: 'XML poorly formed comment'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 17:19'! errorPoorlyFormedElement ^self error: 'XML poorly formed ELEMENT'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 17:04'! errorPoorlyFormedNotation ^self error: 'XML poorly formed notation'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 17:01'! errorPoorlyFormedPIAttribute ^self error: 'XML poorly formed PI attribute'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 17:10'! errorPublicOrSystemExpected ^self error: 'XML PUBLIC or SYSTEM expected'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 17:07'! errorRightAngleBracketExpected ^self error: 'XML right angle bracket expected'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 17:21'! errorRightParenthesisExpected ^self error: 'XML right parenthesis expected'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 17:22'! errorRightParenthesisExpectedInElement ^self error: 'XML right parenthesis expected in ELEMENT'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 17:07'! errorRightSquareBracketExpected ^self error: 'XML right square bracket expected'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 17:09'! errorStringExpected ^self error: 'XML string expected'! ! !XMLParser methodsFor: 'errors' stamp: 'SqR 7/2/2000 18:13'! errorUnterminatedCDataBlock ^self error: 'XML unterminated CDATA block'! ! !XMLParser methodsFor: 'initialization' stamp: 'DSM 3/31/1999 11:37'! fromStream: aStream self initialize. stream _ aStream. self parse! ! !XMLParser methodsFor: 'initialization' stamp: 'SqR 7/2/2000 16:19'! fromStream: aStream withEntities: aDictionary self initialize. aDictionary associationsDo: [:element | entities add: element]. stream _ aStream. self parse ! ! !XMLParser methodsFor: 'initialization' stamp: 'len 10/4/2000 16:09'! initialize ch _ $ . entities _ Dictionary new at: #amp put: $&; at: #apos put: $'; at: #gt put: $>; at: #lt put: $<; at: #quot put: $"; yourself. entityReplacementBuffer _ String new! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 16:24'! next stream atEnd ifTrue: [ch _ nil] ifFalse: [ch _ stream next]. ^ch ! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 16:53'! parse ch _ $ . self parseWhiteSpace. [ch isNil] whileFalse: [ ch == $< ifTrue: [self parseTag parseWhiteSpace] ifFalse: [self parseText] ]! ! !XMLParser methodsFor: 'parsing' stamp: 'DSM 10/24/2000 16:39'! parseAttDef | name decl | name _ self parseName. (name='NOTATION') ifTrue: [ self parseEntityNotation] ifFalse: [ "expect CDATA/ID/etc here" self parseWhiteSpace. (ch = $#) ifTrue: [ self next. decl _ self parseName. decl = 'FIXED' ifTrue: [ self parseWhiteSpace. "value _" self parseString. ]. self parseWhiteSpace. ]] ! ! !XMLParser methodsFor: 'parsing' stamp: 'DSM 10/16/2000 12:41'! parseAttList self parseWhiteSpace. self parseName. "tag" self parseWhiteSpace. [ch isNil or: [ch == $>]] whileFalse: [ self parseName. "name" self parseWhiteSpace. ch == $( ifTrue: [self parseEnumeration] ifFalse: [self parseAttDef]. ]. ch == $> ifTrue: [self next] ifFalse: [self errorRightAngleBracketExpected]! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 17:35'! parseAttribute "Handle name='value' construct" | attr value | attr _ self parseName asSymbol. self parseWhiteSpace. ch == $= ifTrue: [ self next. self parseWhiteSpace. (self isStringDelim: ch) ifTrue: [value _ self replaceEntities: self parseString] ifFalse: [^self errorPoorlyFormedAttribute]. self attribute: attr value: value. self parseWhiteSpace ]! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 17:44'! parseAttributes "Handle list of attribute/value pairs" self parseWhiteSpace. [ch isNil or: [ch == $> or: [ch == $/]]] whileFalse: [self parseAttribute] ! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 17:41'! parseCData | name | self next. ch == 'C' ifTrue: [ name _ self parseName. name = 'CDATA' ifTrue: [ch == $[ ifTrue: [self parseCDataContent] ifFalse: [^self errorLeftAngleBracketExpected]] ifFalse: [^self errorCdataExpected] ] ifFalse: [ self parseWhiteSpace. name _ self parseName. (name = 'IGNORE' or: [name = 'INCLUDE']) ifTrue: [ self parseWhiteSpace. ch == $[ ifTrue: [self parseInclude] ifFalse: [^self errorLeftAngleBracketExpected] ] ifFalse: [^self errorInvalidDeclaration] ]! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 18:15'! parseCDataContent "CDATA blocks are terminated by ]]>" | state text | text _ String new writeStream. self next. state _ 0. [state = 2] whileFalse: [ ch == $] ifTrue: [ state _ state + 1. "This line can't be reached. Why was the code here?" state = 3 ifTrue: [text nextPut: $]. state _ 0] ] ifFalse: [ state = 1 ifTrue: [text nextPut: $]]. state _ 0. text nextPut: ch ]. self next. ch ifNil: [^self errorUnterminatedCDataBlock]. (state = 2 and: [ch ~~ $>]) ifTrue: [text nextPutAll: ']]'. state _ 0] ]. self text: text! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 17:27'! parseComment "Comments are terminated by -->. It is illegal to otherwise have double dashes" ^self skipComment! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 17:25'! parseDeclaration "Handle ifFalse: [self errorRightAngleBracketExpected]. self next! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 17:24'! parseDocType "Handle ]> construct" self parseWhiteSpace. "name _" self parseName. self parseWhiteSpace. (ch == $[ or: [ch == $>]) ifFalse: [ (ch == $P or: [ch == $S]) ifTrue: [self parseExternalID]]. ch == $[ ifTrue: [self parseInternalDTD]. ch == $> ifTrue: [self next] ifFalse: [self errorRightAngleBracketExpected] ! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 17:23'! parseElement "Handle constructs" self parseWhiteSpace. "name _ " self parseName. self parseWhiteSpace. ch == $( ifTrue: [ self next. self parseWhiteSpace. ch == $# ifTrue: [self parseElementMixed] ifFalse: [ch _ $(. self parseElementChildren] ] ifFalse: [self parseElementFlags]. self parseWhiteSpace. ch == $> ifFalse: [^self errorRightAngleBracketExpected]. self next! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 17:22'! parseElementChildren "Handle elements of form " self parseWhiteSpace. ch == $( ifTrue: [self parseElementChoiceOrSequence] ifFalse: [self parseName size = 0 ifTrue: [^self errorIdentifierExpected]]. ('*?+' indexOf: ch) > 0 ifTrue: [self next] ! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 17:43'! parseElementChoiceOrSequence "Handle recursive (a,b,c) and (a|b|c) constructs" [self next. self parseElementChildren. self parseWhiteSpace. (',|' indexOf: ch) > 0] whileTrue. ch == $) ifTrue: [self next] ifFalse: [^self errorRightParenthesisExpected]! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 17:20'! parseElementFlags "Handle and constructs" | flag | (flag _ self parseName) = 'EMPTY' ifTrue: [flag _ flag] ifFalse: [flag = 'ANY' ifTrue: [flag _ flag] ifFalse: [^self errorPoorlyFormedElement] ]! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 17:19'! parseElementMixed "Handle and constructs" | name | self next. self parseName = 'PCDATA' ifFalse: [^self errorExpectedPCDataInElement]. self parseWhiteSpace. ch == $| ifTrue: [ [ch == $|] whileTrue: [ self next. self parseWhiteSpace. name _ self parseName. name size = 0 ifTrue: [^self errorIdentifierExpectedInElement]. self parseWhiteSpace ]. ch == $) ifFalse: [^self errorRightParenthesisExpectedInElement]. self next. ch == $* ifFalse: [^self errorAsteriskExpectedInElement]. self next ] ifFalse: [ ch == $) ifTrue: [self next] ifFalse: [^self errorRightParenthesisExpectedInElement] ]! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 17:15'! parseEndNormalTag: tag ch == $/ ifTrue: [ self next. ch == $> ifFalse: [^self errorRightAngleBracketExpected]. self endStartTag: tag. self endTag: tag. self next ] ifFalse: [ ch == $> ifTrue: [self endStartTag: tag. self next] ifFalse: [^self errorRightAngleBracketExpected] ]! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 17:13'! parseEndTag "Handle constructs" | tag | self next. tag _ self parseName asSymbol. self parseWhiteSpace. ch == $> ifFalse: [^self errorRightAngleBracketExpected]. self endTag: tag. self next ! ! !XMLParser methodsFor: 'parsing' stamp: 'DSM 10/16/2000 13:10'! parseEntity self parseWhiteSpace. ch = $% ifTrue: [ self next. self parseWhiteSpace. "name _" self parseName. self parseWhiteSpace. self parsePEDef. "then install in entities dictionary..." self parseWhiteSpace. ] ifFalse: [ "name _" self parseName. self parseWhiteSpace. self parseEntityDef. self parseWhiteSpace. ]. ch = $> ifFalse: [self errorRightAngleBracketExpected]. self next.! ! !XMLParser methodsFor: 'parsing' stamp: 'DSM 10/16/2000 13:08'! parseEntityDef | type | (self isStringDelim: ch) ifTrue: [ self parseString "simple value - should replace included entities - fix also parsePEDef"] ifFalse: [ type _ self parseName. type = 'SYSTEM' ifTrue: [ self parseWhiteSpace. self parseString. self parseWhiteSpace. ] ifFalse: [ type = 'PUBLIC' ifTrue: [ self parseWhiteSpace. self parseString. self parseWhiteSpace. self parseString. self parseWhiteSpace. ] ifFalse: [ self errorPublicOrSystemExpected ]]. ch = $N ifTrue: [ self parseName = 'NDATA' ifFalse: [ self errorNDATAExpected]. self parseWhiteSpace. self parseName. self parseWhiteSpace. ]] ! ! !XMLParser methodsFor: 'parsing' stamp: 'DSM 10/24/2000 17:00'! parseEntityNotation " " self parseWhiteSpace. (ch = $() ifFalse: [ self errorLeftParenthesisExpected ]. self next. [ ch isNil or: [ ch == $)]] whileFalse: [ self parseWhiteSpace. "name _ " self parseName. self parseWhiteSpace. ch = $| ifTrue: [ self next ]. self parseWhiteSpace. ]. self next. self parseWhiteSpace. ! ! !XMLParser methodsFor: 'parsing' stamp: 'DSM 10/16/2000 13:11'! parseEnumeration self next. [ ch isNil or: [ ch == $)]] whileFalse: [ self parseWhiteSpace. self parseName. self parseWhiteSpace. ch = $| ifTrue: [ self next ]. self parseWhiteSpace. ]. self next. self parseWhiteSpace. self parseString. self parseWhiteSpace.! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 17:12'! parseExternalID | type | type _ self parseName. self parseWhiteSpace. type = 'SYSTEM' ifTrue: [ (self isStringDelim: ch) ifTrue: [self parseString] ifFalse: [self errorStringExpected]. ^self parseWhiteSpace ]. type = 'PUBLIC' ifTrue: [ (self isStringDelim: ch) ifTrue: [self parseString] ifFalse: [self errorStringExpected]. self parseWhiteSpace. (self isStringDelim: ch) ifTrue: [self parseString] ifFalse: [self errorStringExpected]. ^self parseWhiteSpace ]. self errorPublicOrSystemExpected! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/3/2000 14:22'! parseInclude self next. self parseWhiteSpace. [ch notNil and: [ch == $<]] whileTrue: [self parseTag. self parseWhiteSpace]. ch == $] ifTrue: [ self next. ch == $] ifTrue: [self next] ifFalse: [self errorRightSquareBracketExpected] ] ifFalse: [self errorRightSquareBracketExpected]! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/3/2000 14:24'! parseInternalDTD self next. self parseWhiteSpace. [ch notNil and: [ch == $<]] whileTrue: [self parseTag. self parseWhiteSpace]. ch == $] ifTrue: [self next] ifFalse: [self errorRightSquareBracketExpected]! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 17:05'! parseName | nameStream | nameStream _ String new writeStream. [self isNamish: ch] whileTrue: [nameStream nextPut: ch. self next]. ^nameStream contents! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 17:05'! parseNormalTag "Handle constructs" | tag | tag _ self parseName asSymbol. self beginStartTag: tag asPI: false. self parseAttributes. self parseEndNormalTag: tag! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 10/24/2000 10:21'! parseNotation "Handle " | scope | self parseWhiteSpace. "name _" self parseName. self parseWhiteSpace. scope _ self parseName. (scope = 'SYSTEM' or: [scope = 'PUBLIC']) ifTrue: [ self parseWhiteSpace. (ch == $' or: [ch == $"]) ifFalse: [self error: 'XML string expected']. self parseString. self parseWhiteSpace ] ifFalse: [self errorPoorlyFormedNotation]! ! !XMLParser methodsFor: 'parsing' stamp: 'DSM 10/16/2000 13:10'! parsePEDef | type | (self isStringDelim: ch) ifTrue: [ self parseString "simple value see comments in parseEntityDef"] ifFalse: [ type _ self parseName. type = 'SYSTEM' ifTrue: [ self parseWhiteSpace. self parseString. self parseWhiteSpace. ] ifFalse: [ type = 'PUBLIC' ifTrue: [ self parseWhiteSpace. self parseString. self parseWhiteSpace. self parseString. self parseWhiteSpace. ] ifFalse: [ self errorPublicOrSystemExpected ]]]. ! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/3/2000 14:24'! parseProcessingInstruction "Handle constructs" | tag attr value | self next. tag _ self parseName asSymbol. self beginStartTag: tag asPI: true. self parseWhiteSpace. [ch isNil or: [ch == $?]] whileFalse: [ attr _ self parseName asSymbol. value _ ''. self parseWhiteSpace. ch == $= ifTrue: [ self next. self parseWhiteSpace. (ch == $" or: [ch == $']) ifTrue: [value _ self parseString] ifFalse: [^self errorPoorlyFormedPIAttribute]. self attribute: attr value: value. self parseWhiteSpace ] ]. self next. ch == $> ifFalse: [^self errorRightAngleBracketExpected]. self endStartTag: tag. self endTag: tag. self next! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 16:59'! parseString | delim stringStream | stringStream _ String new writeStream. delim _ ch. self next. [self isStringish: ch withDelim: delim] whileTrue: [stringStream nextPut: ch. self next]. self next. ^stringStream contents! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 16:59'! parseTag ch == $< ifFalse: [^self errorLeftAngleBracketExpected]. self next. self parseWhiteSpace. ch == $!! ifTrue: [ self next. ch == $- ifTrue: [self next. ch == $- ifTrue: [self next. self parseComment] ifFalse: [^self errorPoorlyFormedComment] ] ifFalse: [self parseDeclaration] ] ifFalse: [ ch == $/ ifTrue: [self parseEndTag] ifFalse: [ch == $? ifTrue: [self parseProcessingInstruction] ifFalse: [self parseNormalTag] ] ]! ! !XMLParser methodsFor: 'parsing' stamp: 'SqR 7/2/2000 16:54'! parseText | textStream | textStream _ String new writeStream. [self isTextish: ch] whileTrue: [textStream nextPut: ch. self next]. self text: (self replaceEntities: textStream contents)! ! !XMLParser methodsFor: 'parsing' stamp: 'len 6/23/2000 10:05'! parseWhiteSpace [self isWhiteSpace: ch] whileTrue: [self next]! ! !XMLParser methodsFor: 'testing' stamp: 'SqR 7/2/2000 16:35'! isNamish: aChar "Is the character part of a valid XML name?" ^aChar notNil and: [aChar isLetter or: [aChar isDigit or: ['-_.:' includes: aChar]]]! ! !XMLParser methodsFor: 'testing' stamp: 'SqR 7/3/2000 14:25'! isStringDelim: aChar ^aChar == $' or: [aChar == $"]! ! !XMLParser methodsFor: 'testing' stamp: 'SqR 7/3/2000 14:28'! isStringish: aChar withDelim: delim ^(aChar isNil or: [aChar == delim]) not! ! !XMLParser methodsFor: 'testing' stamp: 'SqR 7/3/2000 14:27'! isTextish: aChar ^(aChar isNil or: [aChar == $<]) not! ! !XMLParser methodsFor: 'testing' stamp: 'SqR 7/2/2000 16:36'! isWhiteSpace: aChar "Fortunately, XML and Smalltalk share the same idea of whitespace" ^aChar notNil and: [aChar isSeparator]! ! !XMLParser methodsFor: 'private' stamp: 'SqR 7/2/2000 16:48'! ensureEntityReplacementBuffer: anInteger entityReplacementBuffer size < anInteger ifTrue: [entityReplacementBuffer _ String new: anInteger]! ! !XMLParser methodsFor: 'private' stamp: 'SqR 10/24/2000 10:24'! skipComment "Comments are terminated by --> . It is illegal to otherwise have double dashes" | state | state _ 0. [state = 2] whileFalse: [ ch == $- ifTrue: [state _ state + 1] ifFalse: [state _ 0]. self next ]. ch == $> ifFalse: [^self errorPoorlyFormedComment]. self next! ! !XMLParser methodsFor: 'private' stamp: 'SqR 7/2/2000 16:22'! skipWhiteSpace [self isWhiteSpace: ch] whileTrue: [self next]! ! !XMLParser class methodsFor: 'instance creation' stamp: 'SqR 7/2/2000 16:18'! new ^super new initialize! ! !XMLReader methodsFor: 'callbacks' stamp: 'SqR 7/2/2000 18:16'! attribute: aSymbol value: aString (current ifNil: [^self errorNoNode]) addAttribute: aSymbol value: aString! ! !XMLReader methodsFor: 'callbacks' stamp: 'SqR 7/2/2000 18:17'! beginStartTag: aSymbol asPI: aBoolean | node | root ifNil: [^self errorNoCurrentNode]. node _ XMLTagNode tag: aSymbol asPI: aBoolean. current addNode: node. stack addLast: current. current _ node! ! !XMLReader methodsFor: 'callbacks' stamp: 'SqR 7/2/2000 18:17'! endStartTag: aSymbol "Nothing"! ! !XMLReader methodsFor: 'callbacks' stamp: 'SqR 7/2/2000 18:18'! endTag: aSymbol current ifNil: [^self errorNoCurrentNode]. current tag == aSymbol ifFalse: [^self errorNesting]. stack isEmpty ifTrue: [^self errorStackEmpty]. current _ stack removeLast! ! !XMLReader methodsFor: 'callbacks' stamp: 'SqR 7/2/2000 18:18'! text: aString (current ifNil: [^self errorNoCurrentNode]) addNode: (XMLTextNode text: aString)! ! !XMLReader methodsFor: 'errors' stamp: 'SqR 7/2/2000 18:18'! errorNesting ^self error: 'XML nesting error'! ! !XMLReader methodsFor: 'errors' stamp: 'SqR 7/2/2000 18:17'! errorNoCurrentNode ^self error: 'XML no current node'! ! !XMLReader methodsFor: 'errors' stamp: 'SqR 7/2/2000 18:16'! errorNoNode ^self error: 'XML no node'! ! !XMLReader methodsFor: 'errors' stamp: 'SqR 7/2/2000 18:18'! errorStackEmpty ^self error: 'XML stack empty'! ! !XMLReader methodsFor: 'errors' stamp: 'SqR 7/2/2000 18:19'! errorUnterminatedTag ^self error: 'XML unterminated tag'! ! !XMLReader methodsFor: 'initialization' stamp: 'SqR 7/2/2000 18:18'! fromStream: aStream super fromStream: aStream. ^root! ! !XMLReader methodsFor: 'initialization' stamp: 'SqR 7/2/2000 18:19'! fromStream: aStream withEntities: aDictionary super fromStream: aStream withEntities: aDictionary. ^root! ! !XMLReader methodsFor: 'initialization' stamp: 'DSM 3/31/1999 22:20'! initialize super initialize. stack _ OrderedCollection new. root _ XMLRootNode new. current _ root ! ! !XMLReader methodsFor: 'private' stamp: 'SqR 7/2/2000 18:19'! parse super parse. stack isEmpty ifFalse: [^self errorUnterminatedTag]! ! !XMLReader class methodsFor: 'instance creation' stamp: 'DSM 3/31/1999 22:25'! fromFileNamed: aFileName ^ self fromStream: (FileStream readOnlyFileNamed: aFileName)! ! !XMLReader class methodsFor: 'instance creation' stamp: 'DSM 3/31/1999 22:22'! fromStream: aStream ^ self new fromStream: aStream! ! !XMLReader class methodsFor: 'instance creation' stamp: 'DSM 3/31/1999 22:22'! fromStream: aStream withEntities: entities ^ self new fromStream: aStream withEntities: entities! ! !XMLReader class methodsFor: 'instance creation' stamp: 'DSM 1/17/2000 23:03'! fromString: aString ^ self new fromStream: (ReadStream on: aString)! ! !XMLReader class methodsFor: 'example' stamp: 'DSM 1/17/2000 23:25'! example ^ self fromString: ' Some text with special characters <&"'> ' " XMLReader example explore "! ! !XMLRootNode methodsFor: 'initialization' stamp: 'SqR 7/2/2000 16:01'! xmlVersion "Return the XML version stamp" ^((self firstTagNamed: #xml) attributes ifNil: [^self]) at: #version ifAbsent: []! ! !XMLRootNode methodsFor: 'printing' stamp: 'SqR 7/2/2000 16:01'! printOn: aStream self contentsDo: [:element | element printOn: aStream] ! ! !XMLTagNode methodsFor: 'accessing' stamp: 'SqR 7/2/2000 16:08'! addAttribute: aSymbol value: aString attributes == EmptyDictionary ifTrue: [attributes _ IdentityDictionary new]. attributes at: aSymbol put: aString! ! !XMLTagNode methodsFor: 'accessing' stamp: 'SqR 7/2/2000 16:06'! attributes ^attributes ifNil: [EmptyDictionary]! ! !XMLTagNode methodsFor: 'accessing' stamp: 'SqR 7/2/2000 16:11'! isProcessingInstruction ^isProcessingInstruction! ! !XMLTagNode methodsFor: 'accessing' stamp: 'SqR 7/2/2000 16:09'! isTag ^true! ! !XMLTagNode methodsFor: 'accessing' stamp: 'SqR 7/2/2000 16:09'! removeAttribute: aSymbol self attributes removeKey: aSymbol ifAbsent: []! ! !XMLTagNode methodsFor: 'accessing' stamp: 'SqR 7/2/2000 16:09'! removeAttribute: aSymbol ifAbsent: aBlock self attributes removeKey: aSymbol ifAbsent: aBlock! ! !XMLTagNode methodsFor: 'accessing' stamp: 'SqR 7/2/2000 16:11'! setPI: aBoolean isProcessingInstruction _ aBoolean ! ! !XMLTagNode methodsFor: 'accessing' stamp: 'len 10/12/2000 15:57'! tag ^ tag! ! !XMLTagNode methodsFor: 'accessing' stamp: 'DSM 3/30/1999 22:48'! tag: aSymbol tag _ aSymbol! ! !XMLTagNode methodsFor: 'accessing' stamp: 'SqR 7/3/2000 14:57'! valueFor: aSymbol ^self attributes at: aSymbol ifAbsent: [EmptyString]! ! !XMLTagNode methodsFor: 'accessing' stamp: 'SqR 7/3/2000 15:40'! valueFor: aSymbol ifAbsent: aBlock ^self attributes at: aSymbol ifAbsent: aBlock! ! !XMLTagNode methodsFor: 'initialization' stamp: 'SqR 7/3/2000 14:38'! initialize isProcessingInstruction _ false. attributes _ EmptyDictionary! ! !XMLTagNode methodsFor: 'printing' stamp: 'SqR 7/2/2000 18:05'! printAttribute: attribute on: aStream aStream nextPutAll: attribute key asString; nextPutAll: '="'; nextPutAll: attribute value asString asXML; nextPut: $"! ! !XMLTagNode methodsFor: 'printing' stamp: 'SqR 7/2/2000 16:12'! printAttributesOn: aStream self attributes associationsDo: [:attribute | aStream nextPut: $ . self printAttribute: attribute on: aStream ]! ! !XMLTagNode methodsFor: 'printing' stamp: 'SqR 7/2/2000 16:12'! printContentsOn: aStream self contentsDo: [:node | node printOn: aStream] ! ! !XMLTagNode methodsFor: 'printing' stamp: 'SqR 7/2/2000 16:12'! printEndTagOn: aStream self contents isEmpty ifFalse: [ aStream nextPutAll: ' ]! ! !XMLTagNode methodsFor: 'printing' stamp: 'SqR 7/2/2000 16:13'! printOn: aStream self printStartTagOn: aStream; printContentsOn: aStream; printEndTagOn: aStream ! ! !XMLTagNode methodsFor: 'printing' stamp: 'SqR 7/2/2000 16:13'! printStartTagOn: aStream aStream nextPut: $<. self isProcessingInstruction ifTrue: [aStream nextPut: $?]. self printTagOn: aStream; printAttributesOn: aStream. self isProcessingInstruction ifTrue: [aStream nextPut: $?] ifFalse: [self contents isEmpty ifTrue: [aStream nextPut: $/]]. aStream nextPut: $>! ! !XMLTagNode methodsFor: 'printing' stamp: 'SqR 7/2/2000 16:13'! printTagOn: aStream aStream nextPutAll: self tag asString ! ! !XMLTagNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:14'! firstTagNamed: aSymbol "Return the first encountered node with the specified tag. If it is not the receiver, pass the message on" tag == aSymbol ifTrue: [^self]. ^super firstTagNamed: aSymbol ! ! !XMLTagNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:14'! firstTagNamed: aSymbol with: aBlock "Return the first encountered node with the specified tag that allows the block to evaluate to true. Pass the message on" (tag == aSymbol and: [aBlock value: self]) ifTrue: [^self]. ^super firstTagNamed: aSymbol with: aBlock.! ! !XMLTagNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:02'! tagsNamed: aSymbol childrenDo: aOneArgumentBlock "Evaluate aOneArgumentBlock for all children who match" self contentsDo: [:each | each tagsNamed: aSymbol ifReceiverDo: aOneArgumentBlock]! ! !XMLTagNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:02'! tagsNamed: aSymbol childrenDoAndRecurse: aOneArgumentBlock "Evaluate aOneArgumentBlock for all children who match and recurse" self contentsDo: [:each | each tagsNamed: aSymbol ifReceiverDoAndRecurse: aOneArgumentBlock]! ! !XMLTagNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:03'! tagsNamed: aSymbol contentsDo: aBlock "Evaluate aBlock for all of the contents of the receiver if the receiver tag equals aSymbol. Pass the message on" tag == aSymbol ifTrue: [self contentsDo: aBlock]. super tagsNamed: aSymbol contentsDo: aBlock! ! !XMLTagNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:03'! tagsNamed: aSymbol do: aOneArgumentBlock "If the receiver tag equals aSymbol, evaluate aOneArgumentBlock with the receiver. Continue the search" tag == aSymbol ifTrue: [aOneArgumentBlock value: self]. super tagsNamed: aSymbol do: aOneArgumentBlock! ! !XMLTagNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:14'! tagsNamed: aSymbol ifReceiverDo: aOneArgumentBlock "If the receiver tag equals aSymbol, evaluate aOneArgumentBlock with the receiver" tag == aSymbol ifTrue: [aOneArgumentBlock value: self] ! ! !XMLTagNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:14'! tagsNamed: aSymbol ifReceiverDoAndRecurse: aOneArgumentBlock "If the receiver tag equals aSymbol, evaluate aOneArgumentBlock with the receiver. Then recurse through all the children" tag == aSymbol ifTrue: [aOneArgumentBlock value: self]. super tagsNamed: aSymbol ifReceiverDoAndRecurse: aOneArgumentBlock! ! !XMLTagNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:04'! tagsNamed: aSymbol ifReceiverOrChildDo: aOneArgumentBlock "If the receiver tag equals aSymbol, evaluate aOneArgumentBlock with the receiver. For each of the receivers children do the same. Do not go beyond direct children" tag == aSymbol ifTrue: [aOneArgumentBlock value: self]. super tagsNamed: aSymbol ifReceiverDo: aOneArgumentBlock! ! !XMLTagNode class methodsFor: 'instance creation' stamp: 'SqR 7/2/2000 19:54'! tag: aSymbol ^self tag: aSymbol asPI: false! ! !XMLTagNode class methodsFor: 'instance creation' stamp: 'SqR 7/2/2000 19:54'! tag: aSymbol asPI: aBoolean ^self new setPI: aBoolean; tag: aSymbol ! ! !XMLTextNode methodsFor: 'accessing' stamp: 'SqR 7/2/2000 16:15'! contents ^contents ifNil: [EmptyString]! ! !XMLTextNode methodsFor: 'accessing' stamp: 'SqR 7/2/2000 16:15'! text ^self contents! ! !XMLTextNode methodsFor: 'accessing' stamp: 'DSM 3/30/1999 23:02'! text: aString super contents: aString! ! !XMLTextNode methodsFor: 'testing' stamp: 'SqR 7/2/2000 16:16'! isText ^true! ! !XMLTextNode methodsFor: 'printing' stamp: 'SqR 7/2/2000 18:05'! printOn: aStream aStream nextPutAll: self text asXML! ! !XMLTextNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:16'! firstTagNamed: aSymbol "Return the first encountered node with the specified tag. If it is not the receiver, pass the message on" ^nil! ! !XMLTextNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:16'! tagsNamed: aSymbol childrenDo: aOneArgumentBlock "We have no tag & we have no children" ! ! !XMLTextNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:16'! tagsNamed: aSymbol childrenDoAndRecurse: aOneArgumentBlock "We have no tag & we have no children" ! ! !XMLTextNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:17'! tagsNamed: aSymbol contentsDo: aBlock "We have no tag & we have no children" ! ! !XMLTextNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:17'! tagsNamed: aSymbol do: aOneArgumentBlock "We have no tag & we have no children" ! ! !XMLTextNode methodsFor: 'searching'! tagsNamed: aSymbol ifReceiverDoAndRecurse: aOneArgumentBlock "We have no tag & we have no children"! ! !XMLTextNode methodsFor: 'searching' stamp: 'SqR 7/2/2000 16:17'! tagsNamed: aSymbol ifReceiverOrChildDo: aOneArgumentBlock "We have no tag & we have no children" ! ! !XMLTextNode class methodsFor: 'instance creation' stamp: 'SqR 7/2/2000 19:54'! text: someText ^self new text: someText! ! !XMLParser reorganize! ('callbacks' attribute:value: beginStartTag:asPI: endStartTag: endTag: text:) ('entities' addEntity:value: lookupEntity: replaceEntities:) ('errors' errorAsteriskExpectedInElement errorCdataExpected errorExpectedPCDataInElement errorIdentifierExpected errorIdentifierExpectedInElement errorInvalidDeclaration errorLeftAngleBracketExpected errorLeftParenthesisExpected errorNDATAExpected errorPoorlyFormedComment errorPoorlyFormedElement errorPoorlyFormedNotation errorPoorlyFormedPIAttribute errorPublicOrSystemExpected errorRightAngleBracketExpected errorRightParenthesisExpected errorRightParenthesisExpectedInElement errorRightSquareBracketExpected errorStringExpected errorUnterminatedCDataBlock) ('initialization' fromStream: fromStream:withEntities: initialize) ('parsing' next parse parseAttDef parseAttList parseAttribute parseAttributes parseCData parseCDataContent parseComment parseDeclaration parseDocType parseElement parseElementChildren parseElementChoiceOrSequence parseElementFlags parseElementMixed parseEndNormalTag: parseEndTag parseEntity parseEntityDef parseEntityNotation parseEnumeration parseExternalID parseInclude parseInternalDTD parseName parseNormalTag parseNotation parsePEDef parseProcessingInstruction parseString parseTag parseText parseWhiteSpace) ('testing' isNamish: isStringDelim: isStringish:withDelim: isTextish: isWhiteSpace:) ('private' ensureEntityReplacementBuffer: skipComment skipWhiteSpace) ! XMLNode initialize! StringToXMLTranslator initialize! !StringToXMLTranslator reorganize! ('translating' ensureAtLeast: translate:) !