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'! 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/18/2008 14:56'! initializeOn: aDocument document := aDocument with: aDocument! ! !SFComponent methodsFor: 'rendering' stamp: 'lr 1/18/2008 14:46'! renderContentOn: html self document encodeOn: html context document! ! SFComponent subclass: #SFXhtmlView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Core'! WAComponent subclass: #SFStarfishBrowser instanceVariableNames: 'component view' 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-readonly' stamp: 'lr 1/18/2008 14:44'! children ^ Array with: component! ! !SFStarfishBrowser methodsFor: 'initialization' stamp: 'lr 1/18/2008 14:42'! initialize super initialize. self update: self views first! ! !SFStarfishBrowser methodsFor: 'rendering' stamp: 'lr 1/18/2008 14:44'! renderContentOn: html html form: [ html select list: self views; selected: self view; callback: [ :value | self view: value ]. html submitButton text: 'show' ]. html render: component! ! !SFStarfishBrowser methodsFor: 'accessing-readonly' stamp: 'lr 1/18/2008 14:49'! states ^ Array with: self! ! !SFStarfishBrowser methodsFor: 'accessing' stamp: 'lr 1/18/2008 14:43'! view ^ view! ! !SFStarfishBrowser methodsFor: 'accessing' stamp: 'lr 1/18/2008 14:57'! view: aView component := SFXhtmlView on: aView new. view := aView! ! !SFStarfishBrowser methodsFor: 'accessing-readonly' stamp: 'lr 1/18/2008 14:44'! views ^ SFView allSubclasses asArray sort: [ :a :b | a name < b name ]! ! !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:44'! 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 ) ( break SFBreakTag ) ( horizontalRule SFRuleTag ))! ! !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:45'! anchor ^ self add: SFAnchorTag new! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! anchor: anObject ^ self anchor with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! big ^ self tag: 'big'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! big: anObject ^ self big with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! break ^ self add: SFBreakTag new! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! break: anObject ^ self break with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! definitionData ^ self tag: 'dd'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! definitionData: anObject ^ self definitionData with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! definitionList ^ self tag: 'dl'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! definitionList: anObject ^ self definitionList with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! definitionTerm ^ self tag: 'dt'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! definitionTerm: anObject ^ self definitionTerm with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! div ^ self tag: 'div'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! div: anObject ^ self div with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! emphasis ^ self tag: 'em'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! emphasis: anObject ^ self emphasis with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! heading ^ self add: SFHeadingTag new! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! heading: anObject ^ self heading with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! horizontalRule ^ self add: SFRuleTag new! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! horizontalRule: anObject ^ self horizontalRule 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:45'! listItem ^ self tag: 'li'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! listItem: anObject ^ self listItem with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! ordereList ^ self tag: 'ol'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! ordereList: anObject ^ self ordereList with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! paragraph ^ self tag: 'p'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! paragraph: anObject ^ self paragraph with: anObject! ! !SFBuilder methodsFor: 'elements' stamp: 'lr 1/18/2008 15:03'! render: anObject anObject buildOn: self! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! small ^ self tag: 'small'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! small: anObject ^ self small with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! span ^ self tag: 'span'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! span: anObject ^ self span with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! strong ^ self tag: 'strong'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! strong: anObject ^ self strong with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! subscript ^ self tag: 'sub'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! subscript: anObject ^ self subscript with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! superscript ^ self tag: 'sup'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! superscript: anObject ^ self superscript with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! table ^ self tag: 'table'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! table: anObject ^ self table with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! tableBody ^ self tag: 'tbody'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! tableBody: anObject ^ self tableBody with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! tableData ^ self tag: 'td'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! tableData: anObject ^ self tableData with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! tableFoot ^ self tag: 'tfoot'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! tableFoot: anObject ^ self tableFoot with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! tableHead ^ self tag: 'thead'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! tableHead: anObject ^ self tableHead with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! tableHeading ^ self tag: 'th'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! tableHeading: anObject ^ self tableHeading with: anObject! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! tableRow ^ self tag: 'tr'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! 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/18/2008 14:55'! text: anObject "Emit anObject onto the target document." ^ self add: (SFText on: anObject)! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! unorderedList ^ self tag: 'ul'! ! !SFBuilder methodsFor: 'tags-generated' stamp: 'lr 1/10/2008 15:45'! 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/18/2008 14:52'! with: anObject [ self isEmpty ] whileFalse: [ self removeFirst ]. 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/18/2008 14:58'! callback: aBlock callback := aBlock. self attributes at: 'href' put: '#'! ! !SFAnchorTag methodsFor: 'accessing' stamp: 'lr 12/24/2007 13:10'! tag ^ 'a'! ! SFTag subclass: #SFBreakTag instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements-XHTML'! !SFBreakTag methodsFor: 'testing' stamp: 'lr 1/10/2008 15:44'! isClosed ^ true! ! !SFBreakTag methodsFor: 'accessing' stamp: 'lr 1/10/2008 15:44'! tag ^ 'br'! ! 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 subclass: #SFRuleTag instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements-XHTML'! !SFRuleTag methodsFor: 'testing' stamp: 'lr 1/10/2008 15:44'! isClosed ^ true! ! !SFRuleTag methodsFor: 'accessing' stamp: 'lr 1/10/2008 15:44'! tag ^ 'hr'! ! !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: 'contents' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements'! !SFText class methodsFor: 'instance-creation' stamp: 'lr 1/18/2008 14:54'! on: anObject ^ self new initializeOn: anObject! ! !SFText methodsFor: 'accessing' stamp: 'lr 1/18/2008 14:54'! contents ^ contents! ! !SFText methodsFor: 'encoding' stamp: 'lr 1/18/2008 14:54'! encodeOn: aDocument aDocument print: self contents! ! !SFText methodsFor: 'initialization' stamp: 'lr 1/18/2008 14:53'! initializeOn: anObject contents := anObject! ! SFNode subclass: #SFView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Elements'! SFView subclass: #SFCounter instanceVariableNames: 'heading count' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Examples'! !SFCounter methodsFor: 'as yet unclassified' stamp: 'lr 1/18/2008 14:38'! buildOn: html heading := html heading: count. html div with: [ html anchor callback: [ heading with: (count := count - 1) ]; with: '++'. html anchor callback: [ heading with: (count := count - 1) ]; with: '--' ]! ! !SFCounter methodsFor: 'as yet unclassified' stamp: 'lr 1/8/2008 09:58'! initialize super initialize. count := 0! ! SFView subclass: #SFMultiCounter instanceVariableNames: 'counters' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Examples'! !SFMultiCounter methodsFor: 'as yet unclassified' stamp: 'lr 1/18/2008 15:01'! buildOn: html (1 to: 5) do: [ :each | html add: SFCounter new ] separatedBy: [ html horizontalRule ]! ! Exception subclass: #SFErrorNodeNotFound instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Starfish-Exceptions'! !BlockContext methodsFor: '*starfish' stamp: 'lr 1/9/2008 16:31'! buildOn: aBuilder self numArgs = 0 ifTrue: [ self value ] ifFalse: [ self value: aBuilder ]! ! 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: #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!