Helios-KeyBindings.st 5.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337
  1. Smalltalk current createPackage: 'Helios-KeyBindings' properties: #{}!
  2. Object subclass: #HLBinding
  3. instanceVariableNames: 'key label'
  4. package: 'Helios-KeyBindings'!
  5. !HLBinding methodsFor: 'accessing'!
  6. key
  7. ^ key
  8. !
  9. key: anInteger
  10. key := anInteger
  11. !
  12. label
  13. ^ label
  14. !
  15. label: aString
  16. label := aString
  17. !
  18. shortcut
  19. ^ String fromCharCode: self key
  20. ! !
  21. !HLBinding methodsFor: 'actions'!
  22. applyOn: aKeyBinder
  23. self subclassResponsibility
  24. ! !
  25. !HLBinding methodsFor: 'rendering'!
  26. renderOn: aBindingHelper html: html
  27. ! !
  28. !HLBinding methodsFor: 'testing'!
  29. isBindingAction
  30. ^ false
  31. !
  32. isBindingGroup
  33. ^ false
  34. ! !
  35. !HLBinding class methodsFor: 'instance creation'!
  36. on: anInteger labelled: aString
  37. ^ self new
  38. key: anInteger;
  39. label: aString;
  40. yourself
  41. ! !
  42. HLBinding subclass: #HLBindingAction
  43. instanceVariableNames: 'callback'
  44. package: 'Helios-KeyBindings'!
  45. !HLBindingAction methodsFor: 'accessing'!
  46. callback
  47. ^ callback
  48. !
  49. callback: aBlock
  50. callback := aBlock
  51. ! !
  52. !HLBindingAction methodsFor: 'actions'!
  53. applyOn: aKeyBinder
  54. aKeyBinder applyBindingAction: self
  55. ! !
  56. !HLBindingAction methodsFor: 'testing'!
  57. isBindingAction
  58. ^ true
  59. ! !
  60. HLBinding subclass: #HLBindingGroup
  61. instanceVariableNames: 'bindings'
  62. package: 'Helios-KeyBindings'!
  63. !HLBindingGroup methodsFor: 'accessing'!
  64. add: aBinding
  65. ^ self bindings add: aBinding
  66. !
  67. addActionKey: anInteger labelled: aString callback: aBlock
  68. self add: ((HLBindingAction on: anInteger labelled: aString)
  69. callback: aBlock;
  70. yourself)
  71. !
  72. addActionKey: anInteger labelled: aString command: aCommand
  73. self add: ((HLBindingAction on: anInteger labelled: aString)
  74. command: aCommand;
  75. yourself)
  76. !
  77. addGroupKey: anInteger labelled: aString
  78. self add: (HLBindingGroup on: anInteger labelled: aString)
  79. !
  80. at: aString
  81. ^ self bindings
  82. detect: [ :each | each label = aString ]
  83. ifNone: [ nil ]
  84. !
  85. atKey: anInteger
  86. ^ self bindings
  87. detect: [ :each | each key = anInteger ]
  88. ifNone: [ nil ]
  89. !
  90. bindings
  91. ^ bindings ifNil: [ bindings := OrderedCollection new ]
  92. ! !
  93. !HLBindingGroup methodsFor: 'actions'!
  94. applyOn: aKeyBinder
  95. aKeyBinder applyBindingGroup: self
  96. ! !
  97. !HLBindingGroup methodsFor: 'rendering'!
  98. renderOn: aBindingHelper html: html
  99. aBindingHelper renderBindingGroup: self on: html
  100. ! !
  101. !HLBindingGroup methodsFor: 'testing'!
  102. isBindingGroup
  103. ^ true
  104. ! !
  105. Object subclass: #HLKeyBinder
  106. instanceVariableNames: 'modifierKey active helper bindings selectedBinding'
  107. package: 'Helios-KeyBindings'!
  108. !HLKeyBinder methodsFor: 'accessing'!
  109. activationKey
  110. "SPACE"
  111. ^ 32
  112. !
  113. bindings
  114. ^ bindings ifNil: [ bindings := HLBindingGroup new ]
  115. !
  116. escapeKey
  117. "ESC"
  118. ^ 27
  119. !
  120. helper
  121. ^ helper ifNil: [ helper := HLKeyBinderHelper on: self ]
  122. !
  123. selectedBinding
  124. ^ selectedBinding ifNil: [ self bindings ]
  125. ! !
  126. !HLKeyBinder methodsFor: 'actions'!
  127. activate
  128. active := true.
  129. self helper show
  130. !
  131. applyBinding: aBinding
  132. aBinding applyOn: self
  133. !
  134. applyBindingAction: aBinding
  135. aBinding callback value.
  136. self deactivate
  137. !
  138. applyBindingGroup: aBinding
  139. selectedBinding := aBinding.
  140. self helper refresh
  141. !
  142. deactivate
  143. active := false.
  144. selectedBinding := nil.
  145. self helper hide
  146. !
  147. flushBindings
  148. bindings := nil.
  149. helper := nil
  150. ! !
  151. !HLKeyBinder methodsFor: 'events'!
  152. handleActiveKeyDown: event
  153. "ESC or ctrl+g deactivate the keyBinder"
  154. (event which = self escapeKey or: [
  155. event which = 71 and: [ event ctrlKey ] ])
  156. ifTrue: [
  157. self deactivate.
  158. event preventDefault.
  159. ^ false ].
  160. "Handle the keybinding"
  161. ^ self handleBindingFor: event
  162. !
  163. handleBindingFor: anEvent
  164. | binding |
  165. binding := self selectedBinding atKey: anEvent which.
  166. binding ifNotNil: [
  167. self applyBinding: binding.
  168. anEvent preventDefault.
  169. ^ false ]
  170. !
  171. handleInactiveKeyDown: event
  172. event which = self activationKey ifTrue: [
  173. event ctrlKey ifTrue: [
  174. self activate.
  175. event preventDefault.
  176. ^ false ] ]
  177. !
  178. handleKeyDown: event
  179. ^ self isActive
  180. ifTrue: [ self handleActiveKeyDown: event ]
  181. ifFalse: [ self handleInactiveKeyDown: event ]
  182. !
  183. setupEvents
  184. (window jQuery: 'body') keydown: [ :event | self handleKeyDown: event ]
  185. ! !
  186. !HLKeyBinder methodsFor: 'initialization'!
  187. initialize
  188. super initialize.
  189. active := false
  190. ! !
  191. !HLKeyBinder methodsFor: 'testing'!
  192. isActive
  193. ^ active ifNil: [ false ]
  194. !
  195. systemIsMac
  196. ^ navigator platform match: 'Mac'
  197. ! !
  198. HLWidget subclass: #HLKeyBinderHelper
  199. instanceVariableNames: 'keyBinder'
  200. package: 'Helios-KeyBindings'!
  201. !HLKeyBinderHelper methodsFor: 'accessing'!
  202. keyBinder
  203. ^ keyBinder
  204. !
  205. keyBinder: aKeyBinder
  206. keyBinder := aKeyBinder
  207. !
  208. selectedBinding
  209. ^ self keyBinder selectedBinding
  210. ! !
  211. !HLKeyBinderHelper methodsFor: 'actions'!
  212. hide
  213. rootDiv asJQuery remove
  214. !
  215. show
  216. self appendToJQuery: 'body' asJQuery
  217. ! !
  218. !HLKeyBinderHelper methodsFor: 'keyBindings'!
  219. registerBindings
  220. "Do nothing"
  221. ! !
  222. !HLKeyBinderHelper methodsFor: 'rendering'!
  223. renderBindingGroup: aBindingGroup on: html
  224. (aBindingGroup bindings
  225. sorted: [ :a :b | a key < b key ])
  226. do: [ :each |
  227. html span class: 'command'; with: [
  228. html span class: 'label'; with: each shortcut asLowercase.
  229. html a
  230. class: 'action';
  231. with: each label;
  232. onClick: [ self keyBinder applyBinding: each ] ] ]
  233. !
  234. renderBindingOn: html
  235. self selectedBinding renderOn: self html: html
  236. !
  237. renderContentOn: html
  238. html div class: 'key_helper'; with: [
  239. self
  240. renderSelectionOn:html;
  241. renderBindingOn: html ]
  242. !
  243. renderSelectionOn: html
  244. html span
  245. class: 'selected';
  246. with: (self selectedBinding label ifNil: [ 'Action' ])
  247. ! !
  248. !HLKeyBinderHelper class methodsFor: 'instance creation'!
  249. on: aKeyBinder
  250. ^ self new
  251. keyBinder: aKeyBinder;
  252. yourself
  253. ! !