1
0

Helios-KeyBindings.st 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697
  1. Smalltalk current createPackage: 'Helios-KeyBindings'!
  2. Object subclass: #HLBinding
  3. instanceVariableNames: 'key label'
  4. package: 'Helios-KeyBindings'!
  5. !HLBinding methodsFor: 'accessing'!
  6. atKey: aKey
  7. ^ nil
  8. !
  9. displayLabel
  10. ^ self label
  11. !
  12. key
  13. ^ key
  14. !
  15. key: anInteger
  16. key := anInteger
  17. !
  18. label
  19. ^ label
  20. !
  21. label: aString
  22. label := aString
  23. !
  24. shortcut
  25. ^ String fromCharCode: self key
  26. ! !
  27. !HLBinding methodsFor: 'actions'!
  28. applyOn: aKeyBinder
  29. !
  30. release
  31. ! !
  32. !HLBinding methodsFor: 'rendering'!
  33. renderActionFor: aBinder html: html
  34. html span class: 'command'; with: [
  35. html span
  36. class: 'label';
  37. with: self shortcut asLowercase.
  38. html a
  39. class: 'action';
  40. with: self displayLabel;
  41. onClick: [ aBinder applyBinding: self ] ]
  42. !
  43. renderOn: aBindingHelper html: html
  44. ! !
  45. !HLBinding methodsFor: 'testing'!
  46. isActive
  47. ^ self subclassResponsibility
  48. !
  49. isFinal
  50. " Answer true if the receiver is the final binding of a sequence "
  51. ^ false
  52. ! !
  53. !HLBinding class methodsFor: 'instance creation'!
  54. on: anInteger labelled: aString
  55. ^ self new
  56. key: anInteger;
  57. label: aString;
  58. yourself
  59. ! !
  60. HLBinding subclass: #HLBindingAction
  61. instanceVariableNames: 'command'
  62. package: 'Helios-KeyBindings'!
  63. !HLBindingAction methodsFor: 'accessing'!
  64. command
  65. ^ command
  66. !
  67. command: aCommand
  68. command := aCommand
  69. !
  70. inputBinding
  71. ^ HLBindingInput new
  72. label: self command inputLabel;
  73. ghostText: self command displayLabel;
  74. defaultValue: self command defaultInput;
  75. inputCompletion: self command inputCompletion;
  76. callback: [ :val |
  77. self command
  78. input: val;
  79. execute ];
  80. yourself
  81. ! !
  82. !HLBindingAction methodsFor: 'actions'!
  83. applyOn: aKeyBinder
  84. self command isInputRequired
  85. ifTrue: [ aKeyBinder selectBinding: self inputBinding ]
  86. ifFalse: [ self command execute ]
  87. ! !
  88. !HLBindingAction methodsFor: 'testing'!
  89. isActive
  90. ^ self command isActive
  91. !
  92. isFinal
  93. ^ self command isInputRequired not
  94. ! !
  95. HLBinding subclass: #HLBindingGroup
  96. instanceVariableNames: 'bindings'
  97. package: 'Helios-KeyBindings'!
  98. !HLBindingGroup methodsFor: 'accessing'!
  99. activeBindings
  100. ^ self bindings select: [ :each | each isActive ]
  101. !
  102. add: aBinding
  103. ^ self bindings add: aBinding
  104. !
  105. addActionKey: anInteger labelled: aString callback: aBlock
  106. self add: ((HLBindingAction on: anInteger labelled: aString)
  107. callback: aBlock;
  108. yourself)
  109. !
  110. addGroupKey: anInteger labelled: aString
  111. self add: (HLBindingGroup on: anInteger labelled: aString)
  112. !
  113. at: aString
  114. ^ self bindings
  115. detect: [ :each | each label = aString ]
  116. ifNone: [ nil ]
  117. !
  118. at: aString add: aBinding
  119. | binding |
  120. binding := self at: aString.
  121. binding ifNil: [ ^ self ].
  122. binding add: aBinding
  123. !
  124. atKey: anInteger
  125. ^ self bindings
  126. detect: [ :each | each key = anInteger ]
  127. ifNone: [ nil ]
  128. !
  129. bindings
  130. ^ bindings ifNil: [ bindings := OrderedCollection new ]
  131. !
  132. displayLabel
  133. ^ super displayLabel, '...'
  134. ! !
  135. !HLBindingGroup methodsFor: 'actions'!
  136. release
  137. self bindings do: [ :each | each release ]
  138. ! !
  139. !HLBindingGroup methodsFor: 'rendering'!
  140. renderOn: aBindingHelper html: html
  141. self isActive ifTrue: [
  142. aBindingHelper renderBindingGroup: self on: html ]
  143. ! !
  144. !HLBindingGroup methodsFor: 'testing'!
  145. isActive
  146. ^ self activeBindings notEmpty
  147. ! !
  148. HLBinding subclass: #HLBindingInput
  149. instanceVariableNames: 'input callback status wrapper binder ghostText isFinal message messageTag inputCompletion defaultValue'
  150. package: 'Helios-KeyBindings'!
  151. !HLBindingInput methodsFor: 'accessing'!
  152. atKey: aKey
  153. aKey = 13 ifFalse: [ ^ nil ]
  154. !
  155. callback
  156. ^ callback ifNil: [ callback := [ :value | ] ]
  157. !
  158. callback: aBlock
  159. callback := aBlock
  160. !
  161. defaultValue
  162. ^ defaultValue ifNil: [ '' ]
  163. !
  164. defaultValue: aString
  165. defaultValue := aString
  166. !
  167. ghostText
  168. ^ ghostText
  169. !
  170. ghostText: aText
  171. ghostText := aText
  172. !
  173. input
  174. ^ input
  175. !
  176. inputCompletion
  177. ^ inputCompletion ifNil: [ #() ]
  178. !
  179. inputCompletion: aCollection
  180. inputCompletion := aCollection
  181. !
  182. message
  183. ^ message ifNil: [ message := '' ]
  184. !
  185. message: aString
  186. message := aString
  187. !
  188. status
  189. ^ status ifNil: [ status := 'info' ]
  190. !
  191. status: aStatus
  192. status := aStatus
  193. ! !
  194. !HLBindingInput methodsFor: 'actions'!
  195. applyOn: aKeyBinder
  196. self isFinal: true.
  197. self evaluate: self input asJQuery val
  198. !
  199. clearStatus
  200. self status: 'info'.
  201. self message: ''.
  202. self refresh
  203. !
  204. errorStatus
  205. self status: 'error'.
  206. self refresh
  207. !
  208. evaluate: aString
  209. [ self callback value: aString ]
  210. on: Error
  211. do: [:ex |
  212. self input asJQuery
  213. one: 'keydown'
  214. do: [ self clearStatus ].
  215. self message: ex messageText.
  216. self errorStatus.
  217. self isFinal: false ].
  218. !
  219. release
  220. status := nil.
  221. wrapper := nil.
  222. binder := nil
  223. ! !
  224. !HLBindingInput methodsFor: 'rendering'!
  225. refresh
  226. wrapper ifNil: [ ^ self ].
  227. wrapper class: self status.
  228. messageTag contents: self message
  229. !
  230. renderOn: aBinder html: html
  231. binder := aBinder.
  232. wrapper ifNil: [ wrapper := html span ].
  233. wrapper
  234. class: self status;
  235. with: [
  236. input := html input
  237. placeholder: self ghostText;
  238. value: self defaultValue;
  239. yourself.
  240. input asJQuery
  241. typeahead: #{ 'source' -> self inputCompletion }.
  242. messageTag := (html span
  243. class: 'help-inline';
  244. with: self message;
  245. yourself) ].
  246. "Evaluate with a timeout to ensure focus.
  247. Commands can be executed from a menu, clicking on the menu to
  248. evaluate the command would give it the focus otherwise"
  249. [ input asJQuery focus ] valueWithTimeout: 10
  250. ! !
  251. !HLBindingInput methodsFor: 'testing'!
  252. isActive
  253. ^ true
  254. !
  255. isFinal
  256. ^ isFinal ifNil: [ isFinal := super isFinal ]
  257. !
  258. isFinal: aBoolean
  259. isFinal := aBoolean
  260. ! !
  261. Object subclass: #HLKeyBinder
  262. instanceVariableNames: 'modifierKey helper bindings selectedBinding'
  263. package: 'Helios-KeyBindings'!
  264. !HLKeyBinder methodsFor: 'accessing'!
  265. activationKey
  266. "SPACE"
  267. ^ 32
  268. !
  269. activationKeyLabel
  270. ^ 'ctrl + space'
  271. !
  272. bindings
  273. ^ bindings ifNil: [ bindings := self defaultBindings ]
  274. !
  275. escapeKey
  276. "ESC"
  277. ^ 27
  278. !
  279. helper
  280. ^ helper
  281. !
  282. selectedBinding
  283. ^ selectedBinding ifNil: [ self bindings ]
  284. ! !
  285. !HLKeyBinder methodsFor: 'actions'!
  286. activate
  287. self helper show
  288. !
  289. applyBinding: aBinding
  290. aBinding isActive ifFalse: [ ^ self ].
  291. self selectBinding: aBinding.
  292. aBinding applyOn: self.
  293. aBinding isFinal ifTrue: [ self deactivate ]
  294. !
  295. deactivate
  296. selectedBinding ifNotNil: [ selectedBinding release ].
  297. selectedBinding := nil.
  298. self helper hide
  299. !
  300. flushBindings
  301. bindings := nil
  302. !
  303. selectBinding: aBinding
  304. aBinding = selectedBinding ifTrue: [ ^ self ].
  305. selectedBinding := aBinding.
  306. self helper refresh
  307. ! !
  308. !HLKeyBinder methodsFor: 'defaults'!
  309. defaultBindings
  310. | group |
  311. group := HLBindingGroup new
  312. addGroupKey: 86 labelled: 'View';
  313. add: HLCloseTabCommand new asBinding;
  314. yourself.
  315. HLOpenCommand registerConcreteClassesOn: group.
  316. ^ group
  317. ! !
  318. !HLKeyBinder methodsFor: 'events'!
  319. handleActiveKeyDown: event
  320. "ESC or ctrl+g deactivate the keyBinder"
  321. (event which = self escapeKey or: [
  322. event which = 71 and: [ event ctrlKey ] ])
  323. ifTrue: [
  324. self deactivate.
  325. event preventDefault.
  326. ^ false ].
  327. "Handle the keybinding"
  328. ^ self handleBindingFor: event
  329. !
  330. handleBindingFor: anEvent
  331. | binding |
  332. binding := self selectedBinding atKey: anEvent which.
  333. binding ifNotNil: [
  334. self applyBinding: binding.
  335. anEvent preventDefault.
  336. ^ false ]
  337. !
  338. handleInactiveKeyDown: event
  339. event which = self activationKey ifTrue: [
  340. event ctrlKey ifTrue: [
  341. self activate.
  342. event preventDefault.
  343. ^ false ] ]
  344. !
  345. handleKeyDown: event
  346. ^ self isActive
  347. ifTrue: [ self handleActiveKeyDown: event ]
  348. ifFalse: [ self handleInactiveKeyDown: event ]
  349. !
  350. setupEvents
  351. (window jQuery: 'body') keydown: [ :event | self handleKeyDown: event ]
  352. ! !
  353. !HLKeyBinder methodsFor: 'initialization'!
  354. initialize
  355. super initialize.
  356. helper := HLKeyBinderHelper on: self.
  357. helper
  358. renderStart;
  359. renderCog
  360. ! !
  361. !HLKeyBinder methodsFor: 'testing'!
  362. isActive
  363. ^ ('.', self helper cssClass) asJQuery is: ':visible'
  364. !
  365. systemIsMac
  366. ^ navigator platform match: 'Mac'
  367. ! !
  368. HLWidget subclass: #HLKeyBinderHelper
  369. instanceVariableNames: 'keyBinder'
  370. package: 'Helios-KeyBindings'!
  371. !HLKeyBinderHelper methodsFor: 'accessing'!
  372. cssClass
  373. ^ 'key_helper'
  374. !
  375. keyBinder
  376. ^ keyBinder
  377. !
  378. keyBinder: aKeyBinder
  379. keyBinder := aKeyBinder
  380. !
  381. selectedBinding
  382. ^ self keyBinder selectedBinding
  383. ! !
  384. !HLKeyBinderHelper methodsFor: 'actions'!
  385. hide
  386. ('.', self cssClass) asJQuery remove.
  387. self showCog
  388. !
  389. hideCog
  390. '#cog-helper' asJQuery hide
  391. !
  392. show
  393. self hideCog.
  394. self appendToJQuery: 'body' asJQuery
  395. !
  396. showCog
  397. '#cog-helper' asJQuery show
  398. ! !
  399. !HLKeyBinderHelper methodsFor: 'keyBindings'!
  400. registerBindings
  401. "Do nothing"
  402. ! !
  403. !HLKeyBinderHelper methodsFor: 'rendering'!
  404. renderBindingGroup: aBindingGroup on: html
  405. (aBindingGroup activeBindings
  406. sorted: [ :a :b | a key < b key ])
  407. do: [ :each | each renderActionFor: self keyBinder html: html ]
  408. !
  409. renderBindingOn: html
  410. self selectedBinding renderOn: self html: html
  411. !
  412. renderCloseOn: html
  413. html a
  414. class: 'close';
  415. with: [ (html tag: 'i') class: 'icon-remove' ];
  416. onClick: [ self keyBinder deactivate ]
  417. !
  418. renderCog
  419. [ :html |
  420. html
  421. div id: 'cog-helper';
  422. with: [
  423. html a
  424. with: [ (html tag: 'i') class: 'icon-cog' ];
  425. onClick: [ self keyBinder activate ] ] ]
  426. appendToJQuery: 'body' asJQuery
  427. !
  428. renderContentOn: html
  429. html div class: self cssClass; with: [
  430. self
  431. renderSelectionOn:html;
  432. renderBindingOn: html;
  433. renderCloseOn: html ]
  434. !
  435. renderSelectionOn: html
  436. html span
  437. class: 'selected';
  438. with: (self selectedBinding label ifNil: [ 'Action' ])
  439. !
  440. renderStart
  441. (window jQuery: '#helper') remove.
  442. [ :html |
  443. html div
  444. id: 'helper';
  445. with: 'Press ', self keyBinder activationKeyLabel, ' to start' ] appendToJQuery: 'body' asJQuery.
  446. [ (window jQuery: '#helper') fadeOut: 1000 ]
  447. valueWithTimeout: 2000
  448. ! !
  449. !HLKeyBinderHelper class methodsFor: 'instance creation'!
  450. on: aKeyBinder
  451. ^ self new
  452. keyBinder: aKeyBinder;
  453. yourself
  454. ! !
  455. Object subclass: #HLRepeatingKeyBindingHandler
  456. instanceVariableNames: 'repeatInterval delay interval keyBindings widget isKeyCurrentlyPressed'
  457. package: 'Helios-KeyBindings'!
  458. !HLRepeatingKeyBindingHandler commentStamp!
  459. ##Usage
  460. (HLRepeatingKeyBindingHandler forWidget: aWidget)
  461. whileKeyPressed: keyCode do: [xxxx];
  462. whileKeyPressed: anotherKey do: [yyy];
  463. rebind
  464. Performs an action on a key press, waits for 300 ms and then preforms the action every repeatInterval ms until the button is released!
  465. !HLRepeatingKeyBindingHandler methodsFor: 'accessing'!
  466. repeatInterval: aMillisecondIntegerValue
  467. repeatInterval := aMillisecondIntegerValue
  468. !
  469. whileKeyPressed: aKey do: aBlock
  470. keyBindings at: aKey put: aBlock
  471. !
  472. widget: aWidget
  473. widget := aWidget
  474. ! !
  475. !HLRepeatingKeyBindingHandler methodsFor: 'actions'!
  476. bindKeys
  477. widget bindKeyDown: [ :e | self handleKeyDown: e ] up: [ :e | self handleKeyUp: e ]
  478. !
  479. delayBeforeStartingRepeatWithAction: action
  480. ^ [ interval := self startRepeatingAction: action ] valueWithTimeout: 300
  481. !
  482. handleKeyUp
  483. isKeyCurrentlyPressed := false.
  484. interval ifNotNil: [ interval clearInterval ].
  485. delay ifNotNil: [ delay clearTimeout ]
  486. !
  487. rebindKeys
  488. self unbindKeys;
  489. bindKeys
  490. !
  491. startRepeatingAction: action
  492. ^ [ (widget hasFocus)
  493. ifTrue: [ action value ]
  494. ifFalse: [ self handleKeyUp ] ] valueWithInterval: repeatInterval
  495. !
  496. unbindKeys
  497. widget unbindKeyDownUp
  498. ! !
  499. !HLRepeatingKeyBindingHandler methodsFor: 'events-processing'!
  500. handleKeyDown: e
  501. keyBindings keysAndValuesDo: [ :key :action |
  502. self ifKey: key wasPressedIn: e thenDo: action ]
  503. !
  504. handleKeyUp: e
  505. isKeyCurrentlyPressed
  506. ifTrue: [ self handleKeyUp ]
  507. !
  508. ifKey: key wasPressedIn: e thenDo: action
  509. (e which = key and: [ isKeyCurrentlyPressed = false ])
  510. ifTrue: [ self whileTheKeyIsPressedDo: action ]
  511. !
  512. whileTheKeyIsPressedDo: action
  513. isKeyCurrentlyPressed := true.
  514. action value.
  515. delay := self delayBeforeStartingRepeatWithAction: action
  516. ! !
  517. !HLRepeatingKeyBindingHandler methodsFor: 'initialization'!
  518. initialize
  519. super initialize.
  520. keyBindings := Dictionary new.
  521. isKeyCurrentlyPressed := false.
  522. repeatInterval := 70.
  523. ! !
  524. !HLRepeatingKeyBindingHandler class methodsFor: 'instance-creation'!
  525. forWidget: aWidget
  526. ^self new
  527. widget: aWidget;
  528. yourself
  529. ! !