1
0

Helios-KeyBindings.st 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737
  1. Smalltalk createPackage: 'Helios-KeyBindings'!
  2. Object subclass: #HLBinding
  3. instanceVariableNames: 'key label'
  4. package: 'Helios-KeyBindings'!
  5. !HLBinding commentStamp!
  6. I am the abstract representation of a keybinding in Helios. My instances hold a key (integer value) and a label.
  7. Bindings are built into a tree of keys, so pressing a key may result in more key choices (for example, to open a workspace, 'o' is pressed first then 'w' is pressed).
  8. Binding action handling and selection is handled by the `current` instance of `HLKeyBinder`.
  9. Subclasses implement specific behavior like evaluating actions or (sub-)grouping other bindings.!
  10. !HLBinding methodsFor: 'accessing'!
  11. atKey: aKey
  12. "Answer the sub-binding at key aKey.
  13. Always answer nil here. See HLBindingGroup for more."
  14. ^ nil
  15. !
  16. displayLabel
  17. ^ self label
  18. !
  19. key
  20. ^ key
  21. !
  22. key: anInteger
  23. key := anInteger
  24. !
  25. label
  26. ^ label
  27. !
  28. label: aString
  29. label := aString
  30. !
  31. shortcut
  32. ^ String fromCharCode: self key
  33. ! !
  34. !HLBinding methodsFor: 'actions'!
  35. apply
  36. !
  37. release
  38. ! !
  39. !HLBinding methodsFor: 'rendering'!
  40. renderOn: aBindingHelper html: html
  41. ! !
  42. !HLBinding methodsFor: 'testing'!
  43. isActive
  44. ^ self subclassResponsibility
  45. ! !
  46. !HLBinding class methodsFor: 'instance creation'!
  47. on: anInteger labelled: aString
  48. ^ self new
  49. key: anInteger;
  50. label: aString;
  51. yourself
  52. ! !
  53. HLBinding subclass: #HLBindingAction
  54. instanceVariableNames: 'command'
  55. package: 'Helios-KeyBindings'!
  56. !HLBindingAction commentStamp!
  57. My instances are the leafs of the binding tree. They evaluate actions through commands, instances of concrete subclasses of `HLCommand`.
  58. The `#apply` methods is used to evaluate the `command`. If the command requires user input, an `inputWidget` will be displayed to the user.!
  59. !HLBindingAction methodsFor: 'accessing'!
  60. command
  61. ^ command
  62. !
  63. command: aCommand
  64. command := aCommand
  65. !
  66. input: aString
  67. self command input: aString
  68. !
  69. inputBinding
  70. ^ HLBindingInput new
  71. label: self command inputLabel;
  72. ghostText: self command displayLabel;
  73. defaultValue: self command defaultInput;
  74. inputCompletion: self command inputCompletion;
  75. callback: [ :val |
  76. self command
  77. input: val;
  78. execute ];
  79. yourself
  80. !
  81. inputWidget
  82. ^ HLBindingActionInputWidget new
  83. ghostText: self command displayLabel;
  84. defaultValue: self command defaultInput;
  85. inputCompletion: self command inputCompletion;
  86. callback: [ :value |
  87. self
  88. input: value;
  89. executeCommand ];
  90. yourself
  91. ! !
  92. !HLBindingAction methodsFor: 'actions'!
  93. apply
  94. self command isInputRequired
  95. ifTrue: [ HLKeyBinder current helper showWidget: self inputWidget ]
  96. ifFalse: [ self executeCommand ]
  97. !
  98. executeCommand
  99. self command execute.
  100. HLKeyBinder current deactivate
  101. ! !
  102. !HLBindingAction methodsFor: 'testing'!
  103. isActive
  104. ^ self command isActive
  105. ! !
  106. HLBinding subclass: #HLBindingGroup
  107. instanceVariableNames: 'bindings'
  108. package: 'Helios-KeyBindings'!
  109. !HLBindingGroup commentStamp!
  110. My instances hold other bindings, either actions or groups, and do not have actions by themselves.
  111. Children are accessed with `atKey:` and added with the `add*` methods.!
  112. !HLBindingGroup methodsFor: 'accessing'!
  113. activeBindings
  114. ^ self bindings select: [ :each | each isActive ]
  115. !
  116. at: aString
  117. ^ self bindings
  118. detect: [ :each | each label = aString ]
  119. ifNone: [ nil ]
  120. !
  121. at: aString add: aBinding
  122. | binding |
  123. binding := self at: aString.
  124. binding ifNil: [ ^ self ].
  125. binding add: aBinding
  126. !
  127. atKey: anInteger
  128. ^ self bindings
  129. detect: [ :each | each key = anInteger ]
  130. ifNone: [ nil ]
  131. !
  132. bindings
  133. ^ bindings ifNil: [ bindings := OrderedCollection new ]
  134. !
  135. displayLabel
  136. ^ super displayLabel, '...'
  137. ! !
  138. !HLBindingGroup methodsFor: 'actions'!
  139. release
  140. self bindings do: [ :each | each release ]
  141. ! !
  142. !HLBindingGroup methodsFor: 'add'!
  143. addGroupKey: anInteger labelled: aString
  144. self add: (HLBindingGroup on: anInteger labelled: aString)
  145. ! !
  146. !HLBindingGroup methodsFor: 'adding'!
  147. add: aBinding
  148. ^ self bindings add: aBinding
  149. !
  150. addActionKey: anInteger labelled: aString callback: aBlock
  151. self add: ((HLBindingAction on: anInteger labelled: aString)
  152. callback: aBlock;
  153. yourself)
  154. ! !
  155. !HLBindingGroup methodsFor: 'rendering'!
  156. renderOn: aBindingHelper html: html
  157. self isActive ifTrue: [
  158. aBindingHelper renderBindingGroup: self on: html ]
  159. ! !
  160. !HLBindingGroup methodsFor: 'testing'!
  161. isActive
  162. ^ self activeBindings notEmpty
  163. ! !
  164. HLWidget subclass: #HLBindingActionInputWidget
  165. instanceVariableNames: 'input callback status wrapper ghostText message inputCompletion defaultValue messageTag'
  166. package: 'Helios-KeyBindings'!
  167. !HLBindingActionInputWidget commentStamp!
  168. My instances are built when a `HLBindingAction` that requires user input is applied.!
  169. !HLBindingActionInputWidget methodsFor: 'accessing'!
  170. callback
  171. ^ callback ifNil: [ callback := [ :value | ] ]
  172. !
  173. callback: aBlock
  174. callback := aBlock
  175. !
  176. defaultValue
  177. ^ defaultValue ifNil: [ '' ]
  178. !
  179. defaultValue: aString
  180. defaultValue := aString
  181. !
  182. ghostText
  183. ^ ghostText
  184. !
  185. ghostText: aText
  186. ghostText := aText
  187. !
  188. input
  189. ^ input
  190. !
  191. inputCompletion
  192. ^ inputCompletion ifNil: [ #() ]
  193. !
  194. inputCompletion: aCollection
  195. inputCompletion := aCollection
  196. !
  197. message
  198. ^ message ifNil: [ message := '' ]
  199. !
  200. message: aString
  201. message := aString
  202. !
  203. status
  204. ^ status ifNil: [ status := 'info' ]
  205. !
  206. status: aStatus
  207. status := aStatus
  208. ! !
  209. !HLBindingActionInputWidget methodsFor: 'actions'!
  210. clearStatus
  211. self status: 'info'.
  212. self message: ''.
  213. self refresh
  214. !
  215. errorStatus
  216. self status: 'error'.
  217. self refresh
  218. !
  219. evaluate: aString
  220. [ self callback value: aString ]
  221. on: Error
  222. do: [ :ex |
  223. self input asJQuery
  224. one: 'keydown'
  225. do: [ self clearStatus ].
  226. self message: ex messageText.
  227. self errorStatus ]
  228. !
  229. refresh
  230. wrapper ifNil: [ ^ self ].
  231. wrapper class: self status.
  232. messageTag contents: self message
  233. ! !
  234. !HLBindingActionInputWidget methodsFor: 'rendering'!
  235. renderOn: html
  236. wrapper ifNil: [ wrapper := html span ].
  237. wrapper
  238. class: self status;
  239. with: [
  240. input := html input
  241. placeholder: self ghostText;
  242. value: self defaultValue;
  243. onKeyDown: [ :event |
  244. event which = 13 ifTrue: [
  245. self evaluate: input asJQuery val ] ]
  246. yourself.
  247. input asJQuery
  248. typeahead: #{ 'source' -> self inputCompletion }.
  249. messageTag := (html span
  250. class: 'help-inline';
  251. with: self message;
  252. yourself) ].
  253. "Evaluate with a timeout to ensure focus.
  254. Commands can be executed from a menu, clicking on the menu to
  255. evaluate the command would give it the focus otherwise"
  256. [ input asJQuery focus; select ] valueWithTimeout: 10
  257. ! !
  258. Object subclass: #HLKeyBinder
  259. instanceVariableNames: 'modifierKey helper bindings selectedBinding'
  260. package: 'Helios-KeyBindings'!
  261. !HLKeyBinder commentStamp!
  262. My `current` instance holds keybindings for Helios actions and evaluate them.
  263. Bindings can be nested by groups. The `bindings` instance variable holds the root of the key bindings tree.
  264. Bindings are instances of a concrete subclass of `HLBinding`.
  265. I am always either in 'active' or 'inactive' state. In active state I capture key down events and my `helper` widget is displayed at the bottom of the window. My `selectedBinding`, if any, is displayed by the helper.
  266. Bindings are evaluated through `applyBinding:`. If a binding is final (not a group of other bindings), evaluating it will result in deactivating the binder, and hiding the `helper` widget.!
  267. !HLKeyBinder methodsFor: 'accessing'!
  268. activationKey
  269. "SPACE"
  270. ^ 32
  271. !
  272. activationKeyLabel
  273. ^ 'ctrl + space'
  274. !
  275. bindings
  276. ^ bindings ifNil: [ bindings := self defaultBindings ]
  277. !
  278. escapeKey
  279. "ESC"
  280. ^ 27
  281. !
  282. helper
  283. ^ helper
  284. !
  285. selectedBinding
  286. ^ selectedBinding ifNil: [ self bindings ]
  287. ! !
  288. !HLKeyBinder methodsFor: 'actions'!
  289. activate
  290. self helper show
  291. !
  292. applyBinding: aBinding
  293. aBinding isActive ifFalse: [ ^ self ].
  294. self selectBinding: aBinding.
  295. aBinding apply
  296. !
  297. deactivate
  298. selectedBinding ifNotNil: [ selectedBinding release ].
  299. selectedBinding := nil.
  300. self helper hide
  301. !
  302. flushBindings
  303. bindings := nil
  304. !
  305. selectBinding: aBinding
  306. aBinding = selectedBinding ifTrue: [ ^ self ].
  307. selectedBinding := aBinding.
  308. self helper refresh
  309. ! !
  310. !HLKeyBinder methodsFor: 'defaults'!
  311. defaultBindings
  312. | group |
  313. group := HLBindingGroup new
  314. add: HLCloseTabCommand new asBinding;
  315. add: HLSwitchTabCommand new asBinding;
  316. yourself.
  317. HLOpenCommand registerConcreteClassesOn: group.
  318. ^ group
  319. ! !
  320. !HLKeyBinder methodsFor: 'events'!
  321. handleActiveKeyDown: event
  322. "ESC, ctrl+g ctrl+space deactivate the keyBinder"
  323. (event which = self escapeKey or: [
  324. (event which = 71 or: [ event which = self activationKey ])
  325. and: [ event ctrlKey ] ])
  326. ifTrue: [
  327. self deactivate.
  328. event preventDefault.
  329. ^ false ].
  330. "Handle the keybinding"
  331. ^ self handleBindingFor: event
  332. !
  333. handleBindingFor: anEvent
  334. | binding |
  335. binding := self selectedBinding atKey: anEvent which.
  336. binding ifNotNil: [
  337. self applyBinding: binding.
  338. anEvent preventDefault.
  339. ^ false ]
  340. !
  341. handleInactiveKeyDown: event
  342. event which = self activationKey ifTrue: [
  343. event ctrlKey ifTrue: [
  344. self activate.
  345. event preventDefault.
  346. ^ false ] ]
  347. !
  348. handleKeyDown: event
  349. ^ self isActive
  350. ifTrue: [ self handleActiveKeyDown: event ]
  351. ifFalse: [ self handleInactiveKeyDown: event ]
  352. !
  353. setupEvents
  354. 'body' asJQuery keydown: [ :event | self handleKeyDown: event ]
  355. ! !
  356. !HLKeyBinder methodsFor: 'initialization'!
  357. initialize
  358. super initialize.
  359. helper := HLKeyBinderHelperWidget on: self
  360. ! !
  361. !HLKeyBinder methodsFor: 'testing'!
  362. isActive
  363. ^ ('.', self helper cssClass) asJQuery is: ':visible'
  364. !
  365. systemIsMac
  366. ^ navigator platform match: 'Mac'
  367. ! !
  368. HLKeyBinder class instanceVariableNames: 'current'!
  369. !HLKeyBinder class methodsFor: 'instance creation'!
  370. current
  371. ^ current ifNil: [ current := super new ]
  372. !
  373. new
  374. self shouldNotImplement
  375. ! !
  376. HLWidget subclass: #HLKeyBinderHelperWidget
  377. instanceVariableNames: 'keyBinder'
  378. package: 'Helios-KeyBindings'!
  379. !HLKeyBinderHelperWidget commentStamp!
  380. I am the widget responsible for displaying active keybindings in a bar at the bottom of the window. Each keybinding is an instance of `HLBinding`.
  381. Rendering is done through a double dispatch, see `#renderSelectedBindingOn:`.!
  382. !HLKeyBinderHelperWidget methodsFor: 'accessing'!
  383. cssClass
  384. ^ 'key_helper'
  385. !
  386. keyBinder
  387. ^ keyBinder
  388. !
  389. keyBinder: aKeyBinder
  390. keyBinder := aKeyBinder
  391. !
  392. mainId
  393. ^ 'binding-helper-main'
  394. !
  395. selectedBinding
  396. ^ self keyBinder selectedBinding
  397. ! !
  398. !HLKeyBinderHelperWidget methodsFor: 'actions'!
  399. deactivate
  400. self keyBinder deactivate
  401. !
  402. hide
  403. ('.', self cssClass) asJQuery remove.
  404. '.helper_overlay' asJQuery remove.
  405. self showCog
  406. !
  407. hideCog
  408. '#cog-helper' asJQuery hide
  409. !
  410. show
  411. self hideCog.
  412. self appendToJQuery: 'body' asJQuery
  413. !
  414. showCog
  415. '#cog-helper' asJQuery show
  416. !
  417. showWidget: aWidget
  418. "Some actions need to display more info to the user or request input.
  419. This method is the right place for that"
  420. ('#', self mainId) asJQuery empty.
  421. aWidget appendToJQuery: ('#', self mainId) asJQuery
  422. ! !
  423. !HLKeyBinderHelperWidget methodsFor: 'rendering'!
  424. renderBindingActionFor: aBinding on: html
  425. html span class: 'command'; with: [
  426. html strong
  427. class: 'label';
  428. with: aBinding shortcut asLowercase.
  429. html a
  430. class: 'action';
  431. with: aBinding displayLabel;
  432. onClick: [ self keyBinder applyBinding: aBinding ] ]
  433. !
  434. renderBindingGroup: aBindingGroup on: html
  435. (aBindingGroup activeBindings
  436. sorted: [ :a :b | a key < b key ])
  437. do: [ :each | self renderBindingActionFor: each on: html ]
  438. !
  439. renderCloseOn: html
  440. html a
  441. class: 'close';
  442. with: [ (html tag: 'i') class: 'icon-remove' ];
  443. onClick: [ self keyBinder deactivate ]
  444. !
  445. renderContentOn: html
  446. html div
  447. id: 'overlay';
  448. class: 'helper_overlay';
  449. onClick: [ self deactivate ].
  450. html div class: self cssClass; with: [
  451. self renderLabelOn: html.
  452. html div
  453. id: self mainId;
  454. with: [ self renderSelectedBindingOn: html ].
  455. self renderCloseOn: html ].
  456. ':focus' asJQuery blur
  457. !
  458. renderLabelOn: html
  459. html span
  460. class: 'selected';
  461. with: (self selectedBinding label ifNil: [ 'Action' ])
  462. !
  463. renderSelectedBindingOn: html
  464. self selectedBinding renderOn: self html: html
  465. ! !
  466. !HLKeyBinderHelperWidget class methodsFor: 'instance creation'!
  467. on: aKeyBinder
  468. ^ self new
  469. keyBinder: aKeyBinder;
  470. yourself
  471. ! !
  472. Object subclass: #HLRepeatedKeyDownHandler
  473. instanceVariableNames: 'repeatInterval delay interval keyBindings widget keyDown'
  474. package: 'Helios-KeyBindings'!
  475. !HLRepeatedKeyDownHandler commentStamp!
  476. I am responsible for handling repeated key down actions for widgets.
  477. ##Usage
  478. (self on: aWidget)
  479. whileKeyDown: 38 do: aBlock;
  480. whileKeyDown: 40 do: anotherBlock;
  481. bindKeys
  482. I perform an action block on a key press, wait for 300 ms and then preform the same action block every `repeatInterval` milliseconds until the key is released.!
  483. !HLRepeatedKeyDownHandler methodsFor: 'accessing'!
  484. keyBindings
  485. ^ keyBindings ifNil: [ keyBindings := Dictionary new ]
  486. !
  487. repeatInterval
  488. ^ repeatInterval ifNil: [ self defaultRepeatInterval ]
  489. !
  490. repeatInterval: anInteger
  491. repeatInterval := anInteger
  492. !
  493. widget
  494. ^ widget
  495. !
  496. widget: aWidget
  497. widget := aWidget
  498. ! !
  499. !HLRepeatedKeyDownHandler methodsFor: 'actions'!
  500. startRepeatingAction: aBlock
  501. ^ [ (self widget hasFocus)
  502. ifTrue: [ aBlock value ]
  503. ifFalse: [ self handleKeyUp ] ] valueWithInterval: self repeatInterval
  504. !
  505. whileKeyDown: aKey do: aBlock
  506. self keyBindings at: aKey put: aBlock
  507. ! !
  508. !HLRepeatedKeyDownHandler methodsFor: 'binding'!
  509. bindKeys
  510. self widget
  511. bindKeyDown: [ :e | self handleKeyDown: e ]
  512. keyUp: [ :e | self handleKeyUp ]
  513. !
  514. rebindKeys
  515. self
  516. unbindKeys;
  517. bindKeys
  518. !
  519. unbindKeys
  520. self widget unbindKeyDownKeyUp
  521. ! !
  522. !HLRepeatedKeyDownHandler methodsFor: 'defaults'!
  523. defaultRepeatInterval
  524. ^ 70
  525. ! !
  526. !HLRepeatedKeyDownHandler methodsFor: 'events handling'!
  527. handleEvent: anEvent forKey: anInteger action: aBlock
  528. (anEvent which = anInteger and: [ self isKeyDown not ])
  529. ifTrue: [ self whileKeyDownDo: aBlock ]
  530. !
  531. handleKeyDown: anEvent
  532. self keyBindings keysAndValuesDo: [ :key :action |
  533. self handleEvent: anEvent forKey: key action: action ]
  534. !
  535. handleKeyUp
  536. self isKeyDown ifTrue: [
  537. keyDown := false.
  538. interval ifNotNil: [ interval clearInterval ].
  539. delay ifNotNil: [ delay clearTimeout ] ]
  540. !
  541. whileKeyDownDo: aBlock
  542. keyDown := true.
  543. aBlock value.
  544. delay := [ interval := self startRepeatingAction: aBlock ]
  545. valueWithTimeout: 300
  546. ! !
  547. !HLRepeatedKeyDownHandler methodsFor: 'testing'!
  548. isKeyDown
  549. ^ keyDown ifNil: [ false ]
  550. ! !
  551. !HLRepeatedKeyDownHandler class methodsFor: 'instance creation'!
  552. on: aWidget
  553. ^ self new
  554. widget: aWidget;
  555. yourself
  556. ! !