SystemOrganization addCategory: #'Starfish-Core'! SystemOrganization addCategory: #'Starfish-Events'! SystemOrganization addCategory: #'Starfish-Elements'! SystemOrganization addCategory: #'Starfish-Tests'! WAEntryPoint subclass: #SFHandler instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Core'! !SFHandler class methodsFor: 'accessing' stamp: 'lr 12/19/2007 10:05'! description ^ 'Seastar Handler'! ! !SFHandler methodsFor: 'processing' stamp: 'lr 12/19/2007 10:06'! handleRequest: aRequest ! ! Object subclass: #SFNode instanceVariableNames: 'parentNode firstChild lastChild previousSibling nextSibling' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements'! !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 12/24/2007 19:24'! announce: anAnnouncement parentNode ifNil: [ ^ self ]. parentNode announce: anAnnouncement! ! !SFNode methodsFor: 'modifying-dom' stamp: 'lr 12/26/2007 21:40'! 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: (SFInsertionEvent on: aNode). ^ aNode! ! !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: 'private' stamp: 'lr 12/28/2007 13:11'! errorNotFound: anObject self error: 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 12/28/2007 13:28'! 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: (SFInsertionEvent 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 12/28/2007 13:29'! 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 subclass: #SFTagNode instanceVariableNames: 'attributes' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements'! SFTagNode subclass: #SFAnchorTag instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements'! !SFAnchorTag methodsFor: 'as yet unclassified' stamp: 'lr 12/24/2007 13:10'! tag ^ 'a'! ! SFTagNode subclass: #SFGenericTag instanceVariableNames: 'tag' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements'! !SFGenericTag methodsFor: 'as yet unclassified' stamp: 'lr 12/24/2007 13:10'! tag ^ tag! ! !SFTagNode methodsFor: 'encoding' stamp: 'lr 12/24/2007 13:13'! encodeOn: aDocument aDocument openTag: self tag attributes: attributes closed: self isClosed. self isClosed ifTrue: [ ^ self ]. self isEmpty ifFalse: [ self children do: [ :each | aDocument print: each ] ]. aDocument closeTag: self tag! ! !SFTagNode methodsFor: 'testing' stamp: 'lr 12/24/2007 13:10'! isClosed ^ false! ! !SFTagNode methodsFor: 'accessing' stamp: 'lr 12/24/2007 13:10'! tag self subclassResponsibility! ! SFNode subclass: #SFTextNode instanceVariableNames: 'text' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements'! !SFTextNode methodsFor: 'as yet unclassified' stamp: 'lr 12/24/2007 13:13'! encodeOn: aDocument aDocument print: text! ! Object subclass: #SFOpposite instanceVariableNames: 'owner selector' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Core'! SFOpposite subclass: #SFMany instanceVariableNames: 'elements' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Core'! !SFMany methodsFor: 'initialization' stamp: 'lr 12/21/2007 20:24'! initializeOn: aSelector of: anObject super initializeOn: aSelector of: anObject. elements := OrderedCollection new! ! !SFMany methodsFor: 'private' stamp: 'lr 12/21/2007 20:42'! primitiveAdd: anObject opposite: anOpposite elements add: anOpposite! ! !SFMany methodsFor: 'private' stamp: 'lr 12/21/2007 20:42'! primitiveRemove: anObject opposite: anOpposite elements remove: anOpposite! ! SFOpposite subclass: #SFOne instanceVariableNames: 'element' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Core'! !SFOne methodsFor: 'private' stamp: 'lr 12/21/2007 20:42'! primitiveAdd: anObject opposite: anOpposite element := anOpposite! ! !SFOne methodsFor: 'private' stamp: 'lr 12/21/2007 20:35'! primitiveRemove: anObject opposite: anOpposite element := nil! ! !SFOpposite class methodsFor: 'as yet unclassified' stamp: 'lr 12/21/2007 20:16'! on: aSelector of: anObject ^ self basicNew initializeOn: aSelector of: anObject! ! !SFOpposite methodsFor: 'accessing' stamp: 'lr 12/21/2007 20:31'! add: anObject | opposite | opposite := anObject perform: selector. opposite primitiveAdd: owner opposite: self. self primitiveAdd: anObject opposite: opposite! ! !SFOpposite methodsFor: 'initialization' stamp: 'lr 12/21/2007 20:26'! initializeOn: aSelector of: anObject owner := anObject. selector := aSelector! ! !SFOpposite methodsFor: 'accessing' stamp: 'lr 12/21/2007 20:47'! owner ^ owner! ! !SFOpposite methodsFor: 'private' stamp: 'lr 12/21/2007 20:33'! primitiveAdd: anObject opposite: anOpposite self subclassResponsibility! ! !SFOpposite methodsFor: 'private' stamp: 'lr 12/21/2007 20:33'! primitiveRemove: anObject opposite: anOpposite self subclassResponsibility! ! !SFOpposite methodsFor: 'accessing' stamp: 'lr 12/21/2007 20:33'! remove: anObject | opposite | opposite := anObject perform: selector. opposite primitiveRemove: owner opposite: self. self primitiveRemove: anObject opposite: opposite! ! 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 ]! ! Announcement subclass: #SFInsertionEvent instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Events'! !SFInsertionEvent methodsFor: 'accessing' stamp: 'lr 12/28/2007 13:28'! node ^node! ! !SFInsertionEvent methodsFor: 'accessing' stamp: 'lr 12/28/2007 13:28'! node: anObject node := anObject! ! Announcement subclass: #SFRemoveEvent instanceVariableNames: 'parentNode node' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Events'! !SFRemoveEvent methodsFor: 'accessing' stamp: 'lr 12/28/2007 13:26'! node ^node! ! !SFRemoveEvent methodsFor: 'accessing' stamp: 'lr 12/28/2007 13:26'! node: anObject node := anObject! ! !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: #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 12/19/2007 13:59'! testEmpty self assert: node isEmpty. self assertConsistent: node! ! !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 ]! !