Trapped-Frontend.st 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184
  1. Smalltalk current createPackage: 'Trapped-Frontend' properties: #{}!
  2. Widget subclass: #TrappedDumbView
  3. instanceVariableNames: ''
  4. package: 'Trapped-Frontend'!
  5. !TrappedDumbView commentStamp!
  6. I just read and show an actual path.!
  7. !TrappedDumbView methodsFor: 'rendering'!
  8. renderOn: html
  9. html root trapShow: #()
  10. ! !
  11. Object subclass: #TrappedPlainModel
  12. instanceVariableNames: 'payload'
  13. package: 'Trapped-Frontend'!
  14. !TrappedPlainModel methodsFor: 'accessing'!
  15. payload
  16. ^payload
  17. !
  18. payload: anObject
  19. payload := anObject
  20. ! !
  21. !TrappedPlainModel methodsFor: 'action'!
  22. name
  23. ^ self class name
  24. !
  25. read: path do: aBlock
  26. | data |
  27. data := path inject: self payload
  28. into: [ :soFar :segment | soFar at: segment ].
  29. aBlock value: data.
  30. !
  31. start
  32. Trapped current register: self name: self name
  33. ! !
  34. !TrappedPlainModel class methodsFor: 'action'!
  35. start
  36. self new start
  37. ! !
  38. Object subclass: #TrappedSingleton
  39. instanceVariableNames: ''
  40. package: 'Trapped-Frontend'!
  41. !TrappedSingleton methodsFor: 'action'!
  42. start
  43. ^ self subclassResponsibility
  44. ! !
  45. TrappedSingleton class instanceVariableNames: 'current'!
  46. !TrappedSingleton class methodsFor: 'accessing'!
  47. current
  48. ^ current ifNil: [ current := self new ]
  49. ! !
  50. !TrappedSingleton class methodsFor: 'action'!
  51. start
  52. self current start
  53. ! !
  54. TrappedSingleton subclass: #Trapped
  55. instanceVariableNames: 'registry'
  56. package: 'Trapped-Frontend'!
  57. !Trapped methodsFor: 'accessing'!
  58. byName: aString
  59. ^ registry at: aString
  60. !
  61. register: aFly name: aString
  62. registry at: aString put: aFly
  63. ! !
  64. !Trapped methodsFor: 'action'!
  65. start
  66. '[data-trap]' asJQuery each: [ :index :elem |
  67. | trap jq viewName modelName tokens path |
  68. jq := elem asJQuery.
  69. trap := jq attr: 'data-trap'.
  70. tokens := trap tokenize: ':'.
  71. tokens size = 1 ifTrue: [ tokens := { 'TrappedDumbView' }, tokens ].
  72. viewName := tokens first.
  73. tokens := (tokens second tokenize: ' ') select: [ :each | each notEmpty ].
  74. modelName := tokens first.
  75. path := Trapped parse: tokens allButFirst.
  76. { modelName }, path trapDescend: [(Smalltalk current at: viewName) new appendToJQuery: jq].
  77. ]
  78. ! !
  79. !Trapped methodsFor: 'initialization'!
  80. initialize
  81. super initialize.
  82. registry := #{}.
  83. ! !
  84. !Trapped class methodsFor: 'accessing'!
  85. parse: anArray
  86. ^anArray collect: [ :each |
  87. | asNum |
  88. <asNum = parseInt(each)>.
  89. asNum = asNum ifTrue: [ asNum ] ifFalse: [
  90. each first = '#' ifTrue: [ each allButFirst asSymbol ] ifFalse: [ each ]]]
  91. !
  92. path
  93. ^TrappedPathStack current elements
  94. ! !
  95. TrappedSingleton subclass: #TrappedPathStack
  96. instanceVariableNames: 'elements'
  97. package: 'Trapped-Frontend'!
  98. !TrappedPathStack methodsFor: 'accessing'!
  99. elements
  100. ^elements
  101. ! !
  102. !TrappedPathStack methodsFor: 'descending'!
  103. append: anArray
  104. elements := elements, anArray
  105. !
  106. with: anArray do: aBlock
  107. | old |
  108. old := elements.
  109. [ self append: anArray.
  110. aBlock value ] ensure: [ elements := old ]
  111. ! !
  112. !TrappedPathStack methodsFor: 'initialization'!
  113. initialize
  114. elements := #().
  115. ! !
  116. !Array methodsFor: '*Trapped-Frontend'!
  117. trapDescend: aBlock
  118. TrappedPathStack current with: self do: aBlock
  119. ! !
  120. !Array methodsFor: '*Trapped-Frontend'!
  121. trapDescend: aBlock
  122. TrappedPathStack current with: self do: aBlock
  123. ! !
  124. !TagBrush methodsFor: '*Trapped-Frontend'!
  125. trap: path read: aBlock
  126. path trapDescend: [ | actual model |
  127. actual := Trapped path.
  128. model := Trapped current byName: actual first.
  129. "TODO register for later"
  130. [ model read: actual allButFirst do: [ :data |
  131. aBlock value: self value: data
  132. ]] fork
  133. ]
  134. !
  135. trapShow: path
  136. self trap: path read: [ :brush :model | brush empty; with: model ]
  137. ! !