Helios-KeyBindings.st 15 KB

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