Helios-KeyBindings.st 15 KB

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