Trapped.st 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567
  1. Smalltalk createPackage: 'Trapped'!
  2. (Smalltalk packageAt: 'Trapped' ifAbsent: [ self error: 'Package not created: Trapped' ]) imports: {'amber/web/Web'}!
  3. Object subclass: #TrappedDataCarrier
  4. instanceVariableNames: 'target model chain'
  5. package: 'Trapped'!
  6. !TrappedDataCarrier methodsFor: 'accessing'!
  7. chain: aProcessingChain
  8. chain := aProcessingChain
  9. !
  10. target
  11. ^target
  12. !
  13. target: anObject
  14. target := anObject
  15. !
  16. value
  17. ^model
  18. !
  19. value: anObject
  20. model := anObject
  21. !
  22. value: anObject whenDifferentFrom: anotherObject
  23. anObject = anotherObject ifFalse: [ self value: anObject ]
  24. ! !
  25. !TrappedDataCarrier methodsFor: 'converting'!
  26. falseAsNilValue
  27. | value |
  28. value := self value.
  29. value = false ifTrue: [ ^nil ] ifFalse: [ ^value ]
  30. ! !
  31. !TrappedDataCarrier methodsFor: 'initialization'!
  32. initialize
  33. super initialize.
  34. model := true
  35. ! !
  36. !TrappedDataCarrier class methodsFor: 'not yet classified'!
  37. on: aProcessingChain target: anObject
  38. ^self new
  39. chain: aProcessingChain;
  40. target: anObject;
  41. yourself
  42. ! !
  43. TrappedDataCarrier subclass: #TrappedDataCarrierToModel
  44. instanceVariableNames: 'index'
  45. package: 'Trapped'!
  46. !TrappedDataCarrierToModel methodsFor: 'not yet classified'!
  47. proceed
  48. index := index ifNil: [ chain lastProcessorNo ] ifNotNil: [ index - 1 ].
  49. (chain processorNo: index) toModel: self
  50. ! !
  51. TrappedDataCarrier subclass: #TrappedDataCarrierToView
  52. instanceVariableNames: 'index'
  53. package: 'Trapped'!
  54. !TrappedDataCarrierToView methodsFor: 'not yet classified'!
  55. proceed
  56. index := index ifNil: [ chain firstProcessorNo ] ifNotNil: [ index + 1 ].
  57. (chain processorNo: index) toView: self
  58. ! !
  59. Object subclass: #TrappedPosition
  60. instanceVariableNames: 'path model'
  61. package: 'Trapped'!
  62. !TrappedPosition methodsFor: 'accessing'!
  63. model
  64. ^model
  65. !
  66. path
  67. ^path
  68. !
  69. path: anArray model: aTrappedMW
  70. path := anArray.
  71. model := aTrappedMW
  72. ! !
  73. !TrappedPosition methodsFor: 'action'!
  74. modify: aBlock
  75. self model axes: self path transform: aBlock
  76. !
  77. read: aBlock
  78. self model axes: self path consume: aBlock
  79. !
  80. watch: aBlock
  81. self model axxord addInterest: (self class
  82. interestOn: self path
  83. block: [ self read: aBlock ])
  84. ! !
  85. !TrappedPosition class methodsFor: 'factory'!
  86. interestOn: anAspect block: aBlock
  87. (anAspect notEmpty and: [ anAspect last isNil ])
  88. ifTrue: [ ^ Axes newInterestThru: anAspect allButLast doing: aBlock ]
  89. ifFalse: [ ^ Axes newInterestUpTo: anAspect doing: aBlock ]
  90. ! !
  91. TrappedPosition subclass: #TrappedSnapshot
  92. instanceVariableNames: 'prefix'
  93. package: 'Trapped'!
  94. !TrappedSnapshot methodsFor: 'accessing'!
  95. prefix
  96. ^ prefix
  97. !
  98. prefix: anObject
  99. prefix := anObject
  100. ! !
  101. !TrappedSnapshot methodsFor: 'action'!
  102. do: aBlock
  103. TrappedPathStack current with: {prefix}, path do: [ aBlock value: model ]
  104. ! !
  105. Object subclass: #TrappedProcessingChain
  106. instanceVariableNames: 'processors'
  107. package: 'Trapped'!
  108. !TrappedProcessingChain methodsFor: 'accessing'!
  109. firstProcessorNo
  110. ^1
  111. !
  112. lastProcessorNo
  113. ^processors size
  114. !
  115. processorNo: aNumber
  116. ^processors at: aNumber
  117. !
  118. processors: anArray
  119. processors := anArray
  120. ! !
  121. !TrappedProcessingChain methodsFor: 'action'!
  122. forSnapshot: aSnapshot andBrush: aTagBrush
  123. | toViewCarrier toModelCarrier |
  124. toViewCarrier := TrappedDataCarrierToView on: self target: aTagBrush.
  125. toModelCarrier := TrappedDataCarrierToModel on: self target: aSnapshot.
  126. processors do: [ :each | each installToView: toViewCarrier toModel: toModelCarrier ].
  127. toViewCarrier value = true ifTrue: [ toViewCarrier copy proceed ]
  128. ! !
  129. !TrappedProcessingChain class methodsFor: 'instance creation'!
  130. new: anArray
  131. (anArray anySatisfy: [ :each | each isExpectingModelData ])
  132. ifFalse: [ anArray add: self dataTerminator ]
  133. ifTrue: [ anArray addFirst: self blackboardReaderWriter ].
  134. ^self new
  135. processors: anArray;
  136. yourself
  137. !
  138. newFromProcessorSpecs: anArray
  139. ^self new: ((anArray ifEmpty: [ #(contents) ]) collect: [ :each | each asTrapProcSendTo: TrappedProcessor ])
  140. ! !
  141. !TrappedProcessingChain class methodsFor: 'private'!
  142. blackboardReaderWriter
  143. ^TrappedProcessorBlackboard new
  144. !
  145. dataTerminator
  146. ^TrappedProcessorTerminator new
  147. ! !
  148. Object subclass: #TrappedProcessor
  149. instanceVariableNames: ''
  150. package: 'Trapped'!
  151. !TrappedProcessor commentStamp!
  152. I am a processing step in TrappedProcessingChain.
  153. I am stateless flyweight (aka servant)
  154. and will get all necessary data as arguments in API calls.
  155. My public API is:
  156. - installToView:toModel:
  157. This gets two TrappedDataCarriers set up without actual data
  158. and at the beginning of their chains. It should do one-time
  159. installation task needed (install event handlers etc.).
  160. To start a chain, do: dataCarrier copy value: data; proceed.
  161. - toView:
  162. This performs transformation of TrappedDataCarrier on its way from model to view.
  163. Should call aDataCarrier proceed to proceed to subsequent step.
  164. - toModel:
  165. This performs transformation of TrappedDataCarrier on its way from view to model.
  166. Should call aDataCarrier proceed to proceed to subsequent step.!
  167. !TrappedProcessor methodsFor: 'data transformation'!
  168. toModel: aDataCarrier
  169. "by default, proceed"
  170. aDataCarrier proceed
  171. !
  172. toView: aDataCarrier
  173. "by default, proceed"
  174. aDataCarrier proceed
  175. ! !
  176. !TrappedProcessor methodsFor: 'installation'!
  177. installToView: aDataCarrier toModel: anotherDataCarrier
  178. "by default, do nothing"
  179. ! !
  180. !TrappedProcessor methodsFor: 'testing'!
  181. isExpectingModelData
  182. ^false
  183. ! !
  184. !TrappedProcessor class methodsFor: 'factory'!
  185. contents
  186. ^TrappedProcessorContents new
  187. ! !
  188. TrappedProcessor subclass: #TrappedDataExpectingProcessor
  189. instanceVariableNames: ''
  190. package: 'Trapped'!
  191. !TrappedDataExpectingProcessor commentStamp!
  192. I answer true to isExpectingModelData and serve as a base class
  193. for processor that present / change model data.
  194. When at least one of my instances is present in the chain,
  195. automatic databinding processor is added at the beginning
  196. (the data-binding scenario); otherwise, the chain
  197. is run immediately with true as data (run-once scenario).!
  198. !TrappedDataExpectingProcessor methodsFor: 'testing'!
  199. isExpectingModelData
  200. ^true
  201. ! !
  202. TrappedDataExpectingProcessor subclass: #TrappedProcessorContents
  203. instanceVariableNames: ''
  204. package: 'Trapped'!
  205. !TrappedProcessorContents commentStamp!
  206. I put data into target via contents: in toView:!
  207. !TrappedProcessorContents methodsFor: 'data transformation'!
  208. toView: aDataCarrier
  209. aDataCarrier toTargetContents
  210. ! !
  211. TrappedProcessor subclass: #TrappedProcessorBlackboard
  212. instanceVariableNames: ''
  213. package: 'Trapped'!
  214. !TrappedProcessorBlackboard commentStamp!
  215. I am used internally to fetch data from blackboard
  216. or write it back.
  217. I am added to the beginning of the chain
  218. when the chain contains at least one element
  219. that isExpectingModelData (see TrappedDataExpectingProcessor).!
  220. !TrappedProcessorBlackboard methodsFor: 'data transformation'!
  221. toModel: aDataCarrier
  222. aDataCarrier modifyTarget
  223. ! !
  224. !TrappedProcessorBlackboard methodsFor: 'installation'!
  225. installToView: aDataCarrier toModel: anotherDataCarrier
  226. | snap |
  227. snap := anotherDataCarrier target.
  228. snap watch: [ :data |
  229. (aDataCarrier target asJQuery closest: 'html') toArray isEmpty ifTrue: [ AxonOff signal ].
  230. snap do: [ aDataCarrier copy value: data; proceed ] ].
  231. aDataCarrier value: false
  232. ! !
  233. TrappedProcessor subclass: #TrappedProcessorTerminator
  234. instanceVariableNames: ''
  235. package: 'Trapped'!
  236. !TrappedProcessorTerminator commentStamp!
  237. I do not proceed in toView:.
  238. I am added automatically to end of chain when it does not contain
  239. any element that isExpectingModelData (see TrappedDataExpectingProcessor).!
  240. !TrappedProcessorTerminator methodsFor: 'data transformation'!
  241. toView: aDataCarrier
  242. "stop"
  243. ! !
  244. Object subclass: #TrappedSingleton
  245. instanceVariableNames: ''
  246. package: 'Trapped'!
  247. !TrappedSingleton methodsFor: 'action'!
  248. start: args
  249. ^ self subclassResponsibility
  250. ! !
  251. TrappedSingleton class instanceVariableNames: 'current'!
  252. !TrappedSingleton class methodsFor: 'accessing'!
  253. current
  254. ^ current ifNil: [ current := self new ]
  255. ! !
  256. !TrappedSingleton class methodsFor: 'action'!
  257. start: args
  258. self current start: args
  259. ! !
  260. TrappedSingleton subclass: #Trapped
  261. instanceVariableNames: 'registry'
  262. package: 'Trapped'!
  263. !Trapped methodsFor: 'accessing'!
  264. byName: aString
  265. ^ registry at: aString
  266. !
  267. register: aListKeyedEntity
  268. self register: aListKeyedEntity name: aListKeyedEntity trappedLabel
  269. !
  270. register: aListKeyedEntity name: aString
  271. registry at: aString put: aListKeyedEntity
  272. ! !
  273. !Trapped methodsFor: 'action'!
  274. start: args
  275. args do: [ :each | self register: each ].
  276. self injectToElement: document
  277. ! !
  278. !Trapped methodsFor: 'initialization'!
  279. initialize
  280. super initialize.
  281. registry := #{}.
  282. ! !
  283. !Trapped methodsFor: 'private'!
  284. cloneAndInject: anObject
  285. ^anObject asJQuery clone
  286. each: [ :i :each | self injectToElement: each ];
  287. get: 0
  288. !
  289. descend: anArray snapshotDo: aBlock
  290. | tpsc |
  291. tpsc := TrappedPathStack current.
  292. tpsc append: anArray do: [
  293. | prefix modelPath model |
  294. prefix := tpsc elements first.
  295. modelPath := tpsc elements allButFirst.
  296. model := self byName: prefix.
  297. aBlock value: (TrappedSnapshot new prefix: prefix; path: modelPath model: model)
  298. ]
  299. !
  300. injectToChildren: anElement
  301. | child |
  302. child := anElement firstChild.
  303. [ child isNil ] whileFalse: [ self injectToElement: child. child := child nextSibling ]
  304. !
  305. injectToElement: anElement
  306. | jq |
  307. jq := anElement asJQuery.
  308. (jq attr: 'data-trap') ifNotNil: [ :attr |
  309. jq removeAttr: 'data-trap'.
  310. (Trapped parse: attr) do: [ :rule |
  311. (HTMLCanvas onJQuery: jq) root trap: rule first processors: (rule at: 2 ifAbsent: [#()]) ] ].
  312. self injectToChildren: anElement
  313. ! !
  314. !Trapped class methodsFor: 'parsing'!
  315. parse: aString
  316. ^ (aString tokenize: '.') collect: [ :rule |
  317. (rule tokenize: ':') collect: [ :message |
  318. Axes parse: message ] ]
  319. ! !
  320. !Trapped class methodsFor: 'private'!
  321. loop: aSequenceableCollection before: aNode do: aBlock
  322. aSequenceableCollection withIndexDo: [ :item :i |
  323. | env |
  324. "env := document createDocumentFragment."
  325. env := document createElement: 'ins'.
  326. {i} trapDescend: [ (HTMLCanvas onJQuery: env asJQuery) root with: aBlock ].
  327. "aNode parentNode insertBefore: env reference: aNode"
  328. (Array streamContents: [ :str |
  329. | child |
  330. child := env firstChild.
  331. [ child isNil ] whileFalse: [
  332. str nextPut: child.
  333. child := child nextSibling ]])
  334. do: [ :each | aNode parentNode insertBefore: each reference: aNode ]
  335. ]
  336. !
  337. loop: aSequenceableCollection between: aTagBrush and: anotherTagBrush do: aBlock
  338. (aTagBrush asJQuery nextUntil: anotherTagBrush element) remove.
  339. aSequenceableCollection ifNotNil: [
  340. self loop: aSequenceableCollection before: anotherTagBrush element do: aBlock
  341. ]
  342. ! !
  343. TrappedSingleton subclass: #TrappedPathStack
  344. instanceVariableNames: 'elements'
  345. package: 'Trapped'!
  346. !TrappedPathStack methodsFor: 'accessing'!
  347. elements
  348. ^elements
  349. ! !
  350. !TrappedPathStack methodsFor: 'descending'!
  351. append: anArray do: aBlock
  352. self with: elements, anArray do: aBlock
  353. !
  354. with: anArray do: aBlock
  355. | old |
  356. old := elements.
  357. [ elements := anArray.
  358. aBlock value ] ensure: [ elements := old ]
  359. ! !
  360. !TrappedPathStack methodsFor: 'initialization'!
  361. initialize
  362. super initialize.
  363. elements := #().
  364. ! !
  365. !Array methodsFor: '*Trapped'!
  366. asTrapProcSendTo: anObject
  367. | selector args |
  368. selector := ''.
  369. args := #().
  370. self withIndexDo: [ :element :index | index odd
  371. ifTrue: [ selector := selector, element ]
  372. ifFalse: [ selector := selector, ':'. args add: element ] ].
  373. ^anObject perform: selector withArguments: args
  374. !
  375. trapDescend: aBlock
  376. Trapped current descend: self snapshotDo: aBlock
  377. ! !
  378. !Axolator methodsFor: '*Trapped'!
  379. trappedLabel
  380. ^ root trappedLabel
  381. ! !
  382. !HTMLCanvas methodsFor: '*Trapped'!
  383. trapIter: path do: aBlock
  384. self with: [ :html | (html tag: 'script') at: 'type' put: 'application/x-beacon'; trapIter: path after: aBlock ]
  385. ! !
  386. !Object methodsFor: '*Trapped'!
  387. asTrapProcSendTo: anObject
  388. self error: 'Trapped cannot use processor descriptor of ', self class name, ' type.'
  389. !
  390. trappedLabel
  391. ^ self class name
  392. ! !
  393. !String methodsFor: '*Trapped'!
  394. asTrapProcSendTo: anObject
  395. ^anObject perform: self
  396. ! !
  397. !TagBrush methodsFor: '*Trapped'!
  398. trap: path
  399. self trap: path processors: #()
  400. !
  401. trap: path processors: anArray
  402. path trapDescend: [ :snap |
  403. (TrappedProcessingChain newFromProcessorSpecs: anArray)
  404. forSnapshot: snap andBrush: self ]
  405. !
  406. trap: path read: aBlock
  407. path trapDescend: [ :snap |
  408. snap watch: [ :data |
  409. (self asJQuery closest: 'html') toArray isEmpty ifTrue: [ AxonOff signal ].
  410. snap do: [ self with: [ :html | aBlock value: data value: html ] ]
  411. ]
  412. ]
  413. !
  414. trapGuard: anArray contents: aBlock
  415. #() trapDescend: [ :snap |
  416. | shown |
  417. shown := nil.
  418. self trap: anArray read: [ :gdata |
  419. | sanitized |
  420. sanitized := gdata ifNil: [ false ].
  421. shown = sanitized ifFalse: [
  422. shown := sanitized.
  423. shown
  424. ifTrue: [ snap do: [ self contents: aBlock ]. self asJQuery show ]
  425. ifFalse: [ self asJQuery hide; empty ] ] ] ]
  426. !
  427. trapIter: path after: aBlock
  428. | end |
  429. end := TagBrush fromJQuery: ('<script type="application/x-beacon" />' asJQuery) canvas: canvas.
  430. self element parentNode insertBefore: end element reference: self element nextSibling.
  431. self trap: path read: [ :model |
  432. Trapped loop: model between: self and: end do: aBlock.
  433. ]
  434. ! !