cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- changed keyboard events management to reflects changes in croatoan API.

This commit is contained in:
cage 2023-11-12 14:41:47 +01:00
parent 7d22b73d1a
commit c30c334a82
3 changed files with 97 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/command-window.lisp
View File

@ -506,31 +506,31 @@ command line."
(move-suggestion-page-left command-window))
((eq :alt-right original-key-event)
(move-suggestion-page-right command-window))
((eq :backspace original-key-event)
((eq :key-backspace original-key-event)
(setf command-line (delete-at-point command-window command-line :direction :left))
(when 'hooks:*after-char-to-command-window*
(hooks:run-hook 'hooks:*after-delete-char-from-command-window* command-window))
(show-candidate-completion command-window))
((eq :dc original-key-event)
((eq :key-delete-char original-key-event)
(setf command-line (delete-at-point command-window command-line :direction :right))
(when 'hooks:*after-char-to-command-window*
(hooks:run-hook 'hooks:*after-delete-char-from-command-window* command-window))
(show-candidate-completion command-window))
((eq :left original-key-event)
((eq :key-arrow-left original-key-event)
(move-point-left command-window))
((eq :right original-key-event)
((eq :key-arrow-right original-key-event)
(move-point-right command-window (length command-line)))
((eq :end original-key-event)
((eq :key-end original-key-event)
(move-point-to-end command-window command-line))
((eq :home original-key-event)
((eq :key-home original-key-event)
(move-point-to-start command-window))
((eq :up original-key-event)
((eq :key-arrow-up original-key-event)
(if (win-shown-p suggestions-win)
(select-suggestion-previous command-window)
(multiple-value-bind (new-id new-input)
(db:previous-in-history history-position prompt)
(set-history new-id new-input))))
((eq :down original-key-event)
((eq :key-arrow-down original-key-event)
(if (win-shown-p suggestions-win)
(select-suggestion-next command-window)
(multiple-value-bind (new-id new-input)

109
src/keybindings.lisp
View File

@ -34,10 +34,15 @@
;; | KEYCODE
;; | FUNCTION-PLACEHOLDER
;; COMMAND-KEY := ( (COMMAND-MOD-1 DASH) | COMMAND-MOD-2 ) KEYCODE
;; META-KEY := META-MOD DASH KEYCODE
;; META-KEY := META-MOD DASH AFTER-META-KEYCODE
;; KEYCODE := NON-PRINTABLE-KEY | SIMPLE-KEY
;; AFTER-META-KEYCODE := AFTER-META-KEY | SIMPLE-KEY
;; AFTER-META-KEY := 'right'
;; |'left'
;; |'up'
;; |'down'
;; SIMPLE-KEY := CHAR
;; NON-PRINTABLE-KEY := |'f1'
;; NON-PRINTABLE-KEY := 'f1'
;; |'f2'
;; |'f3'
;; |'f4'
@ -47,15 +52,15 @@
;; |'f8'
;; |'f9'
;; |'f10
;; | 'right'
;; | 'left'
;; | 'up'
;; | 'down'
;; | 'home'
;; | 'end'
;; | 'npage'
;; | 'ppage'
;; | "dc"
;; | 'key-arrow-right'
;; | 'key-arrow-left'
;; | 'key-arrow-up'
;; | 'key-arrow-down'
;; | 'key-home'
;; | 'key-end'
;; | 'key-next-page'
;; | 'key-previous-page'
;; | 'dc'
;; COMMAND-MOD-1 := 'C'
;; COMMAND-MOD-2 := '^'
;; META-MOD := 'M'
@ -81,6 +86,33 @@
(defrule dash #\-
(:text t))
(defrule arrow-right "right"
(:constant "key-arrow-right"))
(defrule arrow-left "left"
(:constant "key-arrow-left"))
(defrule arrow-up "up"
(:constant "key-arrow-up"))
(defrule arrow-down "down"
(:constant "key-arrow-down"))
(defrule key-home "home"
(:constant "key-home"))
(defrule key-end "end"
(:constant "key-end"))
(defrule key-next-page "npage"
(:constant "key-next-page"))
(defrule key-previous-page "ppage"
(:constant "key-previous-page"))
(defrule key-delete-next-char "dc"
(:constant "key-delete-char"))
(defrule non-printable-key
(or "f10"
"f1"
@ -92,15 +124,32 @@
"f7"
"f8"
"f9"
"right"
"key-arrow-right"
"key-arrow-left"
"key-arrow-up"
"key-arrow-down"
"key-home"
"key-end"
"key-next-page"
"key-previous-page"
"key-delete-char"
arrow-right
arrow-left
arrow-up
arrow-down
key-home
key-end
key-next-page
key-previous-page
key-next-page)
(:text t)
(:function string-upcase))
(defrule after-meta-key
(or "right"
"left"
"up"
"down"
"home"
"end"
"npage" ; page down
"ppage" ; page up
"dc") ; canc
"down")
(:text t)
(:function string-upcase))
@ -120,11 +169,13 @@
(defrule keycode (or non-printable-key simple-key)) ; keep the order
(defrule after-meta-keycode (or after-meta-key simple-key)) ; keep the order
(defun to-meta-code-string (command)
(strcat +meta-prefix+ (string-upcase (third command))))
(defrule meta-key
(and meta-mod dash keycode)
(and meta-mod dash after-meta-keycode)
(:function to-meta-code-string)
(:text t))
@ -451,12 +502,21 @@ understand"
(function-name key)))
((string= key "^J")
(_ "Enter"))
((string= key "DC")
((or (string= key "KEY-DELETE-CHAR")
(string= key "DC"))
(_ "Delete"))
((string= key "NPAGE")
((or (string= key "KEY-NEXT-PAGE")
(string= key "NPAGE"))
(_ "Page-up"))
((string= key "PPAGE")
((or (string= key "KEY-PREVIOUS-PAGE")
(string= key "PPAGE"))
(_ "Page-down"))
((or (string= key "KEY-ARROW-DOWN")
(string= key "UP"))
(_ "Arrow up"))
((or (string= key "KEY-ARROW-UP")
(string= key "DOWN"))
(_ "Arrow down"))
(t
(to-s key))))
@ -484,7 +544,10 @@ each leaf (as strings)"
(loop for path in paths collect
(mapcar #'humanize-key (rest path))))
(build-string (paths)
(mapcar (lambda (a) (format nil "~a" (join-with-strings a " ")))
(mapcar (lambda (a) (format nil
"~a: ~a"
(first a)
(join-with-strings (rest a) " ")))
paths)))
(collect keymapping-tree)
(mapcar #'make-help-fields

4
src/line-oriented-window.lisp
View File

@ -551,10 +551,10 @@ will fire the `callback' function (with the selected field from `all-fields'
while (string/= c "q")
do
(cond
((string= c :up)
((string= c :key-arrow-up)
(unselect-all high-level-window)
(row-move high-level-window -1))
((string= c :down)
((string= c :key-arrow-down)
(unselect-all high-level-window)
(row-move high-level-window 1))
((string= c "^J")