'From Squeak3.3alpha of 11 January 2002 [latest update: #4654] on 30 January 2002 at 4:39:22 pm'! "Change Set: XML-Parser Date: 25 January 2002 Authors: Duane Maxwell, Andres Valloud, Michael Rueger Published as 4744YAXO.cs in Squeak 3.3a. YAX is yet another XML parser. This version is an effort to further integrate the original yax version with the Exobox implementation. The original yax version already was based on some ideas in the Comanche tokenizer and the Exobox parser. The YAX homepage is at http://www.squeaklet.com/Yax/index.html. This change set includes a XMLParser with SAX and DOM support and a XMLWriter. The SAXDriver/Handler implements the revised SAX2 API. The parser is what somebody dubbed semi-verifying. It handles internal entity declaration and expands them but does no verification against any DTD declarations. What's missing/buggy: - inline expansion of external references/files - 16 bit character support - XMLWriter character escapes The parser passes a lot of the standalone SUnit tests, but also fails (too) many for (none) well formedness. There are several ways to use this implementation to parse XML files: - use the DOM parser. It returns a hierarchical data structure containing the XML elements. - subclass SAXHandler (XMLDOMParser does that too) and override the callbacks. This avoids the overhead associated with building a complete DOM structure in memory. - subclass XMLTokenizer and overwrite the handle callbacks. Not really recommended although for compatibilty reasons the Exobox XMLParser does this. You can do incremental parsing by repeatedly calling nextEntity on the parser. Examples: XMLDOMParser addressBookXMLWithDTD parses the same example into a DOM structure using the SAXDriver and the DOMParser being an implementation of a SAXHandler. Parsing from a file: XMLDOMParser parseDocumentFromFileNamed: 'examples\dream.xml'. Parsing from a stream: XMLDOMParser parseDocumentFrom: XMLTokenizer addressBookXMLWithDTD readStream. "! Object subclass: #DTDEntityDeclaration instanceVariableNames: 'name value ndata ' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! DTDEntityDeclaration class instanceVariableNames: 'contextBehavior '! DTDEntityDeclaration subclass: #DTDExternalEntityDeclaration instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! DTDExternalEntityDeclaration class instanceVariableNames: ''! DTDEntityDeclaration subclass: #DTDParameterEntityDeclaration instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! DTDParameterEntityDeclaration class instanceVariableNames: ''! Error subclass: #SAXException instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! Object subclass: #SAXHandler instanceVariableNames: 'document driver eod ' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! SAXHandler class instanceVariableNames: ''! SAXException subclass: #SAXMalformedException instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! SAXException subclass: #SAXParseException instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! Warning subclass: #SAXWarning instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! SAXHandler subclass: #XMLDOMParser instanceVariableNames: 'entity stack incremental ' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! XMLDOMParser class instanceVariableNames: ''! Error subclass: #XMLException instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! XMLException subclass: #XMLInvalidException instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! XMLException subclass: #XMLMalformedException instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! Object subclass: #XMLNode instanceVariableNames: '' classVariableNames: 'CanonicalTable ' poolDictionaries: '' category: 'XML-Parser'! XMLNode subclass: #XMLNodeWithEntities instanceVariableNames: 'entities ' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! XMLNodeWithEntities subclass: #XMLDocument instanceVariableNames: 'dtd version encoding requiredMarkup ' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! XMLNodeWithEntities subclass: #XMLElement instanceVariableNames: 'name contents attributes ' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! XMLElement class instanceVariableNames: ''! XMLNode subclass: #XMLPI instanceVariableNames: 'target data ' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! XMLPI class instanceVariableNames: ''! XMLNode subclass: #XMLStringNode instanceVariableNames: 'string ' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! XMLStringNode class instanceVariableNames: ''! Object subclass: #XMLTokenizer instanceVariableNames: 'stream nestedStreams entities externalEntities parameterEntities parsingMarkup markedPosition peekChar validating ' classVariableNames: 'CharEscapes NameDelimiters ' poolDictionaries: '' category: 'XML-Parser'! !XMLTokenizer commentStamp: '' prior: 0! XMLTokenizer bolot@cc.gatech.edu breaks the stream of characters into a stream of XMLnodes (aka token stream) token stream is used by XMLparser to generate XMLdocument tree! XMLTokenizer subclass: #SAXDriver instanceVariableNames: 'saxHandler ' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! XMLTokenizer subclass: #XMLParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! XMLTokenizer class instanceVariableNames: ''! XMLException subclass: #XMLWarningException instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'XML-Parser'! Object subclass: #XMLWriter instanceVariableNames: 'stream stack scanner canonical ' classVariableNames: 'XMLTranslation ' poolDictionaries: '' category: 'XML-Parser'! XMLWriter class instanceVariableNames: ''! !DTDEntityDeclaration methodsFor: 'invocation' stamp: 'mir 11/16/2000 21:23'! registerIn: aParser aParser entity: self name put: self! ! !DTDEntityDeclaration methodsFor: 'invocation' stamp: 'mir 1/15/2002 15:08'! valueForContext: aContext ^self perform: (self class behaviorForContext: aContext)! ! !DTDEntityDeclaration methodsFor: 'accessing' stamp: 'mir 1/4/2002 19:40'! name ^name! ! !DTDEntityDeclaration methodsFor: 'accessing' stamp: 'mir 1/17/2002 15:25'! name: aString name _ aString asSymbol! ! !DTDEntityDeclaration methodsFor: 'accessing' stamp: 'mir 12/8/2000 17:22'! ndata ^ndata! ! !DTDEntityDeclaration methodsFor: 'accessing' stamp: 'mir 12/8/2000 17:22'! ndata: aString ndata _ aString! ! !DTDEntityDeclaration methodsFor: 'accessing' stamp: 'mir 11/16/2000 10:54'! value ^value! ! !DTDEntityDeclaration methodsFor: 'accessing' stamp: 'mir 11/16/2000 10:55'! value: aString value _ aString! ! !DTDEntityDeclaration methodsFor: 'behaviors' stamp: 'mir 1/15/2002 11:29'! bypass "Return my reference as is." ^self reference! ! !DTDEntityDeclaration methodsFor: 'behaviors' stamp: 'mir 1/15/2002 11:29'! forbidden self error: 'Forbidden reference usage'! ! !DTDEntityDeclaration methodsFor: 'behaviors' stamp: 'mir 1/15/2002 18:01'! include "Return my expanded value." ^value ifNil: [SAXWarning signal: 'XML undefined entity ' , name printString]! ! !DTDEntityDeclaration methodsFor: 'behaviors' stamp: 'mir 1/15/2002 18:06'! includedInLiteral "Return my expanded value." ^self include! ! !DTDEntityDeclaration methodsFor: 'behaviors' stamp: 'mir 1/15/2002 11:30'! reference "Return my reference as is." ^self class leadIn , self name , ';'! ! !DTDEntityDeclaration class methodsFor: 'instance creation' stamp: 'mir 11/16/2000 20:13'! name: aString value: aValueString ^self new name: aString; value: aValueString! ! !DTDEntityDeclaration class methodsFor: 'class initialization' stamp: 'mir 1/15/2002 18:02'! initialize "DTDEntityDeclaration initialize" contextBehavior _ Dictionary new. contextBehavior at: #content put: #include ; at: #attributeValueContent put: #includedInLiteral ; at: #attributeValue put: #forbidden ; at: #entityValue put: #bypass ; at: #dtd put: #forbidden ! ! !DTDEntityDeclaration class methodsFor: 'accessing' stamp: 'mir 11/16/2000 20:14'! behaviorForContext: aContext ^self contextBehavior at: aContext! ! !DTDEntityDeclaration class methodsFor: 'accessing' stamp: 'mir 11/16/2000 20:15'! contextBehavior ^contextBehavior! ! !DTDEntityDeclaration class methodsFor: 'accessing' stamp: 'mir 11/16/2000 20:27'! leadIn ^'&'! ! !DTDExternalEntityDeclaration class methodsFor: 'class initialization' stamp: 'mir 1/14/2002 18:15'! initialize "DTDExternalEntityDeclaration initialize" contextBehavior _ Dictionary new. contextBehavior at: #content put: #include ; at: #attributeValueContent put: #includedInLiteral ; at: #attributeValue put: #forbidden ; at: #entityValue put: #bypass ; at: #dtd put: #forbidden ! ! !DTDParameterEntityDeclaration methodsFor: 'invocation' stamp: 'mir 11/28/2000 17:26'! registerIn: aParser aParser parameterEntity: self name put: self! ! !DTDParameterEntityDeclaration methodsFor: 'behaviors' stamp: 'mir 1/15/2002 11:30'! includePE "Return my expanded value." ^self include! ! !DTDParameterEntityDeclaration methodsFor: 'behaviors' stamp: 'mir 1/15/2002 23:21'! notRecognized SAXMalformedException signal: 'Malformed entity.'! ! !DTDParameterEntityDeclaration class methodsFor: 'accessing' stamp: 'mir 11/16/2000 20:27'! leadIn ^'%'! ! !DTDParameterEntityDeclaration class methodsFor: 'class initialization' stamp: 'mir 1/14/2002 18:15'! initialize "DTDParameterEntityDeclaration initialize" contextBehavior _ Dictionary new. contextBehavior at: #content put: #notRecognized: ; at: #attributeValueContent put: #notRecognized: ; at: #attributeValue put: #notRecognized: ; at: #entityValue put: #include: ; at: #dtd put: #includePE:! ! !SAXHandler methodsFor: 'parsing' stamp: 'mir 1/8/2002 18:18'! parseDocument [self driver nextEntity isNil or: [self eod]] whileFalse! ! !SAXHandler methodsFor: 'entity' stamp: 'mir 8/11/2000 17:33'! resolveEntity: publicID systemID: systemID "This call corresonds to the Java SAX call resolveEntity(java.lang.String publicId, java.lang.String systemId)."! ! !SAXHandler methodsFor: 'lexical' stamp: 'mir 8/11/2000 18:52'! comment: commentString "This call corresponds to the Java SAX ext call comment(char[] ch, int start, int length)."! ! !SAXHandler methodsFor: 'lexical' stamp: 'mir 8/11/2000 18:53'! endEntity: entityName "This call corresponds to the Java SAX ext call endEntity(java.lang.String name)."! ! !SAXHandler methodsFor: 'lexical' stamp: 'mir 8/11/2000 18:53'! startCData "This call corresponds to the Java SAX ext call startCData()."! ! !SAXHandler methodsFor: 'lexical' stamp: 'mir 8/11/2000 18:54'! startDTD: declName publicID: publicID systemID: systemID "This call corresponds to the Java SAX ext call startDTD(java.lang.String name, java.lang.String publicId, java.lang.String systemId)."! ! !SAXHandler methodsFor: 'lexical' stamp: 'mir 8/11/2000 18:54'! startEntity: entityName "This call corresponds to the Java SAX ext call startEntity(java.lang.String name)."! ! !SAXHandler methodsFor: 'content' stamp: 'mir 1/8/2002 18:27'! characters: aString "This call corresponds to the Java SAX call characters(char[] ch, int start, int length)."! ! !SAXHandler methodsFor: 'content' stamp: 'mir 1/8/2002 18:24'! checkEOD "Check if the document shouldn't be ended already" self eod ifTrue: [self driver errorExpected: 'No more data expected,']! ! !SAXHandler methodsFor: 'content' stamp: 'mir 1/17/2002 13:12'! documentAttributes: attributeList! ! !SAXHandler methodsFor: 'content' stamp: 'mir 1/8/2002 18:26'! endDocument "This call corresponds to the Java SAX call endDocument()." eod _ true! ! !SAXHandler methodsFor: 'content' stamp: 'mir 8/14/2000 18:07'! endElement: elementName ! ! !SAXHandler methodsFor: 'content' stamp: 'mir 1/8/2002 18:26'! endElement: elementName namespaceURI: namespaceURI qualifiedName: qualifiedName "This call corresponds to the Java SAX call endElement(java.lang.String namespaceURI, java.lang.String localName, java.lang.String qName). By default this call is mapped to the following more convenient call:" self endElement: elementName! ! !SAXHandler methodsFor: 'content' stamp: 'mir 8/11/2000 16:25'! endPrefixMapping: prefix "This call corresonds to the Java SAX call endPrefixMapping(java.lang.String prefix)."! ! !SAXHandler methodsFor: 'content' stamp: 'mir 8/11/2000 16:25'! ignorableWhitespace: aString "This call corresonds to the Java SAX call ignorableWhitespace(char[] ch, int start, int length)."! ! !SAXHandler methodsFor: 'content' stamp: 'mir 8/11/2000 16:26'! processingInstruction: piName data: dataString "This call corresonds to the Java SAX call processingInstruction(java.lang.String target, java.lang.String data)."! ! !SAXHandler methodsFor: 'content' stamp: 'mir 8/11/2000 16:45'! skippedEntity: aString "This call corresonds to the Java SAX call skippedEntity(java.lang.String name)."! ! !SAXHandler methodsFor: 'content' stamp: 'mir 8/11/2000 16:45'! startDocument "This call corresonds to the Java SAX call startDocument()."! ! !SAXHandler methodsFor: 'content' stamp: 'mir 8/14/2000 18:07'! startElement: elementName attributeList: attributeList ! ! !SAXHandler methodsFor: 'content' stamp: 'mir 8/11/2000 17:14'! startElement: elementName namespaceURI: namespaceURI qualifiedName: qualifiedName attributeList: attributeList "This call corresonds to the Java SAX call startElement(java.lang.String namespaceURI, java.lang.String localName, java.lang.String qName, Attributes atts). By default this call is mapped to the following more convenient call:" self startElement: elementName attributeList: attributeList! ! !SAXHandler methodsFor: 'content' stamp: 'mir 8/11/2000 16:47'! startPrefixMapping: prefix uri: uri "This call corresonds to the Java SAX call startPrefixMapping(java.lang.String prefix, java.lang.String uri)."! ! !SAXHandler methodsFor: 'initialize' stamp: 'mir 1/8/2002 18:18'! initialize eod _ false! ! !SAXHandler methodsFor: 'accessing' stamp: 'mir 11/30/2000 18:12'! document ^document! ! !SAXHandler methodsFor: 'accessing' stamp: 'mir 11/30/2000 18:12'! document: aDocument document _ aDocument! ! !SAXHandler methodsFor: 'accessing' stamp: 'mir 12/7/2000 15:34'! driver ^driver! ! !SAXHandler methodsFor: 'accessing' stamp: 'mir 12/7/2000 15:34'! driver: aDriver driver _ aDriver. driver saxHandler: self! ! !SAXHandler methodsFor: 'accessing' stamp: 'mir 1/8/2002 18:18'! eod ^eod! ! !SAXHandler class methodsFor: 'instance creation' stamp: 'mir 8/14/2000 18:29'! new ^super new initialize! ! !SAXHandler class methodsFor: 'instance creation' stamp: 'mir 12/18/2000 12:31'! on: aStream | driver parser | driver _ SAXDriver on: aStream. driver validation: true. parser _ self new driver: driver. ^parser! ! !SAXHandler class methodsFor: 'instance creation' stamp: 'mir 6/28/2001 18:57'! parseDTDFrom: aStream | driver parser | driver _ SAXDriver on: aStream. driver validation: true. driver startParsingMarkup. parser _ self new driver: driver. parser startDocument. parser parseDocument. ^parser! ! !SAXHandler class methodsFor: 'instance creation' stamp: 'mir 1/17/2002 13:54'! parseDocumentFrom: aStream | driver parser | driver _ SAXDriver on: aStream. driver validating: true. parser _ self new driver: driver. parser startDocument. parser parseDocument. ^parser! ! !SAXHandler class methodsFor: 'instance creation' stamp: 'mir 1/8/2002 15:55'! parseDocumentFromFileNamed: fileName ^self parseDocumentFromFileNamed: fileName readIntoMemory: false! ! !SAXHandler class methodsFor: 'instance creation' stamp: 'mir 1/8/2002 15:55'! parseDocumentFromFileNamed: fileName readIntoMemory: readIntoMemory | stream xmlDoc | stream _ FileDirectory default readOnlyFileNamed: fileName. readIntoMemory ifTrue: [stream _ stream contentsOfEntireFile readStream]. [xmlDoc _ self parseDocumentFrom: stream] ensure: [stream close]. ^xmlDoc! ! !XMLDOMParser methodsFor: 'private' stamp: 'mir 1/8/2001 12:04'! pop | oldTop | oldTop _ self stack removeLast. entity _ oldTop. ^oldTop! ! !XMLDOMParser methodsFor: 'private' stamp: 'mir 1/8/2001 12:02'! push: anObject self stack add: anObject. entity _ anObject ! ! !XMLDOMParser methodsFor: 'private' stamp: 'mir 8/14/2000 18:28'! stack ^stack! ! !XMLDOMParser methodsFor: 'private' stamp: 'mir 1/8/2001 11:46'! top ^self stack isEmpty ifTrue: [nil] ifFalse: [self stack last]! ! !XMLDOMParser methodsFor: 'content' stamp: 'mir 10/25/2000 11:30'! characters: aString | newElement | newElement _ XMLStringNode string: aString. self top addContent: newElement. ! ! !XMLDOMParser methodsFor: 'content' stamp: 'mir 1/17/2002 13:13'! documentAttributes: attributeList self document version: (attributeList at: 'version' ifAbsent: [nil]). self document encoding: (attributeList at: 'encoding' ifAbsent: [nil]). self document requiredMarkup: (attributeList at: 'requiredMarkup' ifAbsent: [nil]). ! ! !XMLDOMParser methodsFor: 'content' stamp: 'mir 1/8/2002 18:19'! endDocument self pop. super endDocument! ! !XMLDOMParser methodsFor: 'content' stamp: 'mir 1/8/2002 18:11'! endElement: elementName | currentElement | currentElement _ self pop. currentElement name = elementName ifFalse: [self driver errorExpected: 'End tag "', elementName , '" doesn''t match "' , currentElement name , '".']! ! !XMLDOMParser methodsFor: 'content' stamp: 'mir 1/17/2002 13:04'! processingInstruction: piName data: dataString | newElement | newElement _ XMLPI target: piName data: dataString. self top addEntity: newElement! ! !XMLDOMParser methodsFor: 'content' stamp: 'mir 11/30/2000 18:14'! startDocument self document: XMLDocument new. self push: self document ! ! !XMLDOMParser methodsFor: 'content' stamp: 'mir 1/8/2001 12:06'! startElement: elementName attributeList: attributeList | newElement | newElement _ XMLElement named: elementName attributes: attributeList. self incremental ifFalse: [self stack isEmpty ifFalse: [self top addEntity: newElement]]. self push: newElement! ! !XMLDOMParser methodsFor: 'accessing' stamp: 'mir 1/8/2001 12:05'! incremental ^incremental! ! !XMLDOMParser methodsFor: 'accessing' stamp: 'mir 1/8/2001 12:05'! incremental: aBoolean incremental _ aBoolean! ! !XMLDOMParser methodsFor: 'parsing' stamp: 'mir 6/28/2001 18:45'! nextEntity | currentTop | currentTop _ self top. [self driver nextEntity isNil or: [self top ~~ currentTop]] whileTrue. ^entity! ! !XMLDOMParser methodsFor: 'parsing' stamp: 'mir 12/21/2000 14:02'! nextEntityStart [self driver nextEntity. self stack isEmpty] whileTrue. ^entity! ! !XMLDOMParser methodsFor: 'initialize' stamp: 'mir 1/8/2001 12:05'! initialize super initialize. stack _ OrderedCollection new. incremental _ false! ! !XMLDOMParser class methodsFor: 'examples' stamp: 'mir 8/14/2000 18:36'! addressBookXMLWithDTD "XMLDOMParser addressBookXMLWithDTD" ^self parseDocumentFrom: XMLTokenizer addressBookXMLWithDTD readStream! ! !XMLDOMParser class methodsFor: 'instance creation' stamp: 'mir 12/7/2000 16:29'! parseDocumentFrom: aStream ^(super parseDocumentFrom: aStream) document! ! !XMLNode methodsFor: 'printing' stamp: 'mir 1/17/2002 15:45'! printOn: stream self printXMLOn: (XMLWriter on: stream)! ! !XMLNode methodsFor: 'printing' stamp: 'mir 1/17/2002 15:45'! printXMLOn: writer self subclassResponsibility! ! !XMLNode methodsFor: 'accessing' stamp: 'mir 1/8/2002 18:44'! addContent: contentString SAXParseException signal: 'Illegal string data.'! ! !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: 'mir 1/17/2002 15:03'! tagsNamed: aSymbol childrenDo: aOneArgumentBlock "Evaluate aOneArgumentBlock for all children who match" self contentsDo: [:each | each tagsNamed: aSymbol ifReceiverDo: aOneArgumentBlock]! ! !XMLNode methodsFor: 'searching' stamp: 'mir 1/17/2002 15:03'! tagsNamed: aSymbol childrenDoAndRecurse: aOneArgumentBlock "Evaluate aOneArgumentBlock for all children who match and recurse" self contentsDo: [:each | each tagsNamed: aSymbol ifReceiverDoAndRecurse: 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: 'enumerating' stamp: 'mir 1/17/2002 14:49'! contentsDo: aBlock! ! !XMLNode methodsFor: 'testing' stamp: 'mir 1/17/2002 15:28'! isProcessingInstruction ^false! ! !XMLNode methodsFor: 'testing' stamp: 'mir 1/17/2002 15:26'! isTag ^false! ! !XMLNode methodsFor: 'testing' stamp: 'mir 1/17/2002 15:26'! isText ^false! ! !XMLNodeWithEntities methodsFor: 'accessing' stamp: 'mir 10/25/2000 11:22'! addEntity: entity self addEntity: entity name value: entity! ! !XMLNodeWithEntities methodsFor: 'accessing' stamp: 'mir 10/25/2000 11:22'! addEntity: entityName value: entityValue self entities add: entityName->entityValue! ! !XMLNodeWithEntities methodsFor: 'accessing'! elements ^(self entities collect: [:each | each value]) , self contents! ! !XMLNodeWithEntities methodsFor: 'accessing' stamp: 'mir 10/25/2000 11:22'! entities entities ifNil: [entities _ OrderedCollection new]. ^entities! ! !XMLNodeWithEntities methodsFor: 'accessing' stamp: 'mir 10/25/2000 11:23'! entityAt: entityName ^self entityAt: entityName ifAbsent: [nil]! ! !XMLNodeWithEntities methodsFor: 'accessing' stamp: 'mir 1/18/2001 16:29'! entityAt: entityName ifAbsent: aBlock ^(entities detect: [:each | each key = entityName] ifNone: [^aBlock value]) value! ! !XMLNodeWithEntities methodsFor: 'accessing'! topElement ^self entities first value! ! !XMLNodeWithEntities methodsFor: 'enumerating' stamp: 'mir 10/25/2000 11:23'! entitiesDo: aBlock entities ifNotNil: [ self entities do: [:each | aBlock value: each key value: each value]]! ! !XMLNodeWithEntities methodsFor: 'printing' stamp: 'mir 1/17/2002 15:57'! printXMLOn: writer self entitiesDo: [:eName :eValue | eValue printXMLOn: writer]! ! !XMLDocument methodsFor: 'accessing' stamp: 'mir 11/30/2000 17:48'! dtd ^dtd! ! !XMLDocument methodsFor: 'accessing' stamp: 'mir 11/30/2000 17:48'! dtd: aDTD dtd _ aDTD! ! !XMLDocument methodsFor: 'accessing' stamp: 'mir 1/17/2002 12:57'! encoding ^encoding! ! !XMLDocument methodsFor: 'accessing' stamp: 'mir 1/17/2002 12:57'! encoding: aString encoding _ aString! ! !XMLDocument methodsFor: 'accessing' stamp: 'mir 1/17/2002 12:57'! requiredMarkup ^requiredMarkup! ! !XMLDocument methodsFor: 'accessing' stamp: 'mir 1/17/2002 12:57'! requiredMarkup: aString requiredMarkup _ aString! ! !XMLDocument methodsFor: 'accessing' stamp: 'mir 1/17/2002 12:57'! version ^version! ! !XMLDocument methodsFor: 'accessing' stamp: 'mir 1/17/2002 12:57'! version: aString version _ aString! ! !XMLDocument methodsFor: 'printing' stamp: 'mir 1/17/2002 16:44'! printCanonicalOn: aStream | writer | writer _ XMLWriter on: aStream. writer canonical: true. self printXMLOn: writer! ! !XMLDocument methodsFor: 'printing' stamp: 'mir 1/17/2002 16:45'! printXMLOn: writer version ifNotNil: [writer xmlDeclaration: self version]. super printXMLOn: writer! ! !XMLElement methodsFor: 'initialize' stamp: 'mir 8/14/2000 17:58'! addContent: contentString self contents add: contentString! ! !XMLElement methodsFor: 'initialize' stamp: 'mir 1/17/2002 15:24'! name: aString name _ aString asSymbol! ! !XMLElement methodsFor: 'initialize' stamp: 'mir 3/7/2000 16:43'! setAttributes: newAttributes attributes _ newAttributes! ! !XMLElement methodsFor: 'searching' stamp: 'mir 1/17/2002 15:02'! firstTagNamed: aSymbol "Return the first encountered node with the specified tag. If it is not the receiver, pass the message on" self tag == aSymbol ifTrue: [^self]. ^super firstTagNamed: aSymbol ! ! !XMLElement methodsFor: 'searching' stamp: 'mir 1/17/2002 15:02'! 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" (self tag == aSymbol and: [aBlock value: self]) ifTrue: [^self]. ^super firstTagNamed: aSymbol with: aBlock.! ! !XMLElement methodsFor: 'searching' stamp: 'mir 1/17/2002 15: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" self tag == aSymbol ifTrue: [self contentsDo: aBlock]. super tagsNamed: aSymbol contentsDo: aBlock! ! !XMLElement methodsFor: 'searching' stamp: 'mir 1/17/2002 15:03'! tagsNamed: aSymbol do: aOneArgumentBlock "If the receiver tag equals aSymbol, evaluate aOneArgumentBlock with the receiver. Continue the search" self tag == aSymbol ifTrue: [aOneArgumentBlock value: self]. super tagsNamed: aSymbol do: aOneArgumentBlock! ! !XMLElement methodsFor: 'searching' stamp: 'mir 1/17/2002 15:04'! tagsNamed: aSymbol ifReceiverDo: aOneArgumentBlock "If the receiver tag equals aSymbol, evaluate aOneArgumentBlock with the receiver" self tag == aSymbol ifTrue: [aOneArgumentBlock value: self] ! ! !XMLElement methodsFor: 'searching' stamp: 'mir 1/17/2002 15:04'! tagsNamed: aSymbol ifReceiverDoAndRecurse: aOneArgumentBlock "If the receiver tag equals aSymbol, evaluate aOneArgumentBlock with the receiver. Then recurse through all the children" self tag == aSymbol ifTrue: [aOneArgumentBlock value: self]. super tagsNamed: aSymbol ifReceiverDoAndRecurse: aOneArgumentBlock! ! !XMLElement methodsFor: 'searching' stamp: 'mir 1/17/2002 15: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" self tag == aSymbol ifTrue: [aOneArgumentBlock value: self]. super tagsNamed: aSymbol ifReceiverDo: aOneArgumentBlock! ! !XMLElement methodsFor: 'enumerating' stamp: 'mir 10/25/2000 11:15'! contentsDo: aBlock contents ifNotNil: [ self contents do: [:each | aBlock value: each]]! ! !XMLElement methodsFor: 'accessing' stamp: 'mir 1/18/2001 16:55'! attributeAt: attributeName ^self attributeAt: attributeName ifAbsent: [nil]! ! !XMLElement methodsFor: 'accessing' stamp: 'mir 1/18/2001 16:55'! attributeAt: attributeName ifAbsent: aBlock ^self attributes at: attributeName ifAbsent: [^aBlock value]! ! !XMLElement methodsFor: 'accessing' stamp: 'mir 1/17/2002 15:24'! attributeAt: attributeName put: attributeValue self attributes at: attributeName asSymbol put: attributeValue! ! !XMLElement methodsFor: 'accessing' stamp: 'mir 3/7/2000 16:24'! attributes ^attributes! ! !XMLElement methodsFor: 'accessing'! characterData ^self contentString! ! !XMLElement methodsFor: 'accessing' stamp: 'mir 1/18/2001 16:27'! contentString ^(self contents size == 1 and: [self contents first isKindOf: XMLStringNode]) ifTrue: [self contents first string] ifFalse: ['']! ! !XMLElement methodsFor: 'accessing' stamp: 'mir 1/17/2002 09:32'! contentStringAt: entityName ^(self entityAt: entityName ifAbsent: [^'']) string! ! !XMLElement methodsFor: 'accessing' stamp: 'mir 8/14/2000 17:58'! contents contents ifNil: [contents _ OrderedCollection new]. ^contents! ! !XMLElement methodsFor: 'accessing' stamp: 'mir 3/7/2000 16:33'! name ^name! ! !XMLElement methodsFor: 'accessing' stamp: 'mir 1/17/2002 14:48'! tag ^name asSymbol! ! !XMLElement methodsFor: 'accessing' stamp: 'mir 1/17/2002 15:28'! valueFor: aSymbol ^self attributes at: aSymbol ifAbsent: ['']! ! !XMLElement methodsFor: 'accessing' stamp: 'mir 1/17/2002 15:28'! valueFor: aSymbol ifAbsent: aBlock ^self attributes at: aSymbol ifAbsent: aBlock! ! !XMLElement methodsFor: 'printing' stamp: 'mir 1/17/2002 16:58'! printXMLOn: writer writer startElement: self name attributeList: self attributes. (writer canonical not and: [self isEmpty and: [self attributes isEmpty not]]) ifTrue: [writer endEmptyTag: self name] ifFalse: [ writer endTag. self contentsDo: [:content | content printXMLOn: writer]. super printXMLOn: writer. writer endTag: self name]! ! !XMLElement methodsFor: 'testing' stamp: 'mir 1/17/2002 16:04'! isEmpty ^self entities isEmpty and: [self contents isEmpty]! ! !XMLElement methodsFor: 'testing' stamp: 'mir 1/17/2002 15:26'! isTag ^true! ! !XMLElement class methodsFor: 'instance creation' stamp: 'mir 3/7/2000 16:33'! named: aString ^self new name: aString! ! !XMLElement class methodsFor: 'instance creation' stamp: 'mir 8/14/2000 18:01'! named: aString attributes: attributeList ^self new name: aString; setAttributes: attributeList! ! !XMLPI methodsFor: 'accessing' stamp: 'mir 1/17/2002 13:02'! data ^data! ! !XMLPI methodsFor: 'accessing' stamp: 'mir 1/17/2002 13:02'! data: aString data _ aString! ! !XMLPI methodsFor: 'accessing' stamp: 'mir 1/17/2002 13:02'! target ^target! ! !XMLPI methodsFor: 'accessing' stamp: 'mir 1/17/2002 13:02'! target: aString target _ aString! ! !XMLPI methodsFor: 'testing' stamp: 'mir 1/17/2002 15:28'! isProcessingInstruction ^true! ! !XMLPI methodsFor: 'printing' stamp: 'mir 1/17/2002 15:53'! printXMLOn: writer writer pi: self target data: self data! ! !XMLPI class methodsFor: 'instance creation' stamp: 'mir 1/17/2002 13:03'! target: targetName data: aString ^self new target: targetName; data: aString! ! !XMLStringNode methodsFor: 'accessing'! characterData ^self string! ! !XMLStringNode methodsFor: 'accessing' stamp: 'mir 10/25/2000 11:28'! string ^string ifNil: ['']! ! !XMLStringNode methodsFor: 'accessing' stamp: 'mir 10/25/2000 11:28'! string: aString string _ aString! ! !XMLStringNode methodsFor: 'printing' stamp: 'mir 1/17/2002 15:53'! printXMLOn: writer writer pcData: self string! ! !XMLStringNode methodsFor: 'testing' stamp: 'mir 1/17/2002 15:27'! isText ^true! ! !XMLStringNode class methodsFor: 'instance creation' stamp: 'mir 10/25/2000 11:30'! string: aString ^self new string: aString! ! !XMLTokenizer methodsFor: 'accessing' stamp: 'mir 6/28/2001 16:51'! parseStream: aStream self stream: aStream! ! !XMLTokenizer methodsFor: 'accessing' stamp: 'mir 1/14/2002 17:51'! validating: aBoolean validating _ aBoolean! ! !XMLTokenizer methodsFor: 'handling tokens' stamp: 'mir 11/13/2000 16:04'! handleCData: aString self log: 'CData: ' , aString! ! !XMLTokenizer methodsFor: 'handling tokens' stamp: 'mir 8/14/2000 11:37'! handleComment: aString self log: 'Comment: ' , aString! ! !XMLTokenizer methodsFor: 'handling tokens' stamp: 'mir 8/14/2000 18:27'! handleEndDocument self log: 'End Doc '! ! !XMLTokenizer methodsFor: 'handling tokens' stamp: 'mir 8/14/2000 11:38'! handleEndTag: aString self log: 'End tag: ' , aString! ! !XMLTokenizer methodsFor: 'handling tokens' stamp: 'mir 8/14/2000 11:38'! handlePCData: aString self log: 'PCData: ' , aString! ! !XMLTokenizer methodsFor: 'handling tokens' stamp: 'mir 12/11/2000 16:10'! handlePI: piTarget data: piData self log: 'PI: ' , piTarget , ' data ' , piData! ! !XMLTokenizer methodsFor: 'handling tokens' stamp: 'mir 8/14/2000 18:26'! handleStartDocument self log: 'Start Doc'! ! !XMLTokenizer methodsFor: 'handling tokens' stamp: 'mir 8/14/2000 11:39'! handleStartTag: tagName attributes: attributes self log: 'Start tag: ' , tagName. attributes keysAndValuesDo: [:key :value | self log: key , '->' , value]! ! !XMLTokenizer methodsFor: 'handling tokens' stamp: 'mir 1/17/2002 13:15'! handleXMLDecl: attributes attributes keysAndValuesDo: [:key :value | self log: key , '->' , value]! ! !XMLTokenizer methodsFor: 'private' stamp: 'mir 11/13/2000 18:19'! endParsingMarkup parsingMarkup _ false! ! !XMLTokenizer methodsFor: 'private' stamp: 'mir 12/7/2000 16:46'! log: aString "Transcript show: aString; cr"! ! !XMLTokenizer methodsFor: 'private' stamp: 'mir 6/28/2001 16:54'! nestedStreams nestedStreams ifNil: [nestedStreams _ OrderedCollection new]. ^nestedStreams! ! !XMLTokenizer methodsFor: 'private' stamp: 'mir 11/13/2000 18:19'! parsingMarkup ^parsingMarkup! ! !XMLTokenizer methodsFor: 'private' stamp: 'mir 11/13/2000 18:19'! startParsingMarkup parsingMarkup _ true! ! !XMLTokenizer methodsFor: 'private' stamp: 'mir 6/28/2001 16:50'! stream ^stream! ! !XMLTokenizer methodsFor: 'private' stamp: 'mir 6/28/2001 16:50'! stream: newStream "Continue parsing from the new nested stream." stream _ newStream! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 1/17/2002 18:12'! checkAndExpandReference: parsingContext | referenceString nextChar | nextChar _ self peek. self validating ifFalse: [^nil]. nextChar == $& ifTrue: [ self next. self peek == $# ifTrue: [^self pushStream: (ReadStream on: self nextCharReference asString)]. referenceString _ self nextLiteral. self next == $; ifFalse: [self errorExpected: ';']. self handleEntity: referenceString in: parsingContext ] ifFalse: [ ((nextChar == $% and: [self parsingMarkup]) and: [parsingContext == #entityValue]) ifTrue: [ self skipSeparators. referenceString _ self nextLiteral. self handleEntity: referenceString in: parsingContext]]. self atEnd ifTrue: [self errorExpected: 'Character expected.']. ^nextChar! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 11/16/2000 21:41'! conditionalInclude: conditionalKeyword conditionalKeyword = 'INCLUDE' ifTrue: [^true]. conditionalKeyword = 'IGNORE' ifTrue: [^false]. ^self conditionalInclude: (self parameterEntity: conditionalKeyword) value! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 1/17/2002 16:10'! nextAttributeInto: attributes | attrName attrValue | attrName _ self nextName. self skipSeparators. self next == $= ifFalse: [self errorExpected: '=']. self skipSeparators. attrValue _ self nextAttributeValue. attributes at: attrName put: attrValue! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 1/17/2002 17:39'! nextAttributeValue | delimiterChar attributeValueStream nextChar nextPeek referenceString entity entityValue | delimiterChar _ self next. (delimiterChar == $" or: [delimiterChar == $']) ifFalse: [self errorExpected: 'Attribute value delimiter expected.']. attributeValueStream _ WriteStream on: (String new). [ nextPeek _ nextChar _ self peek. nextChar ifNil: [self errorExpected: 'Character expected.']. nextChar == $& ifTrue: [ self next. self peek == $# ifTrue: [ nextPeek _ nil. nextChar _ self nextCharReference] ifFalse: [ referenceString _ self nextLiteral. self next == $; ifFalse: [self errorExpected: ';']. entity _ self entity: referenceString. entityValue _ entity valueForContext: #content. (self class isCharEscape: entityValue) ifTrue: [ nextPeek _ nil. nextChar _ entityValue] ifFalse: [ entityValue _ entityValue asString. entityValue isEmpty ifTrue: [nextPeek _ nextChar _ nil] ifFalse: [ self pushStream: (ReadStream on: entityValue asString). nextPeek _ nextChar _ self next]]]] ifFalse: [self next]. nextPeek == delimiterChar] whileFalse: [ nextChar ifNotNil: [attributeValueStream nextPut: nextChar]]. ^attributeValueStream contents! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 1/17/2002 17:00'! nextCDataContent | cdata | "Skip $[ " self next. cdata _ self nextUpToAll: ']]>'. self handleCData: cdata ! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 12/6/2000 14:29'! nextCDataOrConditional | nextChar conditionalKeyword | "Skip [" self next. self skipSeparators. nextChar _ self peek. nextChar == $% ifTrue: [ self checkAndExpandReference: (self parsingMarkup ifTrue: [#dtd] ifFalse: [#content]). conditionalKeyword _ self nextLiteral. self skipSeparators. ^self next == $[ ifTrue: [ self skipSeparators. self nextIncludeSection: (self conditionalInclude: conditionalKeyword)] ifFalse: [self errorExpected: '[' ]]. nextChar == $C ifTrue: [ ^self nextLiteral = 'CDATA' ifTrue: [self peek == $[ ifTrue: [self nextCDataContent] ifFalse: [self errorExpected: '[' ]] ifFalse: [self errorExpected: 'CData']]. self errorExpected: 'CData or declaration' ! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 1/9/2002 18:48'! nextCharReference | base numberString charValue | self next == $# ifFalse: [self errorExpected: 'character reference']. base _ self peek == $x ifTrue: [ self next. 16] ifFalse: [10]. numberString _ self nextUpTo: $;. charValue _ [Number readFrom: numberString base: base] on: Error do: [:ex | self errorExpected: 'Number.']. ^charValue > 255 ifTrue: [^$-] ifFalse: [charValue asCharacter] ! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 11/28/2000 17:54'! nextComment | string | "Skip first -" self next. self next == $- ifFalse: [self errorExpected: 'second comment $-']. string _ self nextUpToAll: '-->'. self handleComment: string! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 11/28/2000 17:52'! nextEndTag | string | "Skip /" self next. self skipSeparators. string _ (self nextUpTo: $>) withBlanksTrimmed. self handleEndTag: string! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 1/17/2002 17:21'! nextEntity "return the next XMLnode, or nil if there are no more" "branch, depending on what the first character is" self skipSeparators. self atEnd ifTrue: [ self handleEndDocument. ^nil]. self checkAndExpandReference: (self parsingMarkup ifTrue: [#dtd] ifFalse: [#content]). ^self peek = $< ifTrue: [self nextNode] ifFalse: [self nextPCData]! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 1/17/2002 18:14'! nextEntityValue | delimiterChar entityValueStream nextChar nextPeek referenceString entity entityValue | delimiterChar _ self next. (delimiterChar == $" or: [delimiterChar == $']) ifFalse: [self errorExpected: 'Entity value delimiter expected.']. entityValueStream _ WriteStream on: (String new). [ nextPeek _ nextChar _ self peek. nextChar ifNil: [self errorExpected: 'Character expected.']. nextChar == $& ifTrue: [ self next. self peek == $# ifTrue: [ nextPeek _ nil. nextChar _ self nextCharReference] ifFalse: [ referenceString _ self nextLiteral. self next == $; ifFalse: [self errorExpected: ';']. entity _ self entity: referenceString. entityValue _ entity valueForContext: #entityValue. self pushStream: (ReadStream on: entityValue asString). nextPeek _ nextChar _ self next]] ifFalse: [ nextChar == $% ifTrue: [ self skipSeparators. referenceString _ self nextLiteral. nextChar _ self handleEntity: referenceString in: #entityValue. nextPeek _ nextChar _ self next] ifFalse: [self next]]. nextPeek == delimiterChar] whileFalse: [ nextChar ifNotNil: [entityValueStream nextPut: nextChar]]. ^entityValueStream contents! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 6/28/2001 16:38'! nextIncludeSection: parseSection | section | "Read the file up to the next include section delimiter and parse it if parseSection is true" section _ self nextUpToAll: ']]>'. parseSection ifTrue: [ self pushStream: (ReadStream on: section)]! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 1/25/2002 16:46'! nextLiteral | resultStream nextChar validChars resultString | validChars _ ':-_.' asSet. resultStream _ (String new: 10) writeStream. ((nextChar _ self peek) isLetter or: [nextChar == $_]) ifFalse: [self errorExpected: 'Name literal.']. [nextChar _ self peek. (nextChar isLetter or: [nextChar isDigit or: [validChars includes: nextChar]]) not ifTrue: [ resultString _ resultStream contents. resultString isEmpty ifTrue: [self errorExpected: 'Name literal'] ifFalse: [^resultString]] ifFalse: [ nextChar == $& ifTrue: [ nextChar _ self next. resultStream nextPut: (self peek == $# ifTrue: [self nextCharReference] ifFalse: [^resultStream contents])] ifFalse: [ resultStream nextPut: self next]]] repeat! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 1/16/2002 10:51'! nextName | resultStream nextChar | resultStream _ WriteStream on: (String new: 10). (self peek isNil or: [self peek == $.]) ifTrue: [self malformedError: 'Character expected.']. [nextChar _ self peek. nextChar isNil ifTrue: [self errorExpected: 'Character expected.']. NameDelimiters at: nextChar asciiValue] whileFalse: [ resultStream nextPut: self next]. ^resultStream contents! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 11/28/2000 17:52'! nextNode | nextChar | "Skip < " self next. nextChar _ self peek. nextChar == $!! ifTrue: [ "Skip !!" self next. nextChar _ self peek. nextChar == $- ifTrue: [^self nextComment]. nextChar == $[ ifTrue: [^self nextCDataOrConditional]. ^self parsingMarkup ifTrue: [self nextMarkupDeclaration] ifFalse: [self nextDocType]]. nextChar == $? ifTrue: [^self nextPI]. ^self nextTag! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 1/17/2002 18:01'! nextPCData | resultStream nextChar referenceString entity entityValue nextPeek | resultStream _ (String new: 10) writeStream. self validating ifFalse: [ [self peek == $<] whileFalse: [resultStream nextPut: self next]. ^self handlePCData: resultStream contents]. [ nextPeek _ nextChar _ self peek. nextChar ifNil: [self errorExpected: 'Character expected.']. nextChar == $& ifTrue: [ self next. self peek == $# ifTrue: [ nextPeek _ nil. nextChar _ self nextCharReference] ifFalse: [ referenceString _ self nextLiteral. self next == $; ifFalse: [self errorExpected: ';']. entity _ self entity: referenceString. entityValue _ entity valueForContext: #content. (self class isCharEscape: entityValue) ifTrue: [ nextPeek _ nil. nextChar _ entityValue] ifFalse: [ entityValue _ entityValue asString. entityValue isEmpty ifTrue: [nextPeek _ nextChar _ nil] ifFalse: [ self pushStream: (ReadStream on: entityValue asString). nextPeek _ nextChar _ self peek]]]] ifFalse: [nextPeek == $< ifFalse: [self next]]. nextPeek == $<] whileFalse: [ nextChar ifNotNil: [resultStream nextPut: nextChar]]. self handlePCData: resultStream contents! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 1/17/2002 13:00'! nextPI | piTarget piData | "Skip ?" self next. piTarget _ self nextLiteral. piTarget asUppercase = 'XML' ifTrue: [^self nextXMLDecl]. self skipSeparators. piData _ self nextUpToAll: '?>'. self handlePI: piTarget data: piData! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 1/17/2002 14:25'! nextPubidLiteral ^self nextAttributeValue! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 1/17/2002 14:25'! nextSystemLiteral ^self nextAttributeValue! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 1/15/2002 22:36'! nextTag | tagName attributes nextChar | (self peek = $/) ifTrue: [^self nextEndTag]. tagName _ self nextName. self skipSeparators. attributes _ Dictionary new. [(nextChar _ self peek) == $> or: [nextChar == $/]] whileFalse: [ self checkAndExpandReference: #content. self nextAttributeInto: attributes. self skipSeparators.]. self handleStartTag: tagName attributes: attributes. self next == $/ ifTrue: [ self handleEndTag: tagName. self next]. ! ! !XMLTokenizer methodsFor: 'tokenizing' stamp: 'mir 1/17/2002 13:21'! nextXMLDecl | attributes nextChar | self skipSeparators. attributes _ Dictionary new. [(nextChar _ self peek) == $?] whileFalse: [ self nextAttributeInto: attributes. self skipSeparators.]. self next. self next == $> ifFalse: [self errorExpected: '> expected.']. self handleXMLDecl: attributes! ! !XMLTokenizer methodsFor: 'tokenizing dtd' stamp: 'mir 6/29/2001 00:08'! endDocTypeDecl "Skip ]>" self next; next. ^nil! ! !XMLTokenizer methodsFor: 'tokenizing dtd' stamp: 'mir 1/8/2002 13:54'! nextDocType | declType | declType _ self nextLiteral. declType = 'DOCTYPE' ifTrue: [ self startParsingMarkup. ^self nextDocTypeDecl]. self errorExpected: 'markup declaration, not ' , declType printString! ! !XMLTokenizer methodsFor: 'tokenizing dtd' stamp: 'mir 1/17/2002 17:29'! nextDocTypeDecl | nextChar | self skipSeparators. self nextLiteral. self skipSeparators. self peek == $[ ifFalse: [[nextChar _ self peek. nextChar == $> or: [nextChar == $[ ]] whileFalse: [self next]]. self peek == $[ ifTrue: [ self next. [self skipSeparators. self peek == $]] whileFalse: [ self checkAndExpandReference: #dtd. self nextNode]. self next == $] ifFalse: [self errorExpected: ']' ]]. self skipSeparators. self next == $> ifFalse: [self errorExpected: '>' ]. self endParsingMarkup! ! !XMLTokenizer methodsFor: 'tokenizing dtd' stamp: 'mir 1/17/2002 14:24'! nextEntityDeclaration | entityName entityDef referenceClass reference | self skipSeparators. referenceClass _ self peek == $% ifTrue: [ self next. self skipSeparators. DTDParameterEntityDeclaration] ifFalse: [DTDEntityDeclaration]. entityName _ self nextLiteral. self skipSeparators. entityDef _ (self peek == $" or: [self peek == $']) ifTrue: [self nextEntityValue] ifFalse: [self nextExternalId]. self skipUpTo: $>. reference _ referenceClass name: entityName value: entityDef. reference registerIn: self. ^reference! ! !XMLTokenizer methodsFor: 'tokenizing dtd' stamp: 'mir 1/17/2002 14:33'! nextExternalId | extDefType systemId dir | extDefType _ self nextLiteral. extDefType = 'PUBLIC' ifTrue: [ self skipSeparators. self nextPubidLiteral. self skipSeparators. self peek == $> ifFalse: [ systemId _ self nextSystemLiteral]]. extDefType = 'SYSTEM' ifTrue: [ self skipSeparators. systemId _ self nextSystemLiteral]. systemId ifNil: [^nil]. dir _ self topStream directory. ^(dir fileExists: systemId) ifTrue: [(dir readOnlyFileNamed: systemId) contentsOfEntireFile] ifFalse: ['']! ! !XMLTokenizer methodsFor: 'tokenizing dtd' stamp: 'mir 1/17/2002 13:49'! nextMarkupDeclaration | declType | declType _ self nextLiteral. self validating ifFalse: [^self skipMarkupDeclaration]. declType = 'ENTITY' ifTrue: [self nextEntityDeclaration] ifFalse: [self skipMarkupDeclaration]! ! !XMLTokenizer methodsFor: 'tokenizing dtd' stamp: 'mir 1/4/2002 11:05'! skipMarkupDeclaration self skipUpTo: $>! ! !XMLTokenizer methodsFor: 'testing' stamp: 'mir 1/14/2002 17:51'! validating ^validating! ! !XMLTokenizer methodsFor: 'initialize' stamp: 'mir 1/16/2002 00:38'! initialize parsingMarkup _ false. validating _ false! ! !XMLTokenizer methodsFor: 'errors' stamp: 'mir 11/13/2000 15:55'! errorExpected: expectedString self parseError: 'XML expected ' , expectedString printString , ': ' , (stream next: 20)! ! !XMLTokenizer methodsFor: 'errors' stamp: 'mir 1/9/2002 15:26'! malformedError: errorString SAXMalformedException signal: errorString! ! !XMLTokenizer methodsFor: 'errors' stamp: 'mir 1/8/2002 15:37'! parseError: errorString SAXParseException signal: errorString! ! !XMLTokenizer methodsFor: 'streaming' stamp: 'mir 6/29/2001 00:10'! atEnd self hasNestedStreams ifFalse: [^peekChar isNil and: [self stream atEnd]]. ^self stream atEnd ifTrue: [ self popNestingLevel. self atEnd] ifFalse: [false]! ! !XMLTokenizer methodsFor: 'streaming' stamp: 'mir 6/29/2001 00:11'! checkNestedStream self hasNestedStreams ifTrue: [(peekChar isNil and: [self stream atEnd]) ifTrue: [ self popNestingLevel. self checkNestedStream]] ! ! !XMLTokenizer methodsFor: 'streaming' stamp: 'mir 6/28/2001 16:45'! hasNestedStreams ^nestedStreams notNil! ! !XMLTokenizer methodsFor: 'streaming' stamp: 'mir 1/8/2002 15:08'! next "Return the next character from the current input stream. If the current stream is at end pop to next nesting level if there is one. Due to the potential nesting of original document, included documents and replacment texts the streams are held in a stack representing the nested streams. The current stream is the top one." | nextChar | nestedStreams ifNotNil: [self checkNestedStream]. peekChar ifNil: [nextChar _ self stream next] ifNotNil: [ nextChar _ peekChar. peekChar _ nil]. ^nextChar! ! !XMLTokenizer methodsFor: 'streaming' stamp: 'mir 1/16/2002 10:58'! nextUpTo: delimiter | resultStream nextChar | self unpeek. resultStream _ WriteStream on: (String new: 10). [self atEnd or: [(nextChar _ self next) == delimiter]] whileFalse: [resultStream nextPut: nextChar]. nextChar == delimiter ifFalse: [self parseError: 'XML no delimiting ' , delimiter printString , ' found']. ^resultStream contents ! ! !XMLTokenizer methodsFor: 'streaming' stamp: 'mir 1/9/2002 15:29'! nextUpToAll: delimitingString | string | self unpeek. string _ self stream upToAll: delimitingString. self stream skip: delimitingString size negated. (self stream next: delimitingString size) = delimitingString ifFalse: [self parseError: 'XML no delimiting ' , delimitingString printString , ' found']. ^string ! ! !XMLTokenizer methodsFor: 'streaming' stamp: 'mir 6/28/2001 23:33'! peek "Return the next character from the current input stream. If the current stream poop to next nesting level if there is one. Due to the potential nesting of original document, included documents and replacment texts the streams are held in a stack representing the nested streams. The current stream is the top one." nestedStreams ifNotNil: [self checkNestedStream]. peekChar ifNil: [peekChar _ self stream next]. ^peekChar! ! !XMLTokenizer methodsFor: 'streaming' stamp: 'mir 6/29/2001 00:36'! popNestingLevel self hasNestedStreams ifTrue: [ self stream close. self stream: self nestedStreams removeLast. self nestedStreams size > 0 ifFalse: [nestedStreams _ nil]]! ! !XMLTokenizer methodsFor: 'streaming' stamp: 'mir 1/16/2002 10:50'! pushBack: aString | pushBackString | pushBackString _ peekChar ifNil: [aString] ifNotNil: [peekChar asString , aString]. peekChar _ nil. self pushStream: (ReadStream on: pushBackString)! ! !XMLTokenizer methodsFor: 'streaming' stamp: 'mir 1/16/2002 10:54'! pushStream: newStream "Continue parsing from the new nested stream." self unpeek. self nestedStreams addLast: self stream. self stream: newStream! ! !XMLTokenizer methodsFor: 'streaming' stamp: 'mir 6/29/2001 00:41'! skipSeparators | nextChar | [(nextChar _ self peek) notNil and: [nextChar isSeparator]] whileTrue: [self next]. (self hasNestedStreams and: [self atEnd]) ifTrue: [ self checkNestedStream. self skipSeparators]! ! !XMLTokenizer methodsFor: 'streaming' stamp: 'mir 1/16/2002 10:42'! skipUpTo: delimiter | nextChar | self unpeek. [self atEnd or: [(nextChar _ self next) == delimiter]] whileFalse: []. nextChar == delimiter ifFalse: [self parseError: 'XML no delimiting ' , delimiter printString , ' found'] ! ! !XMLTokenizer methodsFor: 'streaming' stamp: 'mir 1/17/2002 14:31'! topStream ^self hasNestedStreams ifTrue: [self nestedStreams first] ifFalse: [self stream]! ! !XMLTokenizer methodsFor: 'streaming' stamp: 'mir 6/29/2001 00:07'! unpeek peekChar ifNotNil: [ peekChar _ nil. self stream skip: -1]! ! !XMLTokenizer methodsFor: 'entities' stamp: 'mir 1/14/2002 15:06'! entities entities ifNil: [entities _ self initEntities]. ^entities! ! !XMLTokenizer methodsFor: 'entities' stamp: 'mir 1/17/2002 13:53'! entity: refName ^self validating ifTrue: [self entities at: refName ifAbsentPut: [self parseError: 'XML undefined entity ' , refName printString]] ifFalse: [DTDEntityDeclaration name: refName value: ''] ! ! !XMLTokenizer methodsFor: 'entities' stamp: 'mir 11/16/2000 21:43'! entity: refName put: aReference "Only the first declaration of an entity is valid so if there is already one don't register the new value." self entities at: refName ifAbsentPut: [aReference]! ! !XMLTokenizer methodsFor: 'entities' stamp: 'mir 1/14/2002 17:59'! externalEntities externalEntities ifNil: [externalEntities _ Dictionary new]. ^externalEntities! ! !XMLTokenizer methodsFor: 'entities' stamp: 'mir 1/14/2002 17:59'! externalEntity: refName ^self entities at: refName ifAbsentPut: ['']! ! !XMLTokenizer methodsFor: 'entities' stamp: 'mir 1/17/2002 18:12'! handleEntity: referenceString in: parsingContext | entity entityValue | entity _ self entity: referenceString. entityValue _ entity valueForContext: parsingContext. (self class isCharEscape: entityValue) ifTrue: [entityValue _ entity reference]. self pushStream: (ReadStream on: entityValue asString)! ! !XMLTokenizer methodsFor: 'entities' stamp: 'mir 1/15/2002 21:39'! initEntities | ents | ents _ Dictionary new. ents at: 'amp' put: (DTDEntityDeclaration name: 'amp' value: $&); at: 'quot' put: (DTDEntityDeclaration name: 'amp' value: $"); at: 'apos' put: (DTDEntityDeclaration name: 'apos' value: $'); at: 'gt' put: (DTDEntityDeclaration name: 'gt' value: $>); at: 'lt' put: (DTDEntityDeclaration name: 'lt' value: $<). ^ents! ! !XMLTokenizer methodsFor: 'entities' stamp: 'mir 11/16/2000 21:20'! parameterEntities parameterEntities ifNil: [parameterEntities _ Dictionary new]. ^parameterEntities! ! !XMLTokenizer methodsFor: 'entities' stamp: 'mir 11/16/2000 21:40'! parameterEntity: refName ^self parameterEntities at: refName ifAbsent: [self parseError: 'XML undefined parameter entity ' , refName printString]! ! !XMLTokenizer methodsFor: 'entities' stamp: 'mir 11/16/2000 21:42'! parameterEntity: refName put: aReference "Only the first declaration of an entity is valid so if there is already one don't register the new value." self parameterEntities at: refName ifAbsentPut: [aReference]! ! !SAXDriver methodsFor: 'accessing' stamp: 'mir 8/11/2000 17:51'! saxHandler ^saxHandler! ! !SAXDriver methodsFor: 'accessing' stamp: 'mir 8/11/2000 17:52'! saxHandler: aHandler saxHandler _ aHandler! ! !SAXDriver methodsFor: 'handling tokens' stamp: 'mir 1/16/2002 00:33'! handleCData: aString self saxHandler checkEOD; characters: aString! ! !SAXDriver methodsFor: 'handling tokens' stamp: 'mir 1/8/2002 18:38'! handleEndDocument self saxHandler endDocument! ! !SAXDriver methodsFor: 'handling tokens' stamp: 'mir 1/8/2002 18:24'! handleEndTag: aString self saxHandler checkEOD; endElement: aString! ! !SAXDriver methodsFor: 'handling tokens' stamp: 'mir 1/8/2002 18:24'! handlePCData: aString self saxHandler checkEOD; characters: aString! ! !SAXDriver methodsFor: 'handling tokens' stamp: 'mir 1/8/2002 18:24'! handlePI: piTarget data: piData self saxHandler checkEOD; processingInstruction: piTarget data: piData! ! !SAXDriver methodsFor: 'handling tokens' stamp: 'mir 8/14/2000 18:29'! handleStartDocument self saxHandler startDocument! ! !SAXDriver methodsFor: 'handling tokens' stamp: 'mir 1/8/2002 18:25'! handleStartTag: elementName attributes: attributeList self saxHandler checkEOD; startElement: elementName namespaceURI: nil qualifiedName: nil attributeList: attributeList! ! !SAXDriver methodsFor: 'handling tokens' stamp: 'mir 1/17/2002 13:15'! handleXMLDecl: attributes self saxHandler checkEOD; documentAttributes: attributes! ! !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: 'handling tokens' stamp: 'mir 1/17/2002 09:27'! handleCData: aString self text: aString! ! !XMLParser methodsFor: 'handling tokens' stamp: 'mir 1/17/2002 09:26'! handleEndTag: aString self endTag: aString! ! !XMLParser methodsFor: 'handling tokens' stamp: 'mir 1/17/2002 09:27'! handlePCData: aString self text: aString! ! !XMLParser methodsFor: 'handling tokens' stamp: 'mir 1/17/2002 09:26'! handleStartTag: tagName attributes: attributes self beginStartTag: tagName asPI: false. attributes keysAndValuesDo: [:key :value | self attribute: key value: value]. self endStartTag: tagName! ! !XMLTokenizer class methodsFor: 'examples' stamp: 'mir 8/14/2000 11:41'! addressBookXML ^'
One of the most talented actresses on Daytime. Kassie plays the devious and beautiful Blair Cramer on ABC's "One Life To Live."
'! ! !XMLTokenizer class methodsFor: 'examples' stamp: 'mir 8/15/2000 10:49'! addressBookXMLWithDTD ^'
One of the most talented actresses on Daytime. Kassie plays the devious and beautiful Blair Cramer on ABC's "One Life To Live."
'! ! !XMLTokenizer class methodsFor: 'examples' stamp: 'mir 8/14/2000 11:41'! exampleAddressBook | tokenizer | "XMLTokenizer exampleAddressBook" tokenizer _ XMLTokenizer on: self addressBookXML readStream. [tokenizer next notNil] whileTrue: []! ! !XMLTokenizer class methodsFor: 'examples' stamp: 'mir 8/14/2000 16:23'! exampleAddressBookWithDTD | tokenizer | "XMLTokenizer exampleAddressBookWithDTD" tokenizer _ XMLTokenizer on: self addressBookXMLWithDTD readStream. [tokenizer next notNil] whileTrue: []! ! !XMLTokenizer class methodsFor: 'instance creation' stamp: 'mir 8/2/2000 19:25'! new ^super new initialize! ! !XMLTokenizer class methodsFor: 'instance creation' stamp: 'mir 11/16/2000 07:58'! on: aStream ^self new parseStream: aStream! ! !XMLTokenizer class methodsFor: 'class initialization' stamp: 'mir 1/15/2002 21:38'! initialize "XMLTokenizer initialize" | nameDelimiters | CharEscapes _ #( $& $" $' $> $< ) asSet. nameDelimiters _ #(9 10 12 13 32 61 "$= asInteger 61" 62 "$> asInteger" 47 "$/ asInteger"). " NameDelimiters _ nameDelimiters collect: [:each | each asCharacter]) asSet" NameDelimiters _ Array new: 256. NameDelimiters atAllPut: false. nameDelimiters do: [:each | NameDelimiters at: each put: true]. ! ! !XMLTokenizer class methodsFor: 'accessing' stamp: 'mir 1/15/2002 21:39'! isCharEscape: aChar ^CharEscapes includes: aChar! ! !XMLWriter methodsFor: 'writing dtd' stamp: 'mir 8/8/2000 18:13'! endDecl: type self endTag! ! !XMLWriter methodsFor: 'writing dtd' stamp: 'mir 12/8/2000 18:02'! endDeclaration self stream cr; nextPut: $]. self endTag! ! !XMLWriter methodsFor: 'writing dtd' stamp: 'mir 12/8/2000 18:02'! startDecl: type self stream nextPutAll: ''. self canonical ifFalse: [self stream space]! ! !XMLWriter methodsFor: 'writing xml' stamp: 'mir 1/17/2002 16:07'! endTag self stream nextPut: $>. "self canonical ifFalse: [self stream space]"! ! !XMLWriter methodsFor: 'writing xml' stamp: 'mir 1/17/2002 16:08'! endTag: tagName self popTag: tagName. self stream nextPutAll: ''] ifFalse: [self stack last]. ^stackTop = tagName ifTrue: [self stack removeLast] ifFalse: [self error: 'Closing tag "' , tagName , '" does not match "' , stackTop]! ! !XMLWriter methodsFor: 'private' stamp: 'mir 8/7/2000 16:18'! pushTag: tagName self stack add: tagName! ! !XMLWriter methodsFor: 'private' stamp: 'mir 12/11/2000 16:24'! putAsXMLString: aValue self stream nextPut: $". self pcData: aValue. self stream nextPut: $"! ! !XMLWriter methodsFor: 'private' stamp: 'mir 8/8/2000 17:02'! stack ^stack! ! !XMLWriter methodsFor: 'private tags' stamp: 'mir 12/8/2000 18:01'! endCData self stream nextPutAll: ']]>'! ! !XMLWriter methodsFor: 'private tags' stamp: 'mir 12/8/2000 18:01'! endComment self stream nextPutAll: ' -->'! ! !XMLWriter methodsFor: 'private tags' stamp: 'mir 12/8/2000 18:01'! endPI self stream nextPutAll: '?>'! ! !XMLWriter methodsFor: 'private tags' stamp: 'mir 12/8/2000 18:01'! startCData self stream nextPutAll: ' put: '>'; " at: $' put: '''; " at: $" put: '"'. ! ! XMLWriter initialize! XMLTokenizer initialize! DTDParameterEntityDeclaration initialize! DTDExternalEntityDeclaration initialize! DTDEntityDeclaration initialize!