SystemOrganization addCategory: #'Starfish-Core'! SystemOrganization addCategory: #'Starfish-Elements'! SystemOrganization addCategory: #'Starfish-Elements-XHTML'! SystemOrganization addCategory: #'Starfish-Events'! SystemOrganization addCategory: #'Starfish-Exceptions'! SystemOrganization addCategory: #'Starfish-Examples'! SystemOrganization addCategory: #'Starfish-Tests'! Exception subclass: #SFErrorNodeNotFound instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Exceptions'! !Object methodsFor: '*starfish' stamp: 'lr 1/9/2008 16:31'! buildOn: aBuilder aBuilder text: self! ! Object subclass: #SFBuilder instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements'! !SFBuilder class methodsFor: 'private' stamp: 'lr 1/10/2008 15:30'! buildAll | model class | model := RBNamespace new. class := model classFor: self. class selectors do: [ :selector | (class protocolsFor: selector) do: [ :protocol | (protocol notNil and: [ protocol endsWith: '-generated' ]) ifTrue: [ class removeMethod: selector ] ] ]. self specification do: [ :each | class compile: (String streamContents: [ :stream | stream nextPutAll: each first; cr. stream nextPutAll: ' ^ '. (Smalltalk hasClassNamed: each second) ifFalse: [ stream nextPutAll: 'self tag: '; print: each second asString ] ifTrue: [ stream nextPutAll: 'self add: '; nextPutAll: each second; nextPutAll: ' new' ] ]) classified: 'tags-generated'. class compile: (String streamContents: [ :stream | stream nextPutAll: each first; nextPutAll: ': anObject'; cr. stream nextPutAll: ' ^ self '; nextPutAll: each first; nextPutAll: ' with: anObject' ]) classified: 'tags-generated' ]. RefactoryChangeManager instance performChange: model changes! ! !SFBuilder class methodsFor: 'instance-creation' stamp: 'lr 1/9/2008 16:42'! on: aNode ^ self basicNew initializeOn: aNode! ! !SFBuilder class methodsFor: 'private' stamp: 'lr 1/10/2008 15:33'! specification ^ #( ( paragraph p ) ( div div ) ( span span ) ( big big ) ( strong strong ) ( emphasis em ) ( subscript sub ) ( superscript sup ) ( big big ) ( small small ) ( ordereList ol ) ( unorderedList ul ) ( definitionList dl ) ( listItem li ) ( definitionData dd ) ( definitionTerm dt ) ( table table ) ( tableRow tr ) ( tableData td ) ( tableHeading th ) ( tableHead thead ) ( tableBody tbody ) ( tableFoot tfoot ) ( heading SFHeadingTag ) ( anchor SFAnchorTag ) )! ! !SFBuilder methodsFor: 'private' stamp: 'lr 1/9/2008 16:27'! add: aNode ^ node appendChild: aNode! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! anchor ^ self add: SFAnchorTag new! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! anchor: anObject ^ self anchor with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! big ^ self tag: 'big'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! big: anObject ^ self big with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! definitionData ^ self tag: 'dd'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! definitionData: anObject ^ self definitionData with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! definitionList ^ self tag: 'dl'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! definitionList: anObject ^ self definitionList with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! definitionTerm ^ self tag: 'dt'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! definitionTerm: anObject ^ self definitionTerm with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! div ^ self tag: 'div'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! div: anObject ^ self div with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! emphasis ^ self tag: 'em'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! emphasis: anObject ^ self emphasis with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! heading ^ self add: SFHeadingTag new! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! heading: anObject ^ self heading with: anObject! ! !SFBuilder methodsFor: 'initialization' stamp: 'lr 1/9/2008 16:42'! initializeOn: aNode node := aNode! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! listItem ^ self tag: 'li'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! listItem: anObject ^ self listItem with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! ordereList ^ self tag: 'ol'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! ordereList: anObject ^ self ordereList with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! paragraph ^ self tag: 'p'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! paragraph: anObject ^ self paragraph with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! small ^ self tag: 'small'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! small: anObject ^ self small with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! span ^ self tag: 'span'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! span: anObject ^ self span with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! strong ^ self tag: 'strong'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! strong: anObject ^ self strong with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! subscript ^ self tag: 'sub'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! subscript: anObject ^ self subscript with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! superscript ^ self tag: 'sup'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! superscript: anObject ^ self superscript with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! table ^ self tag: 'table'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! table: anObject ^ self table with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! tableBody ^ self tag: 'tbody'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! tableBody: anObject ^ self tableBody with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! tableData ^ self tag: 'td'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! tableData: anObject ^ self tableData with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! tableFoot ^ self tag: 'tfoot'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! tableFoot: anObject ^ self tableFoot with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! tableHead ^ self tag: 'thead'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! tableHead: anObject ^ self tableHead with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! tableHeading ^ self tag: 'th'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! tableHeading: anObject ^ self tableHeading with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! tableRow ^ self tag: 'tr'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! tableRow: anObject ^ self tableRow with: anObject! ! !SFBuilder methodsFor: 'elements' stamp: 'lr 1/9/2008 16:41'! tag: aString "Defines a generic tag with the name aString." ^ self add: (SFGenericTag tag: aString)! ! !SFBuilder methodsFor: 'elements' stamp: 'lr 1/9/2008 16:41'! text: anObject "Emit anObject onto the target document." ^ self add: (SFText text: anObject)! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! unorderedList ^ self tag: 'ul'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:33'! unorderedList: anObject ^ self unorderedList with: anObject! ! Object subclass: #SFNode instanceVariableNames: 'parentNode firstChild lastChild previousSibling nextSibling' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements'! SFNode subclass: #SFDocument instanceVariableNames: 'announcer' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements'! !SFDocument methodsFor: 'accessing' stamp: 'lr 1/8/2008 09:22'! announcer ^ announcer! ! !SFDocument methodsFor: 'initialization' stamp: 'lr 1/7/2008 13:51'! initialize super initialize. announcer := Announcer new! ! !SFNode methodsFor: 'modifying' stamp: 'lr 12/24/2007 13:31'! add: aNode ^ self appendChild: aNode! ! !SFNode methodsFor: 'modifying' stamp: 'lr 12/24/2007 13:28'! add: aNode after: anotherNode "Add aNode as an element of the receiver. Put it in the sequence just succeeding anotherNode. Answer aNode." ^ self insert: aNode before: anotherNode nextSibling! ! !SFNode methodsFor: 'modifying' stamp: 'lr 12/24/2007 13:28'! add: aNode before: anotherNode "Add aNode as an element of the receiver. Put it in the sequence just preceeding anotherNode. Answer aNode." ^ self insert: aNode before: anotherNode! ! !SFNode methodsFor: 'modifying' stamp: 'lr 12/24/2007 13:27'! addFirst: aNode "Add aNode to the beginning of the receiver. Answer aNode." ^ self insert: aNode before: firstChild! ! !SFNode methodsFor: 'modifying' stamp: 'lr 12/24/2007 13:32'! addLast: aNode "Add aNode to the end of the receiver. Answer aNode." ^ self appendChild: aNode! ! !SFNode methodsFor: 'enumerating' stamp: 'lr 12/24/2007 13:17'! allChildren ^ SFTreeIterator on: self! ! !SFNode methodsFor: 'actions' stamp: 'lr 1/8/2008 09:30'! announce: anAnnouncement "Announces anAnnouncement in the receiver and bubbles up if possible." anAnnouncement isStopped ifTrue: [ ^ self ]. self announcer isNil ifFalse: [ self announcer announce: anAnnouncement ]. self parentNode isNil ifFalse: [ self parentNode announce: anAnnouncement ]! ! !SFNode methodsFor: 'accessing' stamp: 'lr 1/8/2008 09:25'! announcer "Answer the announcer of the receiver or nil." ^ nil! ! !SFNode methodsFor: 'modifying-dom' stamp: 'lr 1/7/2008 13:43'! appendChild: aNode "Add the node aNode to the end of the list of children of this node. If the aNode is already in the tree, it is first removed." aNode parentNode isNil ifFalse: [ aNode remove ]. aNode setParentNode: self. aNode setNextSibling: nil. aNode setPreviousSibling: lastChild. lastChild isNil ifFalse: [ lastChild setNextSibling: aNode ]. firstChild isNil ifTrue: [ firstChild := aNode ]. lastChild := aNode. self announce: (SFInsertEvent new node: aNode). ^ aNode! ! !SFNode methodsFor: 'building' stamp: 'lr 1/9/2008 16:33'! buildOn: aBuilder aBuilder add: self! ! !SFNode methodsFor: 'enumerating' stamp: 'lr 12/19/2007 14:02'! children ^ SFChildrenIterator on: self! ! !SFNode methodsFor: 'copying' stamp: 'lr 12/26/2007 21:47'! clone: aBoolean "Answer a clone of the receiver, which optionally includes cloned versions of child nodes." | node | node := self copy. aBoolean ifTrue: [ node children do: [ :each | node appendChild: (each clone: aBoolean) ] ]. ^ node! ! !SFNode methodsFor: 'encoding' stamp: 'lr 1/7/2008 13:55'! encodeOn: aDocument self isEmpty ifTrue: [ ^ self ]. self children do: [ :each | aDocument print: each ]! ! !SFNode methodsFor: 'private' stamp: 'lr 1/7/2008 13:48'! errorNotFound: anObject SFErrorNodeNotFound raiseSignal: anObject printString , ' is not in the collection.'! ! !SFNode methodsFor: 'accessing' stamp: 'lr 12/19/2007 10:28'! firstChild "The first child of this node, or nil if this node has no child nodes." ^ firstChild! ! !SFNode methodsFor: 'modifying-dom' stamp: 'lr 1/7/2008 13:42'! insert: aNode before: anotherNode "Insert the node aNode before the existing child node anotherNode. If anotherNode is nil, insert anotherNode at the end of the list of children." anotherNode isNil ifTrue: [ ^ self add: aNode ]. anotherNode parentNode = self ifFalse: [ ^ self errorNotFound: anotherNode ]. anotherNode = aNode ifTrue: [ ^ aNode ]. aNode parentNode isNil ifFalse: [ aNode remove ]. aNode setParentNode: self. aNode setNextSibling: anotherNode. aNode setPreviousSibling: anotherNode previousSibling. aNode previousSibling isNil ifTrue: [ firstChild := aNode ] ifFalse: [ aNode previousSibling setNextSibling: aNode ]. anotherNode setPreviousSibling: aNode. self announce: (SFInsertEvent new node: aNode). ^ aNode! ! !SFNode methodsFor: 'testing' stamp: 'lr 12/19/2007 14:10'! isEmpty ^ firstChild isNil and: [ lastChild isNil ]! ! !SFNode methodsFor: 'testing' stamp: 'lr 12/24/2007 19:33'! isFirst ^ parentNode notNil and: [ parentNode firstChild == self ]! ! !SFNode methodsFor: 'testing' stamp: 'lr 12/24/2007 19:33'! isLast ^ parentNode notNil and: [ parentNode lastChild == self ]! ! !SFNode methodsFor: 'accessing' stamp: 'lr 12/19/2007 10:28'! lastChild "The last child of this node, or nil if this node has no child nodes." ^ lastChild! ! !SFNode methodsFor: 'accessing' stamp: 'lr 12/19/2007 10:28'! nextSibling "The node immediately following this node, or nil if there is no sibling node." ^ nextSibling! ! !SFNode methodsFor: 'accessing' stamp: 'lr 12/28/2007 13:31'! ownerNode ^ parentNode isNil ifTrue: [ self ] ifFalse: [ parentNode ownerNode ]! ! !SFNode methodsFor: 'accessing' stamp: 'lr 12/19/2007 14:08'! parentNode "The parent of this node, or nil if there is no parent node." ^ parentNode! ! !SFNode methodsFor: 'copying' stamp: 'lr 12/26/2007 21:49'! postCopy super postCopy. parentNode := nil. firstChild := lastChild := nil. previousSibling := nextSibling := nil! ! !SFNode methodsFor: 'accessing' stamp: 'lr 12/19/2007 10:29'! previousSibling "The node immediately preceding this node, or nil if there is no sibling node." ^ previousSibling! ! !SFNode methodsFor: 'printing' stamp: 'lr 12/19/2007 10:31'! printOn: aStream super printOn: aStream. aStream nextPut: $[; print: self hash; nextPut: $]! ! !SFNode methodsFor: 'modifying' stamp: 'lr 12/19/2007 17:25'! remove ^ parentNode removeChild: self! ! !SFNode methodsFor: 'modifying' stamp: 'lr 12/19/2007 17:26'! remove: aNode ^ self removeChild: aNode! ! !SFNode methodsFor: 'modifying-dom' stamp: 'lr 1/7/2008 13:42'! removeChild: aNode "Remove the child node indicated by aNode from the list of children, and returns it." aNode parentNode = self ifFalse: [ ^ self errorNotFound: aNode ]. aNode previousSibling isNil ifTrue: [ firstChild := aNode nextSibling ] ifFalse: [ aNode previousSibling setNextSibling: aNode nextSibling ]. aNode nextSibling isNil ifTrue: [ lastChild := aNode previousSibling ] ifFalse: [ aNode nextSibling setPreviousSibling: aNode previousSibling ]. aNode setPreviousSibling: nil; setNextSibling: nil; setParentNode: nil. self announce: (SFRemoveEvent new parentNode: self; node: aNode). ^ aNode! ! !SFNode methodsFor: 'modifying' stamp: 'lr 12/24/2007 13:29'! removeFirst "Remove the first element of the receiver and answer it. If the receiver is empty, create an error notification." ^ self removeChild: firstChild! ! !SFNode methodsFor: 'modifying' stamp: 'lr 12/24/2007 13:29'! removeLast "Remove the last element of the receiver and answer it. If the receiver is empty, create an error notification." ^ self removeChild: lastChild! ! !SFNode methodsFor: 'modifying-dom' stamp: 'lr 12/19/2007 17:27'! replaceChild: oldNode with: newNode "Replace the child node oldChild with newChild in the list of children, and returns the oldChild node." self insert: newNode before: oldNode. ^ self remove: oldNode! ! !SFNode methodsFor: 'initialization' stamp: 'lr 12/19/2007 10:28'! setFirstChild: aNode firstChild := aNode! ! !SFNode methodsFor: 'initialization' stamp: 'lr 12/19/2007 10:28'! setLastChild: aNode lastChild := aNode! ! !SFNode methodsFor: 'initialization' stamp: 'lr 12/19/2007 10:28'! setNextSibling: aNode nextSibling := aNode! ! !SFNode methodsFor: 'initialization' stamp: 'lr 12/19/2007 10:28'! setParentNode: aNode parentNode := aNode! ! !SFNode methodsFor: 'initialization' stamp: 'lr 12/19/2007 10:27'! setPreviousSibling: aNode previousSibling := aNode! ! !SFNode methodsFor: 'building' stamp: 'lr 1/9/2008 16:44'! with: anObject anObject buildOn: (SFBuilder on: self)! ! SFNode subclass: #SFTag instanceVariableNames: 'attributes' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements'! SFTag subclass: #SFAnchorTag instanceVariableNames: 'callback' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements-XHTML'! !SFAnchorTag methodsFor: 'accessing' stamp: 'lr 1/10/2008 11:18'! callback: aBlock callback := aBlock! ! !SFAnchorTag methodsFor: 'accessing' stamp: 'lr 12/24/2007 13:10'! tag ^ 'a'! ! SFTag subclass: #SFGenericTag instanceVariableNames: 'tag' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements-XHTML'! !SFGenericTag class methodsFor: 'instance-creation' stamp: 'lr 1/7/2008 13:56'! tag: aString ^ self new setTag: aString! ! !SFGenericTag methodsFor: 'initialization' stamp: 'lr 1/7/2008 13:56'! setTag: aString tag := aString! ! !SFGenericTag methodsFor: 'accessing' stamp: 'lr 12/24/2007 13:10'! tag ^ tag! ! SFTag subclass: #SFHeadingTag instanceVariableNames: 'level' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements-XHTML'! !SFHeadingTag methodsFor: 'initialization' stamp: 'lr 1/9/2008 16:21'! initialize super initialize. level := 1! ! !SFHeadingTag methodsFor: 'accessing' stamp: 'lr 1/9/2008 16:21'! level: anInteger level := anInteger! ! !SFHeadingTag methodsFor: 'accessing' stamp: 'lr 1/9/2008 16:21'! tag ^ 'h' , level asString! ! !SFTag methodsFor: 'accessing' stamp: 'lr 1/7/2008 13:58'! attributes ^ attributes! ! !SFTag methodsFor: 'encoding' stamp: 'lr 1/7/2008 13:58'! encodeOn: aDocument aDocument openTag: self tag attributes: self attributes closed: self isClosed. self isClosed ifTrue: [ ^ self ]. super encodeOn: aDocument. aDocument closeTag: self tag! ! !SFTag methodsFor: 'initialization' stamp: 'lr 1/7/2008 13:58'! initialize super initialize. attributes := WAHtmlAttributes new! ! !SFTag methodsFor: 'testing' stamp: 'lr 12/24/2007 13:10'! isClosed ^ false! ! !SFTag methodsFor: 'accessing' stamp: 'lr 12/24/2007 13:10'! tag self subclassResponsibility! ! SFNode subclass: #SFText instanceVariableNames: 'text' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements'! !SFText methodsFor: 'encoding' stamp: 'lr 12/24/2007 13:13'! encodeOn: aDocument aDocument print: text! ! SFNode subclass: #SFView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements'! SFView subclass: #SFCounterExample instanceVariableNames: 'heading count' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Examples'! !SFCounterExample methodsFor: 'as yet unclassified' stamp: 'lr 1/9/2008 16:37'! buildOn: html heading := html heading: count. html div with: [ html anchor callback: [ count := count - 1 ]; with: '++'. html anchor callback: [ count := count - 1 ]; with: '--' ]! ! !SFCounterExample methodsFor: 'as yet unclassified' stamp: 'lr 1/8/2008 09:58'! initialize super initialize. count := 0! ! WAComponent subclass: #SFComponent instanceVariableNames: 'document' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Core'! !SFComponent class methodsFor: 'as yet unclassified' stamp: 'lr 1/8/2008 10:06'! on: aDocument ^ self new initializeOn: aDocument! ! !SFComponent methodsFor: 'accessing' stamp: 'lr 1/9/2008 15:40'! document ^ document! ! !SFComponent methodsFor: 'initialization' stamp: 'lr 1/9/2008 15:38'! initializeOn: aDocument document := aDocument! ! !SFComponent methodsFor: 'rendering' stamp: 'lr 1/9/2008 15:39'! renderContentOn: html html context document encodeOn: self document! ! SFComponent subclass: #SFXhtmlView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Core'! WAComponent subclass: #SFStarfishBrowser instanceVariableNames: 'application current' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Examples'! !SFStarfishBrowser class methodsFor: 'initialization' stamp: 'lr 1/8/2008 10:11'! initialize (self registerAsApplication: 'starfish') addLibrary: SULibrary! ! !SFStarfishBrowser methodsFor: 'accessing' stamp: 'lr 1/9/2008 16:04'! applications ^ SFDocument allSubclasses! ! !SFStarfishBrowser methodsFor: 'rendering' stamp: 'lr 1/9/2008 16:05'! renderContentOn: html html select id: 'starfish-sel'; selected: current; list: self applications; callback: [ :value | self application: current ]; onChange: (html updater id: 'starfish-app'; triggerFormElement: 'starfish-sel'; callback: [ :r | r render: current ]). html div id: 'starfish-app'; with: current! ! Collection subclass: #SFIterator instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements'! SFIterator subclass: #SFChildrenIterator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements'! !SFChildrenIterator methodsFor: 'enumerating' stamp: 'lr 12/19/2007 22:17'! do: aBlock | current | current := node firstChild. [ current isNil ] whileFalse: [ aBlock value: current. current := current nextSibling ]! ! !SFIterator class methodsFor: 'instance-creation' stamp: 'lr 12/19/2007 11:54'! on: aNode ^ self basicNew initializeOn: aNode! ! !SFIterator methodsFor: 'accessing' stamp: 'lr 12/19/2007 13:22'! contents ^ self collect: [ :each | each ]! ! !SFIterator methodsFor: 'initialization' stamp: 'lr 12/19/2007 11:54'! initializeOn: aNode node := aNode! ! !SFIterator methodsFor: 'private' stamp: 'lr 12/19/2007 14:09'! species ^ OrderedCollection! ! SFIterator subclass: #SFTreeIterator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements'! !SFTreeIterator methodsFor: 'enumerating' stamp: 'lr 12/19/2007 11:58'! do: aBlock self do: aBlock startingAt: node ! ! !SFTreeIterator methodsFor: 'enumerating' stamp: 'lr 12/24/2007 13:18'! do: aBlock startingAt: aNode | current | current := aNode firstChild. [ current isNil ] whileFalse: [ aBlock value: current. self do: aBlock startingAt: current. current := current nextSibling ]! ! !BlockContext methodsFor: '*starfish' stamp: 'lr 1/9/2008 16:31'! buildOn: aBuilder self numArgs = 0 ifTrue: [ self value ] ifFalse: [ self value: aBuilder ]! ! Announcement subclass: #SFAnnouncement instanceVariableNames: 'stopped node' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Events'! !SFAnnouncement methodsFor: 'initialization' stamp: 'lr 1/8/2008 09:29'! initialize super initialize. stopped := false! ! !SFAnnouncement methodsFor: 'testing' stamp: 'lr 1/8/2008 09:29'! isStopped ^ stopped! ! !SFAnnouncement methodsFor: 'accessing' stamp: 'lr 1/8/2008 09:28'! node ^node! ! !SFAnnouncement methodsFor: 'accessing' stamp: 'lr 1/8/2008 09:28'! node: aNode node := aNode! ! SFAnnouncement subclass: #SFInsertEvent instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Events'! SFAnnouncement subclass: #SFRemoveEvent instanceVariableNames: 'parentNode' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Events'! !SFRemoveEvent methodsFor: 'accessing' stamp: 'lr 12/28/2007 13:26'! parentNode ^parentNode! ! !SFRemoveEvent methodsFor: 'accessing' stamp: 'lr 12/28/2007 13:26'! parentNode: anObject parentNode := anObject! ! TestCase subclass: #SFDocumentTest instanceVariableNames: 'document events' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Tests'! !SFDocumentTest methodsFor: 'running' stamp: 'lr 1/8/2008 09:34'! setUp super setUp. events := OrderedCollection new. document := SFDocument new. document announcer on: SFAnnouncement send: #add: to: events! ! !SFDocumentTest methodsFor: 'testing' stamp: 'lr 1/8/2008 09:32'! testAppendEvent | node | node := SFNode new. document appendChild: node. self assert: (events size = 1). self assert: (events first isKindOf: SFInsertEvent). self assert: (events first node = node)! ! !SFDocumentTest methodsFor: 'testing' stamp: 'lr 1/8/2008 09:32'! testInsertAfterEvent | node1 node2 | node1 := SFNode new. node2 := SFNode new. document appendChild: node1. document insert: node2 before: node1. self assert: (events size = 2). self assert: (events second isKindOf: SFInsertEvent). self assert: (events second node = node2)! ! !SFDocumentTest methodsFor: 'testing' stamp: 'lr 1/8/2008 09:33'! testRemoveEvent | node | node := SFNode new. document appendChild: node. document removeChild: node. self assert: (events size = 2). self assert: (events second isKindOf: SFRemoveEvent). self assert: (events second node = node). self assert: (events second parentNode = document)! ! TestCase subclass: #SFNodeTest instanceVariableNames: 'root elements' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Tests'! !SFNodeTest methodsFor: 'utilities' stamp: 'lr 12/24/2007 15:55'! assertChildren: aNode equal: aCollection self assert: aNode children contents asOrderedCollection = aCollection asOrderedCollection! ! !SFNodeTest methodsFor: 'utilities' stamp: 'lr 12/24/2007 15:54'! assertConsistent: aNode | firstChild lastChild | firstChild := lastChild := Object new. aNode children do: [ :each | self assert: aNode = each parentNode. each previousSibling isNil ifTrue: [ firstChild := each ] ifFalse: [ self assert: each previousSibling nextSibling = each ]. each nextSibling isNil ifTrue: [ lastChild := each ] ifFalse: [ self assert: each nextSibling previousSibling = each ] ]. aNode isEmpty ifTrue: [ self assert: aNode firstChild isNil. self assert: aNode lastChild isNil ] ifFalse: [ self assert: aNode firstChild = firstChild. self assert: aNode firstChild previousSibling isNil. self assert: aNode lastChild = lastChild. self assert: aNode lastChild nextSibling isNil ]! ! !SFNodeTest methodsFor: 'accessing' stamp: 'lr 12/24/2007 16:45'! count ^ 50! ! !SFNodeTest methodsFor: 'running' stamp: 'lr 12/24/2007 16:01'! fill | element | self count timesRepeat: [ element := SFNode new. elements add: element. root add: element ]! ! !SFNodeTest methodsFor: 'running' stamp: 'lr 12/24/2007 15:58'! setUp root := SFNode new. elements := OrderedCollection new! ! !SFNodeTest methodsFor: 'testing' stamp: 'lr 12/24/2007 16:05'! testAdd | element | self count timesRepeat: [ element := SFNode new. elements add: element. self assert: (root add: element) = element. self assertConsistent: root. self assertChildren: root equal: elements ]! ! !SFNodeTest methodsFor: 'testing' stamp: 'lr 12/24/2007 16:05'! testAddAfter | element target | element := SFNode new. elements add: element. root add: element. self count timesRepeat: [ element := SFNode new. target := elements atRandom. elements add: element after: target. self assert: (root add: element after: target) = element. self assertConsistent: root. self assertChildren: root equal: elements ]! ! !SFNodeTest methodsFor: 'testing' stamp: 'lr 12/24/2007 16:05'! testAddBefore | element target | element := SFNode new. elements add: element. root add: element. self count timesRepeat: [ element := SFNode new. target := elements atRandom. elements add: element before: target. self assert: (root add: element before: target) = element. self assertConsistent: root. self assertChildren: root equal: elements ]! ! !SFNodeTest methodsFor: 'testing' stamp: 'lr 12/24/2007 16:05'! testAddFirst | element | self count timesRepeat: [ element := SFNode new. elements addFirst: element. self assert: (root addFirst: element) = element. self assertConsistent: root. self assertChildren: root equal: elements ]! ! !SFNodeTest methodsFor: 'testing' stamp: 'lr 12/24/2007 16:04'! testAddLast | element | self count timesRepeat: [ element := SFNode new. elements addLast: element. self assert: (root addLast: element) = element. self assertConsistent: root. self assertChildren: root equal: elements ]! ! !SFNodeTest methodsFor: 'testing' stamp: 'lr 1/8/2008 09:30'! testEmpty self assert: root isEmpty. self assertConsistent: root! ! !SFNodeTest methodsFor: 'testing-errors' stamp: 'lr 1/7/2008 13:48'! testInsertBeforeNodeNotFound self should: [ root add: SFNode new before: SFNode new ] raise: SFErrorNodeNotFound! ! !SFNodeTest methodsFor: 'testing' stamp: 'lr 12/24/2007 16:45'! testRemove | element | self fill. [ elements isEmpty ] whileFalse: [ element := elements atRandom. elements remove: element. self assert: (root remove: element) = element. self assertConsistent: root. self assertChildren: root equal: elements ]! ! !SFNodeTest methodsFor: 'testing' stamp: 'lr 12/24/2007 16:45'! testRemove2 | element | self fill. [ elements isEmpty ] whileFalse: [ element := elements atRandom. elements remove: element. self assert: element remove = element. self assertConsistent: root. self assertChildren: root equal: elements ]! ! !SFNodeTest methodsFor: 'testing' stamp: 'lr 12/24/2007 16:04'! testRemoveFirst | element | self fill. [ elements isEmpty ] whileFalse: [ element := elements removeFirst. self assert: root removeFirst = element. self assertConsistent: root. self assertChildren: root equal: elements ]! ! !SFNodeTest methodsFor: 'testing' stamp: 'lr 12/24/2007 16:04'! testRemoveLast | element | self fill. [ elements isEmpty ] whileFalse: [ element := elements removeLast. self assert: root removeLast = element. self assertConsistent: root. self assertChildren: root equal: elements ]! ! !SFNodeTest methodsFor: 'testing-errors' stamp: 'lr 1/7/2008 13:47'! testRemoveNodeNotFound self should: [ root remove: SFNode new ] raise: SFErrorNodeNotFound! ! !SFNodeTest methodsFor: 'testing-errors' stamp: 'lr 1/7/2008 13:49'! testReplaceWithNodeNotFound self should: [ root replaceChild: SFNode new with: SFNode new ] raise: SFErrorNodeNotFound! ! SFStarfishBrowser initialize!