1
0

Helios-KeyBindings.st 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765
  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 ] 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 or ctrl+g deactivate the keyBinder"
  323. (event which = self escapeKey or: [
  324. event which = 71 and: [ event ctrlKey ] ])
  325. ifTrue: [
  326. self deactivate.
  327. event preventDefault.
  328. ^ false ].
  329. "Handle the keybinding"
  330. ^ self handleBindingFor: event
  331. !
  332. handleBindingFor: anEvent
  333. | binding |
  334. binding := self selectedBinding atKey: anEvent which.
  335. binding ifNotNil: [
  336. self applyBinding: binding.
  337. anEvent preventDefault.
  338. ^ false ]
  339. !
  340. handleInactiveKeyDown: event
  341. event which = self activationKey ifTrue: [
  342. event ctrlKey ifTrue: [
  343. self activate.
  344. event preventDefault.
  345. ^ false ] ]
  346. !
  347. handleKeyDown: event
  348. ^ self isActive
  349. ifTrue: [ self handleActiveKeyDown: event ]
  350. ifFalse: [ self handleInactiveKeyDown: event ]
  351. !
  352. setupEvents
  353. 'body' asJQuery keydown: [ :event | self handleKeyDown: event ]
  354. ! !
  355. !HLKeyBinder methodsFor: 'initialization'!
  356. initialize
  357. super initialize.
  358. helper := HLKeyBinderHelperWidget on: self
  359. !
  360. setupHelper
  361. helper
  362. renderStart;
  363. renderCog
  364. ! !
  365. !HLKeyBinder methodsFor: 'testing'!
  366. isActive
  367. ^ ('.', self helper cssClass) asJQuery is: ':visible'
  368. !
  369. systemIsMac
  370. ^ navigator platform match: 'Mac'
  371. ! !
  372. HLKeyBinder class instanceVariableNames: 'current'!
  373. !HLKeyBinder class methodsFor: 'instance creation'!
  374. current
  375. ^ current ifNil: [ current := super new ]
  376. !
  377. new
  378. self shouldNotImplement
  379. ! !
  380. HLWidget subclass: #HLKeyBinderHelperWidget
  381. instanceVariableNames: 'keyBinder'
  382. package: 'Helios-KeyBindings'!
  383. !HLKeyBinderHelperWidget commentStamp!
  384. 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`.
  385. Rendering is done through a double dispatch, see `#renderSelectedBindingOn:`.!
  386. !HLKeyBinderHelperWidget methodsFor: 'accessing'!
  387. cssClass
  388. ^ 'key_helper'
  389. !
  390. keyBinder
  391. ^ keyBinder
  392. !
  393. keyBinder: aKeyBinder
  394. keyBinder := aKeyBinder
  395. !
  396. mainId
  397. ^ 'binding-helper-main'
  398. !
  399. selectedBinding
  400. ^ self keyBinder selectedBinding
  401. ! !
  402. !HLKeyBinderHelperWidget methodsFor: 'actions'!
  403. deactivate
  404. self keyBinder deactivate
  405. !
  406. hide
  407. ('.', self cssClass) asJQuery remove.
  408. '#overlay' asJQuery remove.
  409. self showCog
  410. !
  411. hideCog
  412. '#cog-helper' asJQuery hide
  413. !
  414. show
  415. self hideCog.
  416. self appendToJQuery: 'body' asJQuery
  417. !
  418. showCog
  419. '#cog-helper' asJQuery show
  420. !
  421. showWidget: aWidget
  422. "Some actions need to display more info to the user or request input.
  423. This method is the right place for that"
  424. ('#', self mainId) asJQuery empty.
  425. aWidget appendToJQuery: ('#', self mainId) asJQuery
  426. ! !
  427. !HLKeyBinderHelperWidget methodsFor: 'rendering'!
  428. renderBindingActionFor: aBinding on: html
  429. html span class: 'command'; with: [
  430. html strong
  431. class: 'label';
  432. with: aBinding shortcut asLowercase.
  433. html a
  434. class: 'action';
  435. with: aBinding displayLabel;
  436. onClick: [ self keyBinder applyBinding: aBinding ] ]
  437. !
  438. renderBindingGroup: aBindingGroup on: html
  439. (aBindingGroup activeBindings
  440. sorted: [ :a :b | a key < b key ])
  441. do: [ :each | self renderBindingActionFor: each on: html ]
  442. !
  443. renderCloseOn: html
  444. html a
  445. class: 'close';
  446. with: [ (html tag: 'i') class: 'icon-remove' ];
  447. onClick: [ self keyBinder deactivate ]
  448. !
  449. renderCog
  450. [ :html |
  451. html
  452. div id: 'cog-helper';
  453. with: [
  454. html a
  455. with: [ (html tag: 'i') class: 'icon-cog' ];
  456. onClick: [ self keyBinder activate ] ] ]
  457. appendToJQuery: 'body' asJQuery
  458. !
  459. renderContentOn: html
  460. html div
  461. id: 'overlay';
  462. class: 'light';
  463. onClick: [ self deactivate ].
  464. html div class: self cssClass; with: [
  465. self renderLabelOn: html.
  466. html div
  467. id: self mainId;
  468. with: [ self renderSelectedBindingOn: html ].
  469. self renderCloseOn: html ].
  470. ':focus' asJQuery blur
  471. !
  472. renderLabelOn: html
  473. html span
  474. class: 'selected';
  475. with: (self selectedBinding label ifNil: [ 'Action' ])
  476. !
  477. renderSelectedBindingOn: html
  478. self selectedBinding renderOn: self html: html
  479. !
  480. renderStart
  481. '#helper' asJQuery remove.
  482. [ :html |
  483. html div
  484. id: 'helper';
  485. with: 'Press ', self keyBinder activationKeyLabel, ' to start' ] appendToJQuery: 'body' asJQuery.
  486. [ '#helper' asJQuery fadeOut: 1000 ]
  487. valueWithTimeout: 2000
  488. ! !
  489. !HLKeyBinderHelperWidget class methodsFor: 'instance creation'!
  490. on: aKeyBinder
  491. ^ self new
  492. keyBinder: aKeyBinder;
  493. yourself
  494. ! !
  495. Object subclass: #HLRepeatedKeyDownHandler
  496. instanceVariableNames: 'repeatInterval delay interval keyBindings widget keyDown'
  497. package: 'Helios-KeyBindings'!
  498. !HLRepeatedKeyDownHandler commentStamp!
  499. I am responsible for handling repeated key down actions for widgets.
  500. ##Usage
  501. (self on: aWidget)
  502. whileKeyDown: 38 do: aBlock;
  503. whileKeyDown: 40 do: anotherBlock;
  504. bindKeys
  505. 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.!
  506. !HLRepeatedKeyDownHandler methodsFor: 'accessing'!
  507. keyBindings
  508. ^ keyBindings ifNil: [ keyBindings := Dictionary new ]
  509. !
  510. repeatInterval
  511. ^ repeatInterval ifNil: [ self defaultRepeatInterval ]
  512. !
  513. repeatInterval: anInteger
  514. repeatInterval := anInteger
  515. !
  516. widget
  517. ^ widget
  518. !
  519. widget: aWidget
  520. widget := aWidget
  521. ! !
  522. !HLRepeatedKeyDownHandler methodsFor: 'actions'!
  523. startRepeatingAction: aBlock
  524. ^ [ (self widget hasFocus)
  525. ifTrue: [ aBlock value ]
  526. ifFalse: [ self handleKeyUp ] ] valueWithInterval: self repeatInterval
  527. !
  528. whileKeyDown: aKey do: aBlock
  529. self keyBindings at: aKey put: aBlock
  530. ! !
  531. !HLRepeatedKeyDownHandler methodsFor: 'binding'!
  532. bindKeys
  533. self widget
  534. bindKeyDown: [ :e | self handleKeyDown: e ]
  535. keyUp: [ :e | self handleKeyUp ]
  536. !
  537. rebindKeys
  538. self
  539. unbindKeys;
  540. bindKeys
  541. !
  542. unbindKeys
  543. self widget unbindKeyDownKeyUp
  544. ! !
  545. !HLRepeatedKeyDownHandler methodsFor: 'defaults'!
  546. defaultRepeatInterval
  547. ^ 70
  548. ! !
  549. !HLRepeatedKeyDownHandler methodsFor: 'events handling'!
  550. handleEvent: anEvent forKey: anInteger action: aBlock
  551. (anEvent which = anInteger and: [ self isKeyDown not ])
  552. ifTrue: [ self whileKeyDownDo: aBlock ]
  553. !
  554. handleKeyDown: anEvent
  555. self keyBindings keysAndValuesDo: [ :key :action |
  556. self handleEvent: anEvent forKey: key action: action ]
  557. !
  558. handleKeyUp
  559. self isKeyDown ifTrue: [
  560. keyDown := false.
  561. interval ifNotNil: [ interval clearInterval ].
  562. delay ifNotNil: [ delay clearTimeout ] ]
  563. !
  564. whileKeyDownDo: aBlock
  565. keyDown := true.
  566. aBlock value.
  567. delay := [ interval := self startRepeatingAction: aBlock ]
  568. valueWithTimeout: 300
  569. ! !
  570. !HLRepeatedKeyDownHandler methodsFor: 'testing'!
  571. isKeyDown
  572. ^ keyDown ifNil: [ false ]
  573. ! !
  574. !HLRepeatedKeyDownHandler class methodsFor: 'instance creation'!
  575. on: aWidget
  576. ^ self new
  577. widget: aWidget;
  578. yourself
  579. ! !