Smalltalk createPackage: 'Trapped'! (Smalltalk packageAt: 'Trapped' ifAbsent: [ self error: 'Package not created: Trapped' ]) imports: {'amber/web/Web'}! Object subclass: #TrappedDataCarrier instanceVariableNames: 'target model chain' package: 'Trapped'! !TrappedDataCarrier methodsFor: 'accessing'! chain: aProcessingChain chain := aProcessingChain ! target ^target ! target: anObject target := anObject ! value ^model ! value: anObject model := anObject ! value: anObject whenDifferentFrom: anotherObject anObject = anotherObject ifFalse: [ self value: anObject ] ! ! !TrappedDataCarrier methodsFor: 'converting'! falseAsNilValue | value | value := self value. value = false ifTrue: [ ^nil ] ifFalse: [ ^value ] ! ! !TrappedDataCarrier methodsFor: 'initialization'! initialize super initialize. model := true ! ! !TrappedDataCarrier class methodsFor: 'not yet classified'! on: aProcessingChain target: anObject ^self new chain: aProcessingChain; target: anObject; yourself ! ! TrappedDataCarrier subclass: #TrappedDataCarrierToModel instanceVariableNames: 'index' package: 'Trapped'! !TrappedDataCarrierToModel methodsFor: 'not yet classified'! proceed index := index ifNil: [ chain lastProcessorNo ] ifNotNil: [ index - 1 ]. (chain processorNo: index) toModel: self ! ! TrappedDataCarrier subclass: #TrappedDataCarrierToView instanceVariableNames: 'index' package: 'Trapped'! !TrappedDataCarrierToView methodsFor: 'not yet classified'! proceed index := index ifNil: [ chain firstProcessorNo ] ifNotNil: [ index + 1 ]. (chain processorNo: index) toView: self ! ! Object subclass: #TrappedPosition instanceVariableNames: 'path model' package: 'Trapped'! !TrappedPosition methodsFor: 'accessing'! model ^model ! path ^path ! path: anArray model: aTrappedMW path := anArray. model := aTrappedMW ! ! !TrappedPosition methodsFor: 'action'! modify: aBlock self model axes: self path transform: aBlock ! read: aBlock self model axes: self path consume: aBlock ! watch: aBlock self model axxord addInterest: (self class interestOn: self path block: [ self read: aBlock ]) ! ! !TrappedPosition class methodsFor: 'factory'! interestOn: anAspect block: aBlock (anAspect notEmpty and: [ anAspect last isNil ]) ifTrue: [ ^ Axes newInterestThru: anAspect allButLast doing: aBlock ] ifFalse: [ ^ Axes newInterestUpTo: anAspect doing: aBlock ] ! ! TrappedPosition subclass: #TrappedSnapshot instanceVariableNames: 'prefix' package: 'Trapped'! !TrappedSnapshot methodsFor: 'accessing'! prefix ^ prefix ! prefix: anObject prefix := anObject ! ! !TrappedSnapshot methodsFor: 'action'! do: aBlock TrappedPathStack current with: {prefix}, path do: [ aBlock value: model ] ! ! Object subclass: #TrappedProcessingChain instanceVariableNames: 'processors' package: 'Trapped'! !TrappedProcessingChain methodsFor: 'accessing'! firstProcessorNo ^1 ! lastProcessorNo ^processors size ! processorNo: aNumber ^processors at: aNumber ! processors: anArray processors := anArray ! ! !TrappedProcessingChain methodsFor: 'action'! forSnapshot: aSnapshot andBrush: aTagBrush | toViewCarrier toModelCarrier | toViewCarrier := TrappedDataCarrierToView on: self target: aTagBrush. toModelCarrier := TrappedDataCarrierToModel on: self target: aSnapshot. processors do: [ :each | each installToView: toViewCarrier toModel: toModelCarrier ]. toViewCarrier value = true ifTrue: [ toViewCarrier copy proceed ] ! ! !TrappedProcessingChain class methodsFor: 'instance creation'! new: anArray (anArray anySatisfy: [ :each | each isExpectingModelData ]) ifFalse: [ anArray add: self dataTerminator ] ifTrue: [ anArray addFirst: self blackboardReaderWriter ]. ^self new processors: anArray; yourself ! newFromProcessorSpecs: anArray ^self new: ((anArray ifEmpty: [ #(contents) ]) collect: [ :each | each asTrapProcSendTo: TrappedProcessor ]) ! ! !TrappedProcessingChain class methodsFor: 'private'! blackboardReaderWriter ^TrappedProcessorBlackboard new ! dataTerminator ^TrappedProcessorTerminator new ! ! Object subclass: #TrappedProcessor instanceVariableNames: '' package: 'Trapped'! !TrappedProcessor commentStamp! I am a processing step in TrappedProcessingChain. I am stateless flyweight (aka servant) and will get all necessary data as arguments in API calls. My public API is: - installToView:toModel: This gets two TrappedDataCarriers set up without actual data and at the beginning of their chains. It should do one-time installation task needed (install event handlers etc.). To start a chain, do: dataCarrier copy value: data; proceed. - toView: This performs transformation of TrappedDataCarrier on its way from model to view. Should call aDataCarrier proceed to proceed to subsequent step. - toModel: This performs transformation of TrappedDataCarrier on its way from view to model. Should call aDataCarrier proceed to proceed to subsequent step.! !TrappedProcessor methodsFor: 'data transformation'! toModel: aDataCarrier "by default, proceed" aDataCarrier proceed ! toView: aDataCarrier "by default, proceed" aDataCarrier proceed ! ! !TrappedProcessor methodsFor: 'installation'! installToView: aDataCarrier toModel: anotherDataCarrier "by default, do nothing" ! ! !TrappedProcessor methodsFor: 'testing'! isExpectingModelData ^false ! ! !TrappedProcessor class methodsFor: 'factory'! contents ^TrappedProcessorContents new ! ! TrappedProcessor subclass: #TrappedDataExpectingProcessor instanceVariableNames: '' package: 'Trapped'! !TrappedDataExpectingProcessor commentStamp! I answer true to isExpectingModelData and serve as a base class for processor that present / change model data. When at least one of my instances is present in the chain, automatic databinding processor is added at the beginning (the data-binding scenario); otherwise, the chain is run immediately with true as data (run-once scenario).! !TrappedDataExpectingProcessor methodsFor: 'testing'! isExpectingModelData ^true ! ! TrappedDataExpectingProcessor subclass: #TrappedProcessorContents instanceVariableNames: '' package: 'Trapped'! !TrappedProcessorContents commentStamp! I put data into target via contents: in toView:! !TrappedProcessorContents methodsFor: 'data transformation'! toView: aDataCarrier aDataCarrier toTargetContents ! ! TrappedProcessor subclass: #TrappedProcessorBlackboard instanceVariableNames: '' package: 'Trapped'! !TrappedProcessorBlackboard commentStamp! I am used internally to fetch data from blackboard or write it back. I am added to the beginning of the chain when the chain contains at least one element that isExpectingModelData (see TrappedDataExpectingProcessor).! !TrappedProcessorBlackboard methodsFor: 'data transformation'! toModel: aDataCarrier aDataCarrier modifyTarget ! ! !TrappedProcessorBlackboard methodsFor: 'installation'! installToView: aDataCarrier toModel: anotherDataCarrier | snap | snap := anotherDataCarrier target. snap watch: [ :data | (aDataCarrier target asJQuery closest: 'html') toArray isEmpty ifTrue: [ AxonOff signal ]. snap do: [ aDataCarrier copy value: data; proceed ] ]. aDataCarrier value: false ! ! TrappedProcessor subclass: #TrappedProcessorTerminator instanceVariableNames: '' package: 'Trapped'! !TrappedProcessorTerminator commentStamp! I do not proceed in toView:. I am added automatically to end of chain when it does not contain any element that isExpectingModelData (see TrappedDataExpectingProcessor).! !TrappedProcessorTerminator methodsFor: 'data transformation'! toView: aDataCarrier "stop" ! ! Object subclass: #TrappedSingleton instanceVariableNames: '' package: 'Trapped'! !TrappedSingleton methodsFor: 'action'! start: args ^ self subclassResponsibility ! ! TrappedSingleton class instanceVariableNames: 'current'! !TrappedSingleton class methodsFor: 'accessing'! current ^ current ifNil: [ current := self new ] ! ! !TrappedSingleton class methodsFor: 'action'! start: args self current start: args ! ! TrappedSingleton subclass: #Trapped instanceVariableNames: 'registry' package: 'Trapped'! !Trapped methodsFor: 'accessing'! byName: aString ^ registry at: aString ! register: aListKeyedEntity self register: aListKeyedEntity name: aListKeyedEntity trappedLabel ! register: aListKeyedEntity name: aString registry at: aString put: aListKeyedEntity ! ! !Trapped methodsFor: 'action'! start: args args do: [ :each | self register: each ]. self injectToElement: document ! ! !Trapped methodsFor: 'initialization'! initialize super initialize. registry := #{}. ! ! !Trapped methodsFor: 'private'! cloneAndInject: anObject ^anObject asJQuery clone each: [ :i :each | self injectToElement: each ]; get: 0 ! descend: anArray snapshotDo: aBlock | tpsc | tpsc := TrappedPathStack current. tpsc append: anArray do: [ | prefix modelPath model | prefix := tpsc elements first. modelPath := tpsc elements allButFirst. model := self byName: prefix. aBlock value: (TrappedSnapshot new prefix: prefix; path: modelPath model: model) ] ! injectToChildren: anElement | child | child := anElement firstChild. [ child isNil ] whileFalse: [ self injectToElement: child. child := child nextSibling ] ! injectToElement: anElement | jq | jq := anElement asJQuery. (jq attr: 'data-trap') ifNotNil: [ :attr | jq removeAttr: 'data-trap'. (Trapped parse: attr) do: [ :rule | (HTMLCanvas onJQuery: jq) root trap: rule first processors: (rule at: 2 ifAbsent: [#()]) ] ]. self injectToChildren: anElement ! ! !Trapped class methodsFor: 'parsing'! parse: aString ^ (aString tokenize: '.') collect: [ :rule | (rule tokenize: ':') collect: [ :message | Axes parse: message ] ] ! ! !Trapped class methodsFor: 'private'! loop: aSequenceableCollection before: aNode do: aBlock aSequenceableCollection withIndexDo: [ :item :i | | env | "env := document createDocumentFragment." env := document createElement: 'ins'. {i} trapDescend: [ (HTMLCanvas onJQuery: env asJQuery) root with: aBlock ]. "aNode parentNode insertBefore: env reference: aNode" (Array streamContents: [ :str | | child | child := env firstChild. [ child isNil ] whileFalse: [ str nextPut: child. child := child nextSibling ]]) do: [ :each | aNode parentNode insertBefore: each reference: aNode ] ] ! loop: aSequenceableCollection between: aTagBrush and: anotherTagBrush do: aBlock (aTagBrush asJQuery nextUntil: anotherTagBrush element) remove. aSequenceableCollection ifNotNil: [ self loop: aSequenceableCollection before: anotherTagBrush element do: aBlock ] ! ! TrappedSingleton subclass: #TrappedPathStack instanceVariableNames: 'elements' package: 'Trapped'! !TrappedPathStack methodsFor: 'accessing'! elements ^elements ! ! !TrappedPathStack methodsFor: 'descending'! append: anArray do: aBlock self with: elements, anArray do: aBlock ! with: anArray do: aBlock | old | old := elements. [ elements := anArray. aBlock value ] ensure: [ elements := old ] ! ! !TrappedPathStack methodsFor: 'initialization'! initialize super initialize. elements := #(). ! ! !Array methodsFor: '*Trapped'! asTrapProcSendTo: anObject | selector args | selector := ''. args := #(). self withIndexDo: [ :element :index | index odd ifTrue: [ selector := selector, element ] ifFalse: [ selector := selector, ':'. args add: element ] ]. ^anObject perform: selector withArguments: args ! trapDescend: aBlock Trapped current descend: self snapshotDo: aBlock ! ! !Axolator methodsFor: '*Trapped'! trappedLabel ^ root trappedLabel ! ! !HTMLCanvas methodsFor: '*Trapped'! trapIter: path do: aBlock self with: [ :html | (html tag: 'script') at: 'type' put: 'application/x-beacon'; trapIter: path after: aBlock ] ! ! !Object methodsFor: '*Trapped'! asTrapProcSendTo: anObject self error: 'Trapped cannot use processor descriptor of ', self class name, ' type.' ! trappedLabel ^ self class name ! ! !String methodsFor: '*Trapped'! asTrapProcSendTo: anObject ^anObject perform: self ! ! !TagBrush methodsFor: '*Trapped'! trap: path self trap: path processors: #() ! trap: path processors: anArray path trapDescend: [ :snap | (TrappedProcessingChain newFromProcessorSpecs: anArray) forSnapshot: snap andBrush: self ] ! trap: path read: aBlock path trapDescend: [ :snap | snap watch: [ :data | (self asJQuery closest: 'html') toArray isEmpty ifTrue: [ AxonOff signal ]. snap do: [ self with: [ :html | aBlock value: data value: html ] ] ] ] ! trapGuard: anArray contents: aBlock #() trapDescend: [ :snap | | shown | shown := nil. self trap: anArray read: [ :gdata | | sanitized | sanitized := gdata ifNil: [ false ]. shown = sanitized ifFalse: [ shown := sanitized. shown ifTrue: [ snap do: [ self contents: aBlock ]. self asJQuery show ] ifFalse: [ self asJQuery hide; empty ] ] ] ] ! trapIter: path after: aBlock | end | end := TagBrush fromJQuery: ('