Helios-KeyBindings.st 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750
  1. Smalltalk current 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. helper
  360. renderStart;
  361. renderCog
  362. ! !
  363. !HLKeyBinder methodsFor: 'testing'!
  364. isActive
  365. ^ ('.', self helper cssClass) asJQuery is: ':visible'
  366. !
  367. systemIsMac
  368. ^ navigator platform match: 'Mac'
  369. ! !
  370. HLKeyBinder class instanceVariableNames: 'current'!
  371. !HLKeyBinder class methodsFor: 'instance creation'!
  372. current
  373. ^ current ifNil: [ current := super new ]
  374. !
  375. new
  376. self shouldNotImplement
  377. ! !
  378. HLWidget subclass: #HLKeyBinderHelperWidget
  379. instanceVariableNames: 'keyBinder'
  380. package: 'Helios-KeyBindings'!
  381. !HLKeyBinderHelperWidget commentStamp!
  382. 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`.
  383. Rendering is done through a double dispatch, see `#renderSelectedBindingOn:`.!
  384. !HLKeyBinderHelperWidget methodsFor: 'accessing'!
  385. cssClass
  386. ^ 'key_helper'
  387. !
  388. keyBinder
  389. ^ keyBinder
  390. !
  391. keyBinder: aKeyBinder
  392. keyBinder := aKeyBinder
  393. !
  394. mainId
  395. ^ 'binding-helper-main'
  396. !
  397. selectedBinding
  398. ^ self keyBinder selectedBinding
  399. ! !
  400. !HLKeyBinderHelperWidget methodsFor: 'actions'!
  401. hide
  402. ('.', self cssClass) asJQuery remove.
  403. self showCog
  404. !
  405. hideCog
  406. '#cog-helper' asJQuery hide
  407. !
  408. show
  409. self hideCog.
  410. self appendToJQuery: 'body' asJQuery
  411. !
  412. showCog
  413. '#cog-helper' asJQuery show
  414. !
  415. showWidget: aWidget
  416. "Some actions need to display more info to the user or request input.
  417. This method is the right place for that"
  418. ('#', self mainId) asJQuery empty.
  419. aWidget appendToJQuery: ('#', self mainId) asJQuery
  420. ! !
  421. !HLKeyBinderHelperWidget methodsFor: 'rendering'!
  422. renderBindingActionFor: aBinding on: html
  423. html span class: 'command'; with: [
  424. html span
  425. class: 'label';
  426. with: aBinding shortcut asLowercase.
  427. html a
  428. class: 'action';
  429. with: aBinding displayLabel;
  430. onClick: [ self keyBinder applyBinding: aBinding ] ]
  431. !
  432. renderBindingGroup: aBindingGroup on: html
  433. (aBindingGroup activeBindings
  434. sorted: [ :a :b | a key < b key ])
  435. do: [ :each | self renderBindingActionFor: each on: html ]
  436. !
  437. renderCloseOn: html
  438. html a
  439. class: 'close';
  440. with: [ (html tag: 'i') class: 'icon-remove' ];
  441. onClick: [ self keyBinder deactivate ]
  442. !
  443. renderCog
  444. [ :html |
  445. html
  446. div id: 'cog-helper';
  447. with: [
  448. html a
  449. with: [ (html tag: 'i') class: 'icon-cog' ];
  450. onClick: [ self keyBinder activate ] ] ]
  451. appendToJQuery: 'body' asJQuery
  452. !
  453. renderContentOn: html
  454. html div class: self cssClass; with: [
  455. self renderLabelOn:html.
  456. html div
  457. id: self mainId;
  458. with: [ self renderSelectedBindingOn: html ].
  459. self renderCloseOn: html ]
  460. !
  461. renderLabelOn: html
  462. html span
  463. class: 'selected';
  464. with: (self selectedBinding label ifNil: [ 'Action' ])
  465. !
  466. renderSelectedBindingOn: html
  467. self selectedBinding renderOn: self html: html
  468. !
  469. renderStart
  470. '#helper' asJQuery remove.
  471. [ :html |
  472. html div
  473. id: 'helper';
  474. with: 'Press ', self keyBinder activationKeyLabel, ' to start' ] appendToJQuery: 'body' asJQuery.
  475. [ '#helper' asJQuery fadeOut: 1000 ]
  476. valueWithTimeout: 2000
  477. ! !
  478. !HLKeyBinderHelperWidget class methodsFor: 'instance creation'!
  479. on: aKeyBinder
  480. ^ self new
  481. keyBinder: aKeyBinder;
  482. yourself
  483. ! !
  484. Object subclass: #HLRepeatedKeyDownHandler
  485. instanceVariableNames: '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. ! !