From c30c334a82df7ccae051d251cae0bbd39bbb9758 Mon Sep 17 00:00:00 2001 From: cage Date: Sun, 12 Nov 2023 14:41:47 +0100 Subject: [PATCH] - changed keyboard events management to reflects changes in croatoan API. --- src/command-window.lisp | 16 ++--- src/keybindings.lisp | 109 +++++++++++++++++++++++++++------- src/line-oriented-window.lisp | 6 +- 3 files changed, 97 insertions(+), 34 deletions(-) diff --git a/src/command-window.lisp b/src/command-window.lisp index 4b6c460..8d2bb9a 100644 --- a/src/command-window.lisp +++ b/src/command-window.lisp @@ -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) diff --git a/src/keybindings.lisp b/src/keybindings.lisp index 344614c..9c1c0c1 100644 --- a/src/keybindings.lisp +++ b/src/keybindings.lisp @@ -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 diff --git a/src/line-oriented-window.lisp b/src/line-oriented-window.lisp index b197670..4d24a93 100644 --- a/src/line-oriented-window.lisp +++ b/src/line-oriented-window.lisp @@ -549,12 +549,12 @@ will fire the `callback' function (with the selected field from `all-fields' (loop named inner for c = (tui:decode-key-event (c:get-wide-event low-level-window)) while (string/= c "q") - do + 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")