From VisualWorks®, 7.6 of March 3, 2008 on March 3, 2008 at 9:47:03 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>SourceScannerNodeBuilder</name> <environment>XML</environment> <super>XML.XMLNodeBuilder</super> <private>false</private> none selectors currentFile currentPosition positions changeBlock <imports></imports> <category>XML-Source Code</category> <attributes> <package>XML-source</package> </attributes> </class> <comment> XML.SourceScannerNodeBuilder
This subclass of XMLNodeBuilder is used by the VisualWorks ChangeScanner to scan a VisualWorks XML source file and distill it into first XML elements and then into valid Smalltalk objects for display in the Change List tool. Instance Variables: selectors <Dictionary> comment currentFile <ReadStream> comment currentPosition <Integer> comment positions <Dictionary> comment changeBlock <BlockClosure> comment
</comment> <class> <name>SourceNodeBuilder</name> <environment>XML</environment> <super>XML.XMLNodeBuilder</super> <private>false</private> none selectors <imports></imports> <category>XML-Source Code</category> <attributes> <package>XML-source</package> </attributes> </class> <comment> XML.SourceNodeBuilder
This subclass of XMLNodeBuilder is used by the XML parser to distill a VisualWorks XML source document (stream) into first XML elements and then into valid Smalltalk objects Instance Variables: selectors <Dictionary> map from tag name to accessing selector
</comment> <class> <name>XMLSourceFileFormat</name> <environment>Kernel</environment> <super>Kernel.SourceFileFormat</super> <private>false</private> none state docName cachedFile cachedParser <imports> private XML.* </imports> <category>Kernel-Support</category> <attributes> <package>XML-source</package> </attributes> </class> <comment> Kernel.XMLSourceFileFormat
This class is used to translate abstract system modifications (such as "remove a class", "add a NameSpace", et al) into a recognized XML syntax. It is also used when reading from files that have this recognized syntax, to implement what is commonly known as a "file-in" operation. Instance Variables: state <#open | #closed | #writing | #fragment> Used to guarantee that the correct header and trailer are added to the file. docName <String> Name of the XML document element, which is the top-level element in the XML file. For Smalltalk source, this should always be 'st-source'.
</comment> <name>SaveEmphasis</name> <environment>Kernel.XMLSourceFileFormat</environment> <private>false</private> <constant>false</constant> <category>policy</category> <initializer> false </initializer> <attributes> <package>XML-source</package> </attributes> <methods> XML.SourceScannerNodeBuilder <category>initialize</category>
initialize super initialize. selectors := IdentityDictionary new. positions := IdentityDictionary new.
</methods> <methods> XML.SourceScannerNodeBuilder <category>accessing</category>
currentFile ^currentFile
forgetPosition: elm positions removeKey: elm ifAbsent: []
positionAt: elm ^positions at: elm
positionAt: elm put: p positions at: elm put: p
</methods> <methods> XML.SourceScannerNodeBuilder <category>building</category>
comment: aText | comment | comment := Comment new text: aText. changeBlock value: (OtherChange new text: aText; type: #comment). ^comment
scanFile: file do: aBlock changeBlock := aBlock. XMLParser new builder: self; parseElements: file.
tag: tag attributes: attributes elements: elements position: p stream: stream | elm | elm := Element tag: tag attributes: attributes elements: elements. (tagStack size = 1 or: [(tagStack at: tagStack size-1) tag type = 'st-source']) ifTrue: [currentFile := stream stream. currentPosition := p. self scan: elm. elm discard]. (#('body' 'method') includes: tag type) ifTrue: [self positionAt: elm put: p]. ^elm
</methods> <methods> XML.SourceScannerNodeBuilder <category>scanning</category>
scan: element | name | name := self selectorFor: element tag. (self respondsTo: name) ifTrue: [[self perform: name with: element] on: Error do: [:x | Transcript cr; show: x errorString. x return: (self scan_unknown: element)]] ifFalse: [self scan_unknown: element]
scan_class: anElement | parameters superStringTheory classChange attr | "N.B. Must create otherParameters in same order as keywords in class def." parameters := OrderedCollection new. superStringTheory := self getString: 'super' from: anElement default: ''. parameters addLast: #superclass: -> (superStringTheory = 'nil' ifFalse: [(BindingReference pathString: (self getString: 'super' from: anElement default: '')) makeUnambiguous]). parameters addLast: #indexedType: -> (self getSymbol: 'indexed-type' from: anElement default: #none). parameters addLast: #private: -> (self getBoolean: 'private' from: anElement default: false). parameters addLast: #instanceVariableNames: -> (self getString: 'inst-vars' from: anElement default: ''). parameters addLast: #classInstanceVariableNames: -> (self getString: 'class-inst-vars' from: anElement default: ''). parameters addLast: #imports: -> (self getString: 'imports' from: anElement default: ''). parameters addLast: #category: -> (self getString: 'category' from: anElement default: NameSpaceOrganizer defaultProtocol asString). attr := self getAttributesList: 'attributes' from: anElement. attr isEmpty ifFalse: [parameters addLast: #attributes: -> attr]. classChange := ClassDefinitionChange new. classChange objectType: #class. classChange className: (self getString: 'name' from: anElement default: ''). classChange nameSpaceName: (self getString: 'environment' from: anElement default: #Smalltalk) asQualifiedReference makeUnambiguous asString asSymbol classType: #defineClass: otherParameters: parameters. self doChange: classChange
scan_comment: anElement | class tp | class := self getGlobalIdAny: #('class-id' 'name-space-id' 'object-id') from: anElement do: [:type | tp := type]. self doChange: ((ClassDocumentationChange new) className: class; objectType: tp)
scan_copyright: anElement self doChange: (OtherChange new type: #copyright)
scan_documentation: anElement | class tp | class := self getGlobalIdAny: #('class-id' 'name-space-id' 'object-id') from: anElement do: [:type | tp := type]. self doChange: ((ClassDocumentationChange new) className: class; objectType: tp)
scan_do_it: anElement self doChange: OtherChange new
scan_initialize: anElement | class tp | class := self getGlobalIdAny: #('class-id' 'name-space-id' 'object-id' 'variable-id') from: anElement do: [:type | tp := type]. self doChange: ((ClassOtherChange new) className: class; type: #initialize; objectType: tp)
scan_methods: anElement | class protocol bodies classObject selector attributes savedCurrentPosition | class := self getGlobalId: 'class-id' from: anElement. classObject := (class includes: Character space) ifTrue: [((class copyUpTo: Character space) asQualifiedReference valueOrDo: []) class] ifFalse: [class asQualifiedReference valueOrDo: []]. classObject isBehavior ifFalse: [classObject := Object]. protocol := self getSymbol: 'category' from: anElement default: ClassOrganizer defaultProtocol. bodies := anElement elements select: [:e | e isElement and: [#('body' 'method') includes: e tag type]]. savedCurrentPosition := currentPosition. bodies do: [:elm | | e2 | attributes := Dictionary new. e2 := elm anyElementNamed: 'body'. e2 attributes do: [:attr | attributes at: attr tag type asSymbol put: attr value]. selector := attributes at: #selector ifAbsent: []. selector == nil ifTrue: [selector := classObject parserClass new parseSelector: e2 characterData] ifFalse: [selector := selector asSymbol]. currentPosition := self positionAt: elm. self doChange: (MethodDefinitionChange new className: class; selector: selector; category: protocol; attributes: attributes; yourself). self forgetPosition: elm; forgetPosition: e2]. currentPosition := savedCurrentPosition
scan_name_space: anElement | name env private category imports parameters attr | "N.B. Must create otherParameters in same order as keywords in class def." name := self getSymbol: 'name' from: anElement. env := self getGlobalId: 'environment' from: anElement. env := env asQualifiedReference makeUnambiguous asString. private := self getBoolean: 'private' from: anElement default: false. imports := self getString: 'imports' from: anElement default: ''. category := self getString: 'category' from: anElement default: NameSpaceOrganizer defaultProtocol asString. (parameters := OrderedCollection new) addLast: #private: -> private; addLast: #imports: -> imports; addLast: #category: -> category. attr := self getAttributesList: 'attributes' from: anElement. attr isEmpty ifFalse: [parameters addLast: #attributes: -> attr]. self doChange: ((ClassDefinitionChange new) objectType: #nameSpace; className: name; nameSpaceName: env asSymbol classType: #defineNameSpace: otherParameters: parameters)
scan_new_page: anElement
scan_relocate: anElement | class newParent tp change | class := self getGlobalIdAny: #('class-id' 'name-space-id' 'object-id' 'variable-id') from: anElement do: [:type | tp := type]. newParent := (self getGlobalId: 'environment' from: anElement). change := OtherChange new. change text: ('#{<1s>} relocateTo: <2s>' expandMacrosWith: class with: newParent). changeBlock value: change
scan_remove: anElement | class tp | class := self getGlobalIdAny: #('class-id' 'name-space-id' 'object-id' 'variable-id') from: anElement do: [:type | tp := type]. self doChange: ((ClassOtherChange new) className: class; type: #remove; objectType: tp)
scan_remove_selector: anElement | class selector | class := self getGlobalId: 'class-id' from: anElement. selector := (anElement elementNamed: 'selector') elements first text. self doChange: (MethodOtherChange new className: class; selector: selector; type: #remove)
scan_rename: anElement | class newName tp | class := self getGlobalIdAny: #('class-id' 'name-space-id' 'object-id' 'variable-id') from: anElement do: [:type | tp := type]. newName := self getSymbol: 'name' from: anElement. self doChange: ((ClassRenameChange new) className: newName; oldClassName: class; objectType: tp)
scan_reorganize: anElement | class data tp | class := self getGlobalIdAny: #('class-id' 'name-space-id') from: anElement do: [:type | tp := type]. data := self getString: 'organization' from: anElement default: ['']. self doChange: ((ClassOtherChange new) className: class; type: #reorganize; objectType: tp; otherData: data; yourself)
scan_reorganize_data: anElement | class data tp | class := self getGlobalIdAny: #('class-id' 'name-space-id') from: anElement do: [:type | tp := type]. data := self getString: 'organization' from: anElement default: ['']. self doChange: ((ClassOtherChange new) className: class; type: #reorganize; otherData: data; objectType: tp; yourself)
scan_shared_variable: anElement | name env private category constant initializer parameters attr | "N.B. Must create otherParameters in same order as keywords in class def." name := self getSymbol: 'name' from: anElement. env := self getGlobalId: 'environment' from: anElement. env := env asQualifiedReference makeUnambiguous asString. private := self getBoolean: 'private' from: anElement default: false. constant := self getBoolean: 'constant' from: anElement default: false. category := self getString: 'category' from: anElement default: NameSpaceOrganizer defaultProtocol asString. initializer := self getString: 'initializer' from: anElement default: nil. (parameters := OrderedCollection new) addLast: #private: -> private; addLast: #constant: -> constant; addLast: #category: -> category; addLast: #initializer: -> initializer. attr := self getAttributesList: 'attributes' from: anElement. attr isEmpty ifFalse: [parameters addLast: #attributes: -> attr]. self doChange: ((ClassDefinitionChange new) objectType: #variable; className: name; nameSpaceName: env asSymbol classType: #defineSharedVariable: otherParameters: parameters)
scan_static: anElement "Backward compatibility." ^self scan_shared_variable: anElement
scan_st_source: anElement "Do nothing" ^self
scan_time_stamp: anElement self doChange: (OtherChange new type: #timeStamp)
scan_unknown: anElement self doChange: (UnknownChange new type: anElement tag type asSymbol)
</methods> <methods> XML.SourceScannerNodeBuilder <category>private</category>
decodeLiteral: node "Over time, we may want to accomodate more complex annotations for a class." | c type | (node elements isEmpty or: [node elements contains: [:e | e isElement]]) ifTrue: [c := node elements select: [:i | i isElement]. ^c collect: [:i | self decodeLiteral: i]]. type := node valueOfAttribute: 'type' ifAbsent: []. type = 'sym' ifTrue: [^node characterData asSymbol]. type = 'eval' ifTrue: [^Object readFrom: node characterData readStream]. ^node characterData
doChange: aChange aChange file == nil ifTrue: [aChange file: currentFile position: currentPosition]. changeBlock value: aChange
getAttributesList: tag from: element | list newList | list := element elementsNamed: tag. newList := OrderedCollection new. list do: [:node | self listFrom: node to: newList]. ^newList asArray
getBoolean: tag from: element default: defaultValue | list item | list := element elementsNamed: tag. item := list size = 1 ifTrue: [list first characterData] ifFalse: [list size = 0 ifTrue: [defaultValue] ifFalse: [self error: ((#elementNotUnique1 << #xml >> 'Could not find unique "<1s>".') expandMacrosWith: tag)]]. ^item = 'true' ifTrue: [true] ifFalse: [item = 'false' ifTrue: [false] ifFalse: [self error: ((#nonBooleanValue << #xml >> '"<1s>" is not a boolean value for "<2s>".') expandMacrosWith: item with: tag asString)]]
getGlobalId: tag from: element | list item | list := element elementsNamed: tag. item := list size = 1 ifTrue: [list first characterData] ifFalse: [self error: ((#elementNotUnique1 << #xml >> 'Could not find unique "<1s>".') expandMacrosWith: tag)]. ^item
getGlobalIdAny: possibleTags from: element do: aBlock | list item name | list := OrderedCollection new. possibleTags do: [:tag | list addAll: (element elementsNamed: tag)]. item := list size = 1 ifTrue: [list first characterData] ifFalse: [self error: ((#elementNotUnique2 << #xml >> 'Could not find unique <1p>.') expandMacrosWith: possibleTags)]. name := #('name-space-id' 'class-id' 'object-id' 'variable-id') indexOf: list first tag type. name := #(#nameSpace #class #object #variable) at: name. aBlock value: name. ^item
getString: tag from: element default: defaultValue | list item | list := element elementsNamed: tag. item := list size = 1 ifTrue: [list first characterData] ifFalse: [list size = 0 ifTrue: [defaultValue] ifFalse: [self error: ((#elementNotUnique1 << #xml >> 'Could not find unique "<1s>".') expandMacrosWith: tag)]]. ^item
getSymbol: tag from: element | list item | list := element elementsNamed: tag. item := list size = 1 ifTrue: [list first characterData] ifFalse: [self error: ((#elementNotUnique1 << #xml >> 'Could not find unique "<1s>".') expandMacrosWith: tag)]. ^item asSymbol
getSymbol: tag from: element default: defaultValue | list item | list := element elementsNamed: tag. item := list size = 1 ifTrue: [list first characterData] ifFalse: [list size = 0 ifTrue: [defaultValue] ifFalse: [self error: ((#elementNotUnique1 << #xml >> 'Could not find unique "<1s>".') expandMacrosWith: tag)]]. ^item asSymbol
getValue: tag from: element default: defaultValue | item | item := self getString: tag from: element default: defaultValue. ^Object readFromString: item.
listFrom: node to: list "Over time, we may want to accomodate more complex annotations for a class." node elements do: [:elm | elm isText ifFalse: [ list add: (Array with: elm tag type asSymbol with: (self decodeLiteral: elm))]]
selectorFor: aTag ^selectors at: aTag ifAbsentPut: [| t | t := aTag type copy replaceAll: $: with: $_. t replaceAll: $. with: $_. t replaceAll: $- with: $_. ('scan_', t, ':') asSymbol]
</methods> <methods> XML.SourceScannerNodeBuilder <category>scanning-code components</category>
scan_component_created: anElement self doChange: ( ComponentCreatedChange new componentName: ( self getString: 'name' from: anElement default: nil ); componentType: ( self getSymbol: 'type' from: anElement ); yourself )
scan_component_definition_change: anElement self doChange: ( ComponentDefinitionChange new componentName: ( self getString: 'name' from: anElement default: nil ); componentType: ( self getSymbol: 'type' from: anElement default: '' ); definitionName: ( self getString: 'definitionName' from: anElement default: '' ); definitionChange: ( self getSymbol: 'definitionChange' from: anElement ); yourself )
scan_component_property: anElement self doChange: ( PropertyChange new componentName: ( self getString: 'name' from: anElement default: nil ); componentType: ( self getSymbol: 'type' from: anElement ); property: ( self getSymbol: 'property' from: anElement ); value: ( self getValue: 'value' from: anElement default: nil ); yourself )
scan_component_rename: anElement self doChange: ( ComponentRenamedChange new componentName: ( self getString: 'newName' from: anElement default: nil ); componentType: ( self getSymbol: 'type' from: anElement ); oldName: ( self getString: 'name' from: anElement default: nil ); yourself )
scan_component_selector_change: anElement | selector | selector := self getString: 'selector' from: anElement default: nil. selector == nil ifTrue: [^self scan_component_static_change: anElement]. self doChange: ( ComponentSelectorChange new componentName: ( self getString: 'name' from: anElement default: nil ); componentType: ( self getSymbol: 'type' from: anElement default: '' ); definitionName: ( self getString: 'definitionName' from: anElement default: '' ); selector: ( self getSymbol: 'selector' from: anElement ); meta: ( self getBoolean: 'meta' from: anElement default: false ); definitionChange: ( self getSymbol: 'definitionChange' from: anElement ); yourself )
scan_component_static_change: anElement self doChange: ( ComponentStaticChange new componentName: ( self getString: 'name' from: anElement default: nil ); componentType: ( self getSymbol: 'type' from: anElement default: '' ); definitionName: ( self getString: 'definitionName' from: anElement default: '' ); staticKey: ( self getSymbol: 'staticKey' from: anElement ); definitionChange: ( self getSymbol: 'definitionChange' from: anElement ); yourself )
scan_component_unloaded: anElement self doChange: ( ComponentUnloadedChange new componentName: ( self getString: 'name' from: anElement default: nil ); componentType: ( self getSymbol: 'type' from: anElement ); yourself )
scan_parcel_loaded: anElement self doChange: ( ParcelLoadedChange new componentName: ( self getString: 'name' from: anElement default: nil ); filename: ( self getString: 'filename' from: anElement default: nil ); yourself )
</methods> <methods> XML.SourceNodeBuilder <category>initialize</category>
initialize super initialize. selectors := IdentityDictionary new
</methods> <methods> XML.SourceNodeBuilder <category>building</category>
comment: aText ^Comment new text: aText; discard
tag: tag attributes: attributes elements: elements position: p stream: stream | elm | elm := Element tag: tag attributes: attributes elements: elements. (tagStack size = 1 or: [(tagStack at: tagStack size-1) tag type = 'st-source']) ifTrue: [self compile: elm. elm discard]. ^elm
</methods> <methods> XML.SourceNodeBuilder <category>compiling</category>
compile: element | name | name := self selectorFor: element tag. (self respondsTo: name) ifTrue: [self perform: name with: element] ifFalse: [Transcript cr; show: ((#ChangeTypeUnknownC1s << #xml >> 'Change type unknown: <1s>') expandMacrosWith: element tag asString)]
compile_class: anElement | name env superclass private indexed instVars classInstVars imports category annotations | name := self getSymbol: 'name' from: anElement. env := self getGlobalId: 'environment' from: anElement. env == nil ifTrue: [env := #{Smalltalk}]. superclass := self getGlobalId: 'super' from: anElement. private := self getBoolean: 'private' from: anElement default: 'false'. indexed := self getSymbol: 'indexed-type' from: anElement default: 'none'. instVars := self getString: 'inst-vars' from: anElement default: ''. classInstVars := self getString: 'class-inst-vars' from: anElement default: ''. imports := self getString: 'imports' from: anElement default: ''. category := self getString: 'category' from: anElement default: 'As yet unclassified'. annotations := self getDictionary: 'attributes' from: anElement. env value defineClass: name superclass: superclass indexedType: indexed private: private instanceVariableNames: instVars classInstanceVariableNames: classInstVars imports: imports category: category attributes: annotations
compile_comment: anElement | class body | class := self getGlobal: #('class-id' 'name-space-id' 'object-id') from: anElement. body := anElement elementNamed: 'body'. class comment: body characterData
compile_copyright: anElement "Do nothing." ^self
compile_documentation: anElement | class body str | class := self getGlobal: #('class-id' 'name-space-id' 'object-id') from: anElement. body := anElement children detect: [:elm | elm isElement and: [elm tag namespace = DocumentationSystem xmlNamespace]]. str := String new writeStream. body saxDo: (SAXWriter new output: str). class stDocumentation: str contents
compile_do_it: anElement Compiler evaluate: anElement characterData.
compile_initialize: anElement | class | class := self getGlobal: #('class-id' 'name-space-id' 'object-id' 'variable-id') from: anElement. class initialize
compile_methods: anElement | class protocol bodies | class := self getGlobal: #('class-id') from: anElement. protocol := self getSymbol: 'category' from: anElement default: ClassOrganizer defaultProtocol. bodies := anElement elements select: [:e | e isElement and: [#('body' 'method') includes: e tag type]]. bodies do: [:elm | | attributes e2 doc str sel | attributes := Dictionary new. e2 := elm anyElementNamed: 'body'. e2 attributes do: [:attr | attributes at: attr tag type asSymbol put: attr value]. sel := class compile: e2 characterData classified: protocol notifying: nil attributes: attributes environment: (self environmentForClass: class attributes: attributes). (elm tag type = 'method' and: [(doc := elm elementsNamed: (XML.NodeTag new qualifier: '' ns: DocumentationSystem xmlNamespace type: 'smalltalkDoc')) isEmpty not]) ifTrue: [str := String new writeStream. doc first saxDo: (SAXWriter new output: str). (class compiledMethodAt: sel) stDocumentation: str contents]].
compile_name_space: anElement | name env private category imports annotations | name := self getSymbol: 'name' from: anElement. env := self getGlobalId: 'environment' from: anElement. private := self getBoolean: 'private' from: anElement default: 'false'. imports := self getString: 'imports' from: anElement default: ''. category := self getString: 'category' from: anElement default: NameSpaceOrganizer defaultProtocol. annotations := self getDictionary: 'attributes' from: anElement. env value defineNameSpace: name private: private imports: imports category: category attributes: annotations.
compile_new_page: anElement "Do nothing." ^self
compile_relocate: anElement | class | class := self getGlobal: #('class-id' 'name-space-id' 'object-id' 'variable-id') from: anElement. class relocateTo: (self getGlobal: #('environment') from: anElement)
compile_remove: anElement | class | class := self getGlobal: #('class-id' 'name-space-id' 'object-id' 'variable-id') from: anElement. class removeFromSystem
compile_remove_selector: anElement | class selector | class := self getGlobal: #('class-id') from: anElement. selector := anElement elementNamed: 'selector'. class removeSelector: selector characterData asSymbol
compile_rename: anElement | class | class := self getGlobal: #('class-id' 'name-space-id' 'object-id' 'variable-id') from: anElement. class renameTo: (self getSymbol: 'name' from: anElement)
compile_reorganize: anElement | class | class := self getGlobal: #('class-id' 'name-space-id') from: anElement. class reorganizeFromString: (self getString: 'organization' from: anElement default: [''])
compile_reorganize_data: anElement | class | class := self getGlobal: #('class-id' 'name-space-id') from: anElement. class asNameSpace reorganizeFromString: (self getString: 'organization' from: anElement default: [''])
compile_shared_variable: anElement | name env private category constant initializer annotations | name := self getSymbol: 'name' from: anElement. env := self getGlobalId: 'environment' from: anElement. env == nil ifTrue: [env := #{Smalltalk}]. private := self getBoolean: 'private' from: anElement default: 'false'. constant := self getBoolean: 'constant' from: anElement default: 'false'. category := self getString: 'category' from: anElement default: NameSpaceOrganizer defaultProtocol. initializer := self getString: 'initializer' from: anElement default: nil. annotations := self getDictionary: 'attributes' from: anElement. env value defineSharedVariable: name private: private constant: constant category: category initializer: initializer attributes: annotations.
compile_static: anElement "Backward compatibility." ^self compile_shared_variable: anElement
compile_st_source: anElement "Do nothing" ^self
compile_time_stamp: anElement "Do nothing" ^self
environmentForClass: aClass attributes: aDictionary "Given the class, and the set of attributes that defines the selector and (if applicable) the package, return the environment in which we expect to compile this, or nil if we should use the default." | packageName package selector | packageName := aDictionary at: #package ifAbsent: [^nil]. "If we don't have the selector in the properties, this is technically malformed, but it might happen in hand-written XML source. Or at least it happened once. If it does, just ignore the method." selector := aDictionary at: #selector ifAbsent: [^nil]. package := Store.Registry packageNamed: packageName. package isNil ifTrue: [^nil]. ^package environmentFor: selector in: aClass.
</methods> <methods> XML.SourceNodeBuilder <category>private</category>
decodeLiteral: node "Over time, we may want to accomodate more complex annotations for a class." | c type | (node elements isEmpty or: [node elements contains: [:e | e isElement]]) ifTrue: [c := node elements select: [:i | i isElement]. ^c collect: [:i | self decodeLiteral: i]]. type := node valueOfAttribute: 'type' ifAbsent: []. type = 'sym' ifTrue: [^node characterData asSymbol]. type = 'eval' ifTrue: [^Object readFrom: node characterData readStream]. ^node characterData
dictionaryFrom: node to: dict "Over time, we may want to accomodate more complex annotations for a class." node elements do: [:elm | elm isText ifFalse: [ dict at: elm tag type asSymbol put: (self decodeLiteral: elm)]]
getBoolean: tag from: element default: defaultValue | list item | list := element elementsNamed: tag. item := list size = 1 ifTrue: [list first characterData] ifFalse: [list size = 0 ifTrue: [defaultValue] ifFalse: [self error: ((#elementNotUnique1 << #xml >> 'Could not find unique "<1s>".') expandMacrosWith: tag)]]. ^item = 'true' ifTrue: [true] ifFalse: [item = 'false' ifTrue: [false] ifFalse: [self error: ((#nonBooleanValue << #xml >> '"<1s>" is not a boolean value for "<2s>".') expandMacrosWith: item with: tag asString)]]
getDictionary: tag from: element | list dict | list := element elementsNamed: tag. dict := Dictionary new. list do: [:node | self dictionaryFrom: node to: dict]. ^dict
getGlobal: possibleTags from: element | list item data | list := OrderedCollection new. possibleTags do: [:tag | list addAll: (element elementsNamed: tag)]. list size = 1 ifTrue: [item := list first] ifFalse: [self error: ((#elementNotUnique2 << #xml >> 'Could not find unique <1p>.') expandMacrosWith: possibleTags)]. data := item characterData. ^((item tag isLike: 'class-id') and: ['* class' match: data ignoreCase: false]) ifTrue: [item := data copyFrom: 1 to: data size-6. item asQualifiedReference value class] ifFalse: [(item tag isLike: 'variable-id') ifTrue: [data asQualifiedReference] ifFalse: [data asQualifiedReference value]]
getGlobalId: tag from: element | list item | list := element elementsNamed: tag. item := list size = 1 ifTrue: [list first characterData] ifFalse: [self error: ((#elementNotUnique1 << #xml >> 'Could not find unique "<1s>".') expandMacrosWith: tag)]. ^item isEmpty ifTrue: [nil] ifFalse: [item asQualifiedReference]
getString: tag from: element default: defaultValue | list item | list := element elementsNamed: tag. item := list size = 1 ifTrue: [list first characterData] ifFalse: [list size = 0 ifTrue: [defaultValue] ifFalse: [self error: ((#elementNotUnique1 << #xml >> 'Could not find unique "<1s>".') expandMacrosWith: tag)]]. ^item
getSymbol: tag from: element | list item | list := element elementsNamed: tag. item := list size = 1 ifTrue: [list first characterData] ifFalse: [self error: ((#elementNotUnique1 << #xml >> 'Could not find unique "<1s>".') expandMacrosWith: tag)]. ^item asSymbol
getSymbol: tag from: element default: defaultValue | list item | list := element elementsNamed: tag. item := list size = 1 ifTrue: [list first characterData] ifFalse: [list size = 0 ifTrue: [defaultValue] ifFalse: [self error: ((#elementNotUnique1 << #xml >> 'Could not find unique "<1s>".') expandMacrosWith: tag)]]. ^item asSymbol
selectorFor: aTag ^selectors at: aTag ifAbsentPut: [| t | t := aTag type copy replaceAll: $: with: $_. t replaceAll: $. with: $_. t replaceAll: $- with: $_. ('compile_', t, ':') asSymbol]
</methods> <methods> XML.SourceNodeBuilder <category>compiling-code components</category>
compile_component_created: anElement CodeComponent create: ( self getSymbol: 'type' from: anElement ) named: ( self getString: 'name' from: anElement default: nil )
compile_component_definition_change: anElement CodeComponent type: ( self getSymbol: 'type' from: anElement ) named: ( self getString: 'name' from: anElement default: nil ) objectNamed: ( self getString: 'definitionName' from: anElement default: '' ) change: ( self getSymbol: 'definitionChange' from: anElement )
compile_component_property: anElement CodeComponent type: ( self getSymbol: 'type' from: anElement ) named: ( self getString: 'name' from: anElement default: nil ) property: ( self getSymbol: 'property' from: anElement ) value: ( self getString: 'value' from: anElement default: '' )
compile_component_renamed: anElement CodeComponent type: ( self getSymbol: 'type' from: anElement ) renamed: ( self getString: 'name' from: anElement default: nil ) to: ( self getString: 'newName' from: anElement default: nil )
compile_component_selector_change: anElement | selector | selector := self getString: 'selector' from: anElement default: nil. selector == nil ifTrue: [^self compile_component_static_change: anElement]. CodeComponent type: ( self getSymbol: 'type' from: anElement ) named: ( self getString: 'name' from: anElement default: nil ) classNamed: ( self getString: 'definitionName' from: anElement default: '' ) meta: ( self getBoolean: 'meta' from: anElement default: false ) selector: ( self getSymbol: 'selector' from: anElement ) change: ( self getSymbol: 'definitionChange' from: anElement )
compile_component_static_change: anElement CodeComponent type: ( self getSymbol: 'type' from: anElement ) named: ( self getString: 'name' from: anElement default: nil ) ownerNamed: ( self getString: 'definitionName' from: anElement default: '' ) static: ( self getSymbol: 'staticKey' from: anElement ) change: ( self getSymbol: 'definitionChange' from: anElement )
compile_component_unloaded: anElement CodeComponent unload: ( self getSymbol: 'type' from: anElement ) named: ( self getString: 'name' from: anElement default: nil )
compile_parcel_loaded: anElement | filename | ( filename := self getString: 'filename' from: anElement default: nil ) == nil ifTrue: [ ^Dialog warn: ( (#Parcel1sLoadMissingFilename << #xml >> 'Parcel <1s> load missing filename.') expandMacrosWith: ( self getString: 'name' from: anElement default: nil ) ) ]. Notice show: (#LoadingParcelN1S << #xml >> 'Loading Parcel<n><1s>' expandMacrosWith: filename asString) while: [Parcel loadParcelFrom: (('*fromComponents:*' match: filename) ifTrue: [Object readFromString: filename] ifFalse: [filename asLogicalFileSpecification])]
compile_parcel_saved: anElement Parcel savedParcel: ( self getString: 'name' from: anElement default: nil ) to: ( self getString: 'filename' from: anElement default: nil )
</methods> <methods> Kernel.XMLSourceFileFormat <category>initialize</category>
forFragment state := #fragment.
initialize super initialize. state := #open. docName := 'st-source'
</methods> <methods> Kernel.XMLSourceFileFormat <category>accessing</category>
close: output self checkForClose: output. output close
docName ^docName
docName: aString docName := aString
syntax ^#'VW XML'
</methods> <methods> Kernel.XMLSourceFileFormat <category>actions</category>
addComment: aComment on: aStream | cmt | self checkForWrite: aStream. cmt := aComment. [(cmt findString: '--' startingAt: 1) = 0] whileFalse: [cmt := cmt copyReplaceAll: '--' with: '- ']. aStream nextPutAll: '<!-- '; nextPutAll: cmt; nextPutAll: ' -->'. aStream cr
closeMethodGroup: aFileStream aFileStream cr. self on: aFileStream closeTag: 'methods'
comment: object value: comment on: aStream for: aSourceFileManager | filePosition | self checkForWrite: aStream. aStream cr; cr. filePosition := aSourceFileManager getWritePosition: aStream. self on: aStream tag: 'comment' do: [:xml :str | str cr. xml on: str tag: (self idTagFor: object) value: object fullName. str cr. xml putBodyOn: str attributes: nil value: comment. str cr]. ^aSourceFileManager keyForFile: aSourceFileManager target position: filePosition
copyright: string on: output self on: output tag: 'copyright' value: string. output cr
documentation: object value: comment on: aStream for: aSourceFileManager | filePosition | (DocumentationSystem isCommentOnly: comment) ifTrue: [^self comment: object value: (DocumentationSystem extractCommentFrom: comment) on: aStream for: aSourceFileManager]. self checkForWrite: aStream. aStream cr; cr. filePosition := aSourceFileManager getWritePosition: aStream. self on: aStream tag: 'documentation' do: [:xml :str | str cr. xml on: str tag: (self idTagFor: object) value: object fullName. str cr. XMLParser new validate: false; handlers: (SAXWriter new output: str); parse: comment readStream. str cr]. ^aSourceFileManager keyForFile: aSourceFileManager target position: filePosition
initializeObject: anObject on: aStream self checkForWrite: aStream. aStream cr; cr. self on: aStream tag: 'initialize' do: [:xml :str | str cr. xml on: str tag: (self idTagFor: anObject) value: anObject fullName. str cr]
methodBody: src class: class attributes: attributes on: aFileStream for: aSourceFileManager | filePosition attList selector | aFileStream cr; cr. attributes == nil ifTrue: [class == nil ifTrue: [attList := #()] ifFalse: [selector := [class parserClass new parseSelector: src] on: Error do: [:x | x return: nil]. attList := self attributesFor: class method: selector]] ifFalse: [attList := OrderedCollection new. attributes keysAndValuesDo: [:key :value | attList add: (Array with: key with: value)]. attList := attList asArray]. filePosition := aSourceFileManager getWritePosition: aFileStream. self putBodyOn: aFileStream attributes: attList value: src. ^aSourceFileManager keyForFile: aSourceFileManager target position: filePosition
methodSources: methodSources class: class selector: sel attributes: attributes on: aFileStream for: aSourceFileManager | filePosition attList selector | aFileStream cr; cr. attributes == nil ifTrue: [class == nil ifTrue: [attList := #()] ifFalse: [selector := sel == nil ifTrue: [[class parserClass new parseSelector: methodSources source] on: Error do: [:x | x return: nil]] ifFalse: [sel]. attList := self attributesFor: class method: selector]] ifFalse: [attList := OrderedCollection new. attributes keysAndValuesDo: [:key :value | attList add: (Array with: key with: value)]. attList := attList asArray]. sel == nil ifFalse: [attList := (attList select: [:att | att first ~= #selector]) copyWith: (Array with: #selector with: sel)]. attList := (attList asSortedCollection: [:a1 :a2 | a1 first asString <= a2 first asString]) asArray. filePosition := aSourceFileManager getWritePosition: aFileStream. methodSources stDocumentation size = 0 ifTrue: [self putBodyOn: aFileStream attributes: attList value: methodSources source] ifFalse: [self on: aFileStream tag: 'method' do: [:xml :src | src cr. xml putBodyOn: src attributes: attList value: methodSources source. src cr. XMLParser new validate: false; handlers: (SAXWriter new output: src); parse: methodSources stDocumentation readStream. src cr]]. ^aSourceFileManager keyForFile: aSourceFileManager target position: filePosition
printCategoryChunk: aString for: aClass on: aFileStream self checkForWrite: aFileStream. aFileStream cr; cr. self on: aFileStream openTag: 'methods'. aFileStream cr. self on: aFileStream tag: 'class-id' value: (self classNameFor: aClass). aString == nil ifFalse: [aFileStream space. self on: aFileStream tag: 'category' value: aString]
putRawChunk: src on: aFileStream self checkForWrite: aFileStream. aFileStream cr; cr. aFileStream nextPutAll: src
remove: objName type: type on: aStream self checkForWrite: aStream. aStream cr; cr. self on: aStream tag: 'remove' do: [:xml :str | str cr. xml on: str tag: (self idTagForType: type) value: objName. str cr]
removeSelector: sel from: class on: aStream self checkForWrite: aStream. aStream cr; cr. self on: aStream tag: 'remove-selector' do: [:xml :str | str cr. xml on: str tag: (self idTagFor: class) value: class fullName. str space. xml on: str tag: 'selector' value: sel. str cr]
rename: newName from: oldName type: type on: aStream | name n1 n2 | self checkForWrite: aStream. n1 := self homeAndNameOf: oldName. n2 := self homeAndNameOf: newName. n1 first = n2 first ifFalse: [name := n2 first = '' ifTrue: ['Smalltalk'] ifFalse: [n2 first]. aStream cr; cr. self on: aStream tag: 'relocate' do: [:xml :str | str cr. xml on: str tag: (self idTagForType: type) value: oldName. str cr. xml on: str tag: 'environment' value: name. str cr]]. n1 last = n2 last ifFalse: [name := n2 first = '' ifTrue: [n1 last] ifFalse: [n2 first, '.', n1 last]. aStream cr; cr. self on: aStream tag: 'rename' do: [:xml :str | str cr. xml on: str tag: (self idTagForType: type) value: name. str cr. xml on: str tag: 'name' value: n2 last. str cr]]
reorganize: object on: aStream self checkForWrite: aStream. aStream cr; cr. self on: aStream tag: 'reorganize' do: [:xml :str | str cr. xml on: str tag: (self idTagFor: object) value: object fullName. str space. xml on: str tag: 'organization' value: object organization printString. str cr]
reorganizeName: objectName type: type organization: orgString on: aStream "Store a snapshot of the object's organization on the stream." | tag | self checkForWrite: aStream. aStream cr; cr. tag := type == #nameSpace ifTrue: ['reorganize-data'] ifFalse: ['reorganize']. self on: aStream tag: tag do: [:xml :str | str cr. xml on: str tag: (self idTagForType: type) value: objectName. str space. xml on: str tag: 'organization' value: orgString. str cr]
reorganizeNameSpace: object on: aStream self checkForWrite: aStream. aStream cr; cr. self on: aStream tag: 'reorganize-data' do: [:xml :str | str cr. xml on: str tag: (self idTagFor: object) value: object fullName. str space. xml on: str tag: 'organization' value: object organization printString. str cr]
storeDefinition: object on: aStream | extra def element extraElm | self checkForWrite: aStream. def := object xmlDefinition. def isEmpty ifTrue: [^self]. aStream cr; cr. extra := self attributesFor: object. element := XML.XMLParser new parseElement: def readStream. element elements: (element elements select: [:i | i isElement]). extra isEmpty ifFalse: [extraElm := element elementsNamed: 'attributes'. extraElm size = 0 ifTrue: [extraElm := element class tag: 'attributes'. element addNode: extraElm] ifFalse: [extraElm := extraElm first]. extra do: [:attr | | attElm | attElm := extraElm class tag: attr first. attElm addNode: (XML.Text text: attr last). extraElm addNode: attElm]. element class tag: 'attributes']. SmalltalkWorkbench prettyPrint: element on: aStream
storeExpression: src on: aFileStream self checkForWrite: aFileStream. aFileStream cr; cr. self on: aFileStream tag: 'do-it' value: src.
storeNotation: src type: type on: aFileStream "Store a general textual notation on the file." | map | map := #(#timeStamp #copyright) indexOf: type. map := map = 0 ifTrue: [type asString] ifFalse: [#('time-stamp' 'copyright') at: map]. self checkForWrite: aFileStream. self on: aFileStream tag: map value: src. aFileStream cr.
timeStamp: output | aStream | self checkForWrite: output. aStream := WriteStream on: (String new: 16). SystemUtils timeStamp: aStream. self on: output tag: 'time-stamp' value: aStream contents. output cr
</methods> <methods> Kernel.XMLSourceFileFormat <category>formatting</category>
addElement: elm toText: textStream "Add an XML Element to the textStream. This means modifying the stream's emphasis based on the element's tag, dumping the contents onto the stream, then resetting the emphasis. Dumping the contents may invoke other elements, which will further modify the emphasis." | save newM | save := textStream emphasis. newM := (self inverseMapEmphasis: elm tag type). save == nil ifFalse: [save class == Array ifTrue: [newM := save copyWith: newM] ifFalse: [newM := Array with: save with: newM]]. textStream emphasis: newM. elm elements do: [:el2 | el2 isText ifTrue: [textStream nextPutAll: el2 text] ifFalse: [self addElement: el2 toText: textStream]]. textStream emphasis: save
addTags: open to: all on: str "Add the 'open' emphasis items to the stack ('all'), and add start tags to the stream to match the new emphases." open do: [:i | all add: i. str nextPutAll: '<', (self mapEmphasis: i), '>'.]
closeTags: close from: all on: str "Remove the 'close' tags from the stack ('all'), and generate end tags on the stream. This must be done carefully, because if we remove items from the middle of the stack, we have to pop off any items that are above them on the stack, then push the popped items back on the stack, generating end and start tags so that the XML elements we create are properly nested." | cl index pop | cl := all select: [:c | close includes: c]. cl size = close size ifFalse: [self error: (#xmlCloseTagMissing << #dialogs >> 'Some close tag will not be generated')]. cl size = 0 ifTrue: [^self]. index := all indexOf: cl first. pop := all removeLast: all size-index+1. pop reverseDo: [:i | str nextPutAll: '</', (self mapEmphasis: i), '>']. pop := pop reject: [:i | cl includes: i]. self addTags: pop to: all on: str.
cr: aStream "Add a line-break marker." self checkForWrite: aStream. aStream cr
inverseMapEmphasis: emphasis "Map an element tag to the corresponding text emphasis. This is the inverse of 'mapEmphasis:'. We also include a map for 'body', which is not an emphasis tag, but is just the wrapper tag for the whole text. We assume that this maps to 'no emphasis'." "If saving text emphasis in the file has been turned off, all emphases contained in the file are discarded." SaveEmphasis == true ifFalse: [^nil]. emphasis = 'body' ifTrue: [^nil]. emphasis = 'SM' ifTrue: [^#small]. emphasis = 'LG' ifTrue: [^#large]. emphasis = 'S' ifTrue: [^#serif]. emphasis = 'SS' ifTrue: [^#sansSerif]. emphasis = 'B' ifTrue: [^#bold]. emphasis = 'I' ifTrue: [^#italic]. emphasis = 'U' ifTrue: [^#underline]. ^emphasis asSymbol
makeArrayFrom: emphasis "An emphasis may be nil, a Symbol, or an Array of Symbols--for simplicity, we don't have anything else. In order to treat these as Arrays, we map them to an empty Array, an Array of the single Symbol, or the existing Array." "If we're not saving emphasis on the file, answering an empty array here makes all text appear to have a nil emphasis" SaveEmphasis == true ifFalse: [^#()]. emphasis == nil ifTrue: [^#()]. emphasis class == Array ifTrue: [^emphasis]. ^Array with: emphasis
mapEmphasis: emphasis "Map emphasis keys to element tags. For emphasis, we are willing to use very abbreviated tags." emphasis == #small ifTrue: [^'SM']. emphasis == #large ifTrue: [^'LG']. emphasis == #serif ifTrue: [^'S']. emphasis == #sansSerif ifTrue: [^'SS']. emphasis == #bold ifTrue: [^'B']. emphasis == #italic ifTrue: [^'I']. emphasis == #underline ifTrue: [^'U']. ^emphasis asString
newPage: output self on: output tag: 'new-page'
putBodyOn: aStream attributes: attributes value: aValue "Put the body of a method or of a class comment on the stream. This means mapping all text emphases to XML tags so that they aren't lost." | emph stack start end oldEmph removed added | emph := #(). stack := OrderedCollection new. self on: aStream tag: 'body' attributes: attributes do: [:xml :str | start := 1. [start > aValue size] whileFalse: [end := (aValue runLengthFor: start) + start - 1. oldEmph := emph. emph := self makeArrayFrom: (aValue emphasisAt: start). removed := self subtractEmphasis: emph from: oldEmph. added := self subtractEmphasis: oldEmph from: emph. self closeTags: removed from: stack on: str. self addTags: added to: stack on: str. self on: str value: (aValue copyFrom: start to: end). start := end+1]. self closeTags: stack copy from: stack on: str].
putBodyOn: aStream value: aValue "Put the body of a method or of a class comment on the stream. This means mapping all text emphases to XML tags so that they aren't lost." | emph stack start end oldEmph removed added | emph := #(). stack := OrderedCollection new. self on: aStream tag: 'body' do: [:xml :str | start := 1. [start > aValue size] whileFalse: [end := (aValue runLengthFor: start) + start - 1. oldEmph := emph. emph := self makeArrayFrom: (aValue emphasisAt: start). removed := self subtractEmphasis: emph from: oldEmph. added := self subtractEmphasis: oldEmph from: emph. self closeTags: removed from: stack on: str. self addTags: added to: stack on: str. self on: str value: (aValue copyFrom: start to: end). start := end+1]. self closeTags: stack copy from: stack on: str].
subtractEmphasis: oldEmphasis from: newEmphasis "When switching from one emphasis to another, we need to find out what the difference between the two is, so that we can open or close the right element tags. This computes that difference." | t e s | t := 'a' asText. t addEmphasis: newEmphasis removeEmphasis: #() allowDuplicates: false. t addEmphasis: #() removeEmphasis: oldEmphasis allowDuplicates: false. e := t emphasisAt: 1. e == nil ifTrue: [^#()]. e class == Array ifFalse: [e := Array with: e]. s := #(#small #large #serif #sansSerif #bold #italic #underline) asSet. ^e select: [:emp | s includes: emp]
</methods> <methods> Kernel.XMLSourceFileFormat <category>xml</category>
on: output closeTag: name "This is not very safe. It is preferred when possible that you use the 'tag:' messages, which ensure some level of XML conformity." self checkForWrite: output. output nextPutAll: '</', name, '>'
on: output openTag: name "This is not very safe. It is preferred when possible that you use the 'tag:' messages, which ensure some level of XML conformity." self checkForWrite: output. output nextPutAll: '<', name, '>'
on: output openTag: name attributes: array "This is not very safe. It is preferred when possible that you use the 'tag:' messages, which ensure some level of XML conformity." self checkForWrite: output. output nextPutAll: '<', name. array notNil ifTrue: [array do: [:attr | | ak av | ak := attr at: 1. av := attr at: 2. output space; nextPutAll: ak, '="'. Attribute new printCanonical: av on: output. output nextPut: $"]]. output nextPutAll: '>'.
on: output tag: name self checkForWrite: output. output nextPutAll: '<', name, '/>'
on: output tag: name attributes: array do: aBlock self on: output openTag: name attributes: array. aBlock value: self value: output. output nextPutAll: '</', name, '>'.
on: output tag: name attributes: array value: value | v | self on: output openTag: name attributes: array. v := value == nil ifTrue: [''] ifFalse: [value]. v := v copyReplaceAll: '&' with: '&amp;'. v := v copyReplaceAll: '<' with: '&lt;'. v := v copyReplaceAll: '>' with: '&gt;'. output nextPutAll: v. output nextPutAll: '</', name, '>'.
on: output tag: name do: aBlock self checkForWrite: output. output nextPutAll: '<', name, '>'. aBlock value: self value: output. output nextPutAll: '</', name, '>'.
on: output tag: name encodeLiteral: object (object isKindOf: Array) ifTrue: [^self on: output tag: name do: [:xml2 :str2 | object do: [:s | xml2 on: str2 tag: 'item' encodeLiteral: s] separatedBy: [str2 space]]]. object isSymbol ifTrue: [^self on: output tag: name attributes: #(#('type' 'sym')) value: object]. object isString ifTrue: [^self on: output tag: name value: object]. self on: output tag: name attributes: #(#('type' 'eval')) value: object storeString
on: output tag: name value: value | v | self checkForWrite: output. output nextPutAll: '<', name, '>'. v := value == nil ifTrue: [''] ifFalse: [value]. v := v copyReplaceAll: '&' with: '&amp;'. v := v copyReplaceAll: '<' with: '&lt;'. v := v copyReplaceAll: '>' with: '&gt;'. output nextPutAll: v. output nextPutAll: '</', name, '>'.
on: output value: value | v | self checkForWrite: output. v := value == nil ifTrue: [''] ifFalse: [value]. v := v copyReplaceAll: '&' with: '&amp;'. v := v copyReplaceAll: '<' with: '&lt;'. v := v copyReplaceAll: '>' with: '&gt;'. output nextPutAll: v.
</methods> <methods> Kernel.XMLSourceFileFormat <category>reading</category>
containingStringAt: position in: file ^[| element | file position: position. element := XMLParser new parseElement: file. element noIndentPrintString] on: XMLSignal do: [:x | x getSignal = BadCharacterSignal ifTrue: [x resume]. SourceNotAvailable new parameter: (#SourcePointerBad << #dialogs >> 'The source was unavailable because the source pointer appears to point to an incorrect position in the file. The file may have been modified after this method was updated.'); raiseSignal. x returnWith: nil]
createMarkerString: aString ^'<n>%<do-it%><1p>%</do-it%><n>' expandMacrosWith: aString
documentationAt: position in: file | sub s | sub := [| element | file position: position. element := XMLParser new parseElement: file. (#('documentation') includes: element tag type) ifTrue: [element children detect: [:e | e isElement and: [e tag namespace = DocumentationSystem xmlNamespace]] ifNone: [nil]] ifFalse: [#notDocumentation]] on: XMLSignal do: [:x | x getSignal = BadCharacterSignal ifTrue: [x resume]. SourceNotAvailable new parameter: (#SourcePointerBad << #dialogs >> 'The source was unavailable because the source pointer appears to point to an incorrect position in the file. The file may have been modified after this method was updated.'); raiseSignal. x returnWith: nil]. ^sub == #notDocumentation ifTrue: [DocumentationSystem replaceCommentIn: '' with: (self embeddedStringAt: position in: file)] ifFalse: [sub == nil ifTrue: [nil] ifFalse: [s := String new writeStream. sub saxDo: (SAXWriter new output: s). s contents]]
embeddedStringAt: position in: file ^[| element t count | file position: position. element := XMLParser new parseElement: file. t := TextStream on: (String new: 128). count := 0. (Array with: 'body' with: (NodeTag new qualifier: '' ns: DocumentationSystem xmlNamespace type: 'comment')) do: [:tag | (element anyElementsNamed: tag) do: [:e | count := count+1. self addElement: e toText: t]]. count = 1 ifFalse: [self error: #NoTextFound << #dialogs >> 'no text found']. t contents] on: XMLSignal do: [:x | x getSignal = BadCharacterSignal ifTrue: [x resume]. SourceNotAvailable new parameter: (#SourcePointerBad << #dialogs >> 'The source was unavailable because the source pointer appears to point to an incorrect position in the file. The file may have been modified after this method was updated.'); raiseSignal. x returnWith: nil]
fileInFrom: aStream [XMLParser new validate: false; builder: SourceNodeBuilder new; parseElements: aStream] on: BadCharacterSignal do: [:x | x resume].
methodSourceAt: position in: file | doc s | ^[| element t src | file position: position. element := XMLParser new parseElement: file. element tag type = 'body' ifTrue: [t := TextStream on: (String new: 128). self addElement: element toText: t. src := MethodSourceCollection source: t contents] ifFalse: [element tag type = 'method' ifTrue: [t := TextStream on: (String new: 128). self addElement: (element elementNamed: 'body') toText: t. src := MethodSourceCollection source: t contents. doc := element children detect: [:e | e isElement and: [e tag namespace = DocumentationSystem xmlNamespace]] ifNone: []. doc == nil ifFalse: [s := String new writeStream. doc saxDo: (SAXWriter new output: s). src stDocumentation: s contents]] ifFalse: [XMLSignal raiseSignal]]. src] on: XMLSignal do: [:x | x getSignal = BadCharacterSignal ifTrue: [x resume]. SourceNotAvailable new parameter: (#SourcePointerBad << #dialogs >> 'The source was unavailable because the source pointer appears to point to an incorrect position in the file. The file may have been modified after this method was updated.'); raiseSignal. x returnWith: nil]
stringAt: position in: file ^[| element body t | file position: position. element := (self parserFor: file) parseElement. body := element anyElementNamed: 'body'. body == nil ifTrue: [body := element]. t := TextStream on: (String new: 128). self addElement: body toText: t. t contents] on: XMLSignal do: [:x | x getSignal = BadCharacterSignal ifTrue: [x resume]. SourceNotAvailable new parameter: (#SourcePointerBad << #dialogs >> 'The source was unavailable because the source pointer appears to point to an incorrect position in the file. The file may have been modified after this method was updated.'); raiseSignal. x returnWith: nil]
</methods> <methods> Kernel.XMLSourceFileFormat <category>private</category>
checkForClose: output state = #open ifTrue: [state := #closed]. state = #writing ifTrue: [state := #closed. output cr; cr; nextPutAll: '</', self docName, '>'; cr].
checkForWrite: output state = #open ifTrue: [state := #writing. output nextPutAll: '<?xml version="1.0"?>'; cr; cr. output nextPutAll: '<', self docName, '>'; cr]. state = #closed ifTrue: [self error: (#ThisStreamHasBeenClosed << #dialogs >> 'This stream has been closed')].
idTagFor: object ^self idTagForType: object fileOutObjectType
idTagForType: type ^type = #class ifTrue: ['class-id'] ifFalse: [type = #nameSpace ifTrue: ['name-space-id'] ifFalse: [type = #variable ifTrue: ['variable-id'] ifFalse: ['object-id']]]
parserFor: file (cachedParser ~~ nil and: [cachedFile = file]) ifTrue: [^cachedParser]. cachedFile := file. ^cachedParser := XMLParser new validate: false; on: cachedFile
</methods> <methods> Kernel.XMLSourceFileFormat <category>code component support</category>
component: typeSymbol named: name definitionName: aString change: aSymbol on: aStream "Add the addition/removal of a definition from a CodeComponent event on a stream. " self checkForWrite: aStream. aStream cr; cr. self on: aStream tag: 'component_definition_change' do: [ :xml :str | str cr. xml on: str tag: 'name' value: name. str space. xml on: str tag: 'type' value: typeSymbol. str cr. xml on: str tag: 'definitionName' value: aString. str space. xml on: str tag: 'definitionChange' value: aSymbol. str cr ]
component: typeSymbol named: name definitionName: aString meta: isMeta selector: aSelector change: aSymbol on: aStream "Add the addition/removal of a method from a CodeComponent event on a stream. " self checkForWrite: aStream. aStream cr; cr. self on: aStream tag: 'component_selector_change' do: [ :xml :str | str cr. xml on: str tag: 'name' value: name. str space. xml on: str tag: 'type' value: typeSymbol. str cr. xml on: str tag: 'definitionName' value: aString. str space. xml on: str tag: 'meta' value: isMeta printString. str space. xml on: str tag: 'selector' value: aSelector. str space. xml on: str tag: 'definitionChange' value: aSymbol. str cr ]
component: typeSymbol named: name definitionName: aString static: staticKey change: aSymbol on: aStream "Add the addition/removal of a static from a CodeComponent event on a stream. " self checkForWrite: aStream. aStream cr; cr. self on: aStream tag: 'component_static_change' do: [ :xml :str | str cr. xml on: str tag: 'name' value: name. str space. xml on: str tag: 'type' value: typeSymbol. str cr. xml on: str tag: 'definitionName' value: aString. str space. xml on: str tag: 'staticKey' value: staticKey. str space. xml on: str tag: 'definitionChange' value: aSymbol. str cr ]
component: typeSymbol named: name newName: aString on: aStream "Add the renaming of a CodeComponent event on a stream. " self checkForWrite: aStream. aStream cr; cr. self on: aStream tag: 'component-rename' do: [ :xml :str | str cr. xml on: str tag: 'name' value: name. str space. xml on: str tag: 'type' value: typeSymbol. str cr. xml on: str tag: 'newName' value: aString. str cr ]
component: typeSymbol named: name property: propertySymbol value: valueString on: aStream self checkForWrite: aStream. aStream cr; cr. self on: aStream tag: 'component-property' do: [ :xml :str | str cr. xml on: str tag: 'name' value: name. str space. xml on: str tag: 'type' value: typeSymbol. str cr. xml on: str tag: 'property' value: propertySymbol. str space. xml on: str tag: 'value' value: valueString safeStoreString. str cr ]
createdComponent: typeSymbol named: aString on: aStream "Add the creation of a CodeComponent event on a stream. " self checkForWrite: aStream. aStream cr; cr. self on: aStream tag: 'component-created' do: [ :xml :str | str cr. xml on: str tag: 'name' value: aString. str space. xml on: str tag: 'type' value: typeSymbol. str cr ]
loadComponent: cName type: typeSymbol version: vString on: aStream self checkForWrite: aStream. aStream cr; cr. self on: aStream tag: 'component-loaded' do: [ :xml :str | str cr. xml on: str tag: 'name' value: cName. str space. xml on: str tag: 'type' value: typeSymbol. str cr. xml on: str tag: 'version' value: vString. str cr ]
loadParcel: name filename: aFilename on: aStream "Add the loading of a Parcel event on a stream. " self checkForWrite: aStream. aStream cr; cr. self on: aStream tag: 'parcel-loaded' do: [ :xml :str | str cr. xml on: str tag: 'name' value: name. str space. xml on: str tag: 'filename' value: (aFilename isLogicalFileSpecification ifTrue: [aFilename storeString] ifFalse: [aFilename asString]). str cr]
savedParcel: name filename: aFilename on: aStream "Add the saving of a Parcel event on a stream. " self checkForWrite: aStream. aStream cr; cr. self on: aStream tag: 'parcel-saved' do: [ :xml :str | str cr. xml on: str tag: 'name' value: name. str space. xml on: str tag: 'filename' value: aFilename asString. str cr ]
unloadComponent: typeSymbol named: name on: aStream "Add the unloading of a CodeComponent event on a stream. " self checkForWrite: aStream. aStream cr; cr. self on: aStream tag: 'component-unloaded' do: [ :xml :str | str cr. xml on: str tag: 'name' value: name. str space. xml on: str tag: 'type' value: typeSymbol. str cr ]
</methods> <methods> Kernel.XMLSourceFileFormat class <category>utilities</category>
canFormatStream: aStream | p | p := aStream position. aStream position: 0. aStream skipSeparators. ^[aStream peekFor: $<] ensure: [aStream position: p]
</methods> <methods> UI.UISettings <category>help</category>
fileOutHelp ^(#fileOutHelp << #dialogs >> 'File-out Settings There are three possible languages to use for file-outs. The setting on this page controls which of these formats is used by programming tools, if they do not have a way to control this feature themselves. Not all of these formats may appear on this page, if they have not yet been implemented. Smalltalk chunk format saves Smalltalk programs in a form similar to that used in previous versions of VisualWorks, with Smalltalk expressions separated by exclamation marks. It is not completely compatible with previous VisualWorks releases, since it has been extended substantially for Name Spaces. XML format saves Smalltalk programs using an XML markup set designed to capture as much as possible of the VisualWorks system changes. It is a new technology, but offers the possibility of capturing much more detailed meta-information about the program than Smalltalk chunk format, and hence allowing much more powerful tools for manipulating source files. ANSI interchange format is a file-out format designed for interchange between all dialects of Smalltalk. It is currently a varient of Smalltalk chunk format, but much more verbose and less readable. It allows programs to be migrated from one Smalltalk to another, but when the code is loaded into the new Smalltalk, some additional information may be lost, resulting in a non-functional program.')
</methods> <methods> UI.UISettings class <category>user preferences</category>
addFileOutSectionTo: aDictionary development: devSpecs runtime: runtimeSpecs "Add the core set of preferences and settings slices to the arguments." "UISettings updateAllPreferences" aDictionary at: #fileOutType put: (self preferenceModelFor: #fileOutType default: #ChunkSourceFileFormat); at: #fileOutTypeEditing put: ((aDictionary at: #fileOutType) value asValue); at: #fileOutAccept put: [self fileOutAccept]; at: #fileOutReset put: [self fileOutReset]. devSpecs add: (#fileOutType << #menus >> 'File-out Type')->#(#fileOutSpec #fileOutHelp)
</methods> <methods> UI.UISettings class <category>accessing preferences</category>
fileOutAccept (self preferenceModelFor: #fileOutType) value: (self preferenceFor: #fileOutTypeEditing).
</methods> <methods> Kernel.NameSpace <category>printing</category>
xmlDefinition: anXMLFormatter onto: aStream ^anXMLFormatter on: aStream tag: 'name-space' do: [:xml :str | | nm private | xml on: str cr tag: 'name' value: self name. self environment == nil ifTrue: [nm := ''. private := false] ifFalse: [nm := self environment fullName. private := (self environment bindingFor: self name) isPrivate]. xml on: str cr tag: 'environment' value: nm. xml on: str cr tag: 'private' value: private printString. xml on: str cr tag: 'imports' value: self importString. xml on: str cr tag: 'category' value: self category. str cr]
</methods> <methods> XML.PI <category>printing</category>
printNoIndentOn: aStream endSpacing: endSpacingBlock spacing: spacingBlock aStream nextPutAll: '<?', name, ' ', text, '?>'
</methods> <methods> Kernel.GeneralBindingReference <category>file-in/out</category>
xmlDefinition | aStream | aStream := (String new: 128) writeStream. self xmlDefinition: XMLSourceFileFormat new forFragment onto: aStream. ^aStream contents
</methods> <methods> Core.ClassDescription <category>printing</category>
xmlDefinition "Answer a string that defines the receiver." | aStream | aStream := (String new: 128) writeStream. self xmlDefinition: XMLSourceFileFormat new forFragment onto: aStream. ^aStream contents
</methods> <methods> XML.Node <category>printing</category>
printNoIndentOn: aStream endSpacing: endSpacingBlock spacing: spacingBlock "Print myself on the stream with line breaks between adjacent elements, but no indentation." self subclassResponsibility
</methods> <methods> Kernel.NameSpace <category>definition</category>
xmlDefinition "Answer a string that defines the receiver." | aStream | aStream := (String new: 128) writeStream. self xmlDefinition: XMLSourceFileFormat new forFragment onto: aStream. ^aStream contents
</methods> <methods> Core.Metaclass <category>fileIn/Out</category>
xmlDefinition: anXMLFormatter onto: aStream ^self
</methods> <methods> XML.Element <category>printing</category>
printNoIndentOn: aStream endSpacing: endSpacingBlock spacing: spacingBlock | elem | self saxDo: (SAXWriter new output: aStream) forBodyDo: [elem := elements == nil ifTrue: [#()] ifFalse: [elements reject: [:e | e isBlankText]]. (elem contains: [:e | e isElement]) ifTrue: [endSpacingBlock value: self value: elem. elem do: [:e | e printNoIndentOn: aStream endSpacing: endSpacingBlock spacing: spacingBlock] separatedBy: [spacingBlock value: self value: elem]. endSpacingBlock value: self value: elem] ifFalse: [elem do: [:e | e printNoIndentOn: aStream endSpacing: endSpacingBlock spacing: spacingBlock]]]
</methods> <methods> XML.Comment <category>printing</category>
printNoIndentOn: aStream endSpacing: endSpacingBlock spacing: spacingBlock ^self printOn: aStream
</methods> <methods> UI.UISettings class <category>user preferences</category>
xmlInstall: aParcel "Update the preferences and setting specs." self addPreferenceSection: #addFileOutSectionTo:development:runtime:
</methods> <methods> XML.Attribute <category>printing</category>
printNoIndentOn: aStream endSpacing: endSpacingBlock spacing: spacingBlock aStream nextPutAll: self tag asString, '="'. self printCanonical: value on: aStream. aStream nextPutAll: '"'.
</methods> <methods> Core.Class <category>fileIn/Out</category>
xmlDefinition: anXMLFormatter onto: aStream | extra | ^anXMLFormatter on: aStream tag: 'class' do: [:xml :str | | nm | xml on: str cr tag: 'name' value: self name. xml on: str cr tag: 'environment' value: self environment fullName. nm := self superclass == nil ifTrue: [''] ifFalse: [self superclass fullName]. xml on: str cr tag: 'super' value: nm. xml on: str cr tag: 'private' value: (self environment bindingFor: self name) isPrivate printString. xml on: str cr tag: 'indexed-type' value: self behaviorType. xml on: str cr tag: 'inst-vars' value: self instanceVariablesString. xml on: str cr tag: 'class-inst-vars' value: self class instanceVariablesString. xml on: str cr tag: 'imports' value: self asNameSpace importString. xml on: str cr tag: 'category' value: self category asString. extra := self extraAttributesForDefinition. extra isEmpty ifFalse: [xml on: str cr tag: 'attributes' do: [:xml1 :str1 | extra do: [:attr | xml1 on: str1 cr tag: attr first encodeLiteral: attr last]. str cr]]. str cr]
</methods> <methods> XML.Text <category>printing</category>
printNoIndentOn: aStream endSpacing: endSpacingBlock spacing: spacingBlock text == nil ifTrue: [^self]. self isStripped ifFalse: [self printQuoted: text on: aStream.]
</methods> <methods> UI.UISettings class <category>accessing preferences</category>
fileOutReset (self preferenceModelFor: #fileOutTypeEditing) value: (self preferenceFor: #fileOutType).
</methods> <methods> UI.UISettings class <category>user preferences</category>
xmlUninstall: aParcel "Update the preferences and setting specs." self removePreferenceSection: #addFileOutSectionTo:development:runtime:
</methods> <methods> Core.ClassDescription <category>fileIn/Out</category>
xmlDefinition: anXMLFormatter onto: aStream ^self subclassResponsibility
</methods> <methods> XML.Document <category>printing</category>
printNoIndentOn: aStream endSpacing: endSpacingBlock spacing: spacingBlock nodes do: [:n | n printNoIndentOn: aStream endSpacing: endSpacingBlock spacing: spacingBlock]
</methods> <methods> UI.UISettings class <category>interface specs</category>
fileOutSpec "UIPainter new openOnClass: self andSelector: #fileOutSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{Kernel.UserMessage} #key: #UnlabeledCanvas #defaultString: 'Unlabeled Canvas' #catalogID: #labels) #min: #(#Point 50 50 ) #bounds: #(#Rectangle 172 299 477 501 ) ) #component: #(#SpecCollection #collection: #( #(#GroupBoxSpec #layout: #(#LayoutFrame 10 0 8 0 -10 1 88 0 ) #label: #(#{Kernel.UserMessage} #key: #FileOutFormats #catalogID: #labels #defaultString: ' File-out Formats ') ) #(#RadioButtonSpec #layout: #(#Point 30 31 ) #model: #fileOutTypeEditing #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #disturb ) #tabable: true #label: #(#{Kernel.UserMessage} #key: #SmalltalkChunkSourceCode #catalogID: #labels #defaultString: 'Smalltalk chunk source code') #select: #ChunkSourceFileFormat ) #(#RadioButtonSpec #layout: #(#Point 30 55 ) #model: #fileOutTypeEditing #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #disturb ) #tabable: true #label: #(#{Kernel.UserMessage} #key: #XMLSourceCode #catalogID: #labels #defaultString: 'XML source code') #select: #XMLSourceFileFormat ) #(#ActionButtonSpec #layout: #(#Point 10 240 ) #name: #acceptButton #flags: 40 #model: #fileOutAccept #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #undisturb ) #label: #(#{Kernel.UserMessage} #key: #Accept #catalogID: #labels #defaultString: 'Accept') #isDefault: true #defaultable: true ) #(#ActionButtonSpec #layout: #(#Point 101 240 ) #name: #resetButton #flags: 40 #model: #fileOutReset #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #undisturb ) #label: #(#{Kernel.UserMessage} #key: #Reset #catalogID: #labels #defaultString: 'Reset') #defaultable: true ) #(#ActionButtonSpec #layout: #(#Point 185 240 ) #model: #helpAction #label: #(#{Kernel.UserMessage} #key: #Help #catalogID: #labels #defaultString: 'Help') #defaultable: true ) ) ) )
</methods> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Node</name> <environment>XML</environment> <super>Core.Object</super> <private>false</private> none parent flags userData <imports></imports> <category>XML-Nodes</category> <attributes> <package>XML</package> </attributes> </class> <class> <name>PI</name> <environment>XML</environment> <super>XML.Node</super> <private>false</private> none name text <imports></imports> <category>XML-Nodes</category> <attributes> <package>XML</package> </attributes> </class> <class> <name>Element</name> <environment>XML</environment> <super>XML.Node</super> <private>false</private> none tag attributes namespaces elements definition <imports></imports> <category>XML-Nodes</category> <attributes> <package>XML</package> </attributes> </class> <class> <name>NameSpace</name> <environment>Kernel</environment> <super>Kernel.GeneralNameSpace</super> <private>false</private> none parent name <imports></imports> <category>System-Name Spaces</category> <attributes> <package>System-Name Spaces</package> </attributes> </class> <class> <name>Attribute</name> <environment>XML</environment> <super>XML.Node</super> <private>false</private> none name value <imports></imports> <category>XML-Nodes</category> <attributes> <package>XML</package> </attributes> </class> <class> <name>SourceFileFormat</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none objectProperties methodProperties <imports></imports> <category>Kernel-Support</category> <attributes> <package>Kernel-Support</package> </attributes> </class> <class> <name>ClassDescription</name> <environment>Core</environment> <super>Core.Behavior</super> <private>false</private> none instanceVariables organization <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>Metaclass</name> <environment>Core</environment> <super>Core.ClassDescription</super> <private>false</private> none thisClass <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>Class</name> <environment>Core</environment> <super>Core.ClassDescription</super> <private>false</private> none name classPool environment <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>UISettings</name> <environment>UI</environment> <super>UI.ApplicationModel</super> <private>false</private> none list disturbed subBuilder <imports></imports> <category>Interface-Support</category> <attributes> <package>Interface-Support</package> </attributes> </class> <class> <name>XMLNodeBuilder</name> <environment>XML</environment> <super>Core.Object</super> <private>false</private> none tagStack tags <imports></imports> <category>XML-Parsing</category> <attributes> <package>XML</package> </attributes> </class> <class> <name>Text</name> <environment>XML</environment> <super>XML.Node</super> <private>false</private> none text stripped <imports></imports> <category>XML-Nodes</category> <attributes> <package>XML</package> </attributes> </class> <class> <name>Comment</name> <environment>XML</environment> <super>XML.Node</super> <private>false</private> none text <imports></imports> <category>XML-Nodes</category> <attributes> <package>XML</package> </attributes> </class> <class> <name>Document</name> <environment>XML</environment> <super>XML.Node</super> <private>false</private> none root nodes dtd ids <imports></imports> <category>XML-Nodes</category> <attributes> <package>XML</package> </attributes> </class> <class> <name>GeneralBindingReference</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none path cache <imports></imports> <category>System-Name Spaces</category> <attributes> <package>System-Name Spaces</package> </attributes> </class>