diff options
| -rw-r--r-- | lisp/kitty-keyboard-protocol.el | 48 | ||||
| -rw-r--r-- | lisp/term/xterm-kitty.el | 31 |
2 files changed, 50 insertions, 29 deletions
diff --git a/lisp/kitty-keyboard-protocol.el b/lisp/kitty-keyboard-protocol.el index 120be50..566e6be 100644 --- a/lisp/kitty-keyboard-protocol.el +++ b/lisp/kitty-keyboard-protocol.el @@ -223,10 +223,16 @@ would swap meta and super.") (defconst kitty-kbp--shift-modifier (car (rassoc 'shift kitty-kbp-modifiers-alist)) "Value of the shift modifier.") +(defun kitty-kbp--2d-array-lookup (v2d first-dim second-dim) + (when-let ((row (and (< first-dim (length v2d)) (aref v2d first-dim))) + (val (and (< second-dim (length row)) (aref row second-dim)))) + val)) + (defun kitty-kbp-decode-key-stroke (keycode modifiers suffix) "Take KEYCODE MODIFIERS SUFFIX of the form (105,5,u) and construct key." ;; Ignore modifiers that we cannot understand (CapsLock and NumLock status) - (let ((mods (logand modifiers (1- (length kitty-kbp--numeric-modifiers))))) + (let ((mods (logand modifiers (1- (length kitty-kbp--numeric-modifiers)))) + (result)) (if (eql suffix ?u) (if (< keycode 57344) ;; To do: support remaining keycodes in unicode private use area @@ -236,26 +242,22 @@ would swap meta and super.") (alist-get keycode kitty-kbp-shift-alist))) ;; The following is equivalent to mods & ~shift (new-modifiers (and shifted-key (- mods kitty-kbp--shift-modifier)))) - (vector (logior (or shifted-key keycode) - (aref kitty-kbp--numeric-modifiers (if shifted-key new-modifiers mods))))) + (setq result + (vector (logior (or shifted-key keycode) + (aref kitty-kbp--numeric-modifiers (if shifted-key new-modifiers mods)))))) (when (<= (aref kitty-kbp--suffix-u-private-bounds 0) keycode (aref kitty-kbp--suffix-u-private-bounds 1)) - (aref (aref kitty-kbp--suffix-u-private-precomputed - (- keycode (aref kitty-kbp--suffix-u-private-bounds 0))) - mods))) + (setq result + (kitty-kbp--2d-array-lookup kitty-kbp--suffix-u-private-precomputed + (- keycode (aref kitty-kbp--suffix-u-private-bounds 0)) + mods)))) (if (eql suffix ?~) - (if (eql keycode 200) - (xterm-translate-bracketed-paste nil) - (aref (aref kitty-kbp--suffix-tilde-precomputed keycode) mods)) + (setq result (kitty-kbp--2d-array-lookup kitty-kbp--suffix-tilde-precomputed keycode mods)) (when (<= ?A suffix ?S) - (if (and (or (eql suffix ?I) (eql suffix ?O)) - (eql keycode 0) - (eql mods 0)) - ;; xterm focus in/out; perhaps there's a better way to do this - (if (eql suffix ?I) (xterm-translate-focus-in nil) (xterm-translate-focus-out nil)) - (aref (aref kitty-kbp--suffix-alpha-precomputed (- suffix ?A)) mods))))))) + (setq result (kitty-kbp--2d-array-lookup kitty-kbp--suffix-alpha-precomputed (- suffix ?A) mods))))) + (or result (list keycode modifiers suffix)))) (defun kitty-kbp-handle-non-printable (keystr) "Split kitty non-printable keystring KEYSTR (e.g., 105;5u) and construct key" @@ -267,6 +269,15 @@ would swap meta and super.") ;; (send-string-to-terminal (format "%s %s %s" keystr code modifiers)) (kitty-kbp-decode-key-stroke code modifiers suffix))) +(defconst kitty-kbp-set-string "\e[>1;u" "Terminal set string") +(defconst kitty-kbp-reset-string "\e[<u" "Terminal reset string") +(defun kitty-kbp-setup-terminal (&optional verbose) + (when verbose + (message "Applying kitty keyboard protocol changes")) + (send-string-to-terminal kitty-kbp-set-string) + (push kitty-kbp-set-string (terminal-parameter nil 'tty-mode-set-strings)) + (push kitty-kbp-reset-string (terminal-parameter nil 'tty-mode-reset-strings))) + ;; -------------------------------------------------------------------------------- @@ -370,12 +381,7 @@ would swap meta and super.") keystr) (kitty-kbp-decode-key-stroke 0 mod suffix))) all-modifiers))) - (mapcar #'car kitty-kbp--suffix-alpha-map))) - - ;; Terminal mouse handling - (define-key keymap "\e[200~" #'xterm-translate-bracketed-paste) - (define-key keymap "\e[I" #'xterm-translate-focus-in) - (define-key keymap "\e[O" #'xterm-translate-focus-out)) + (mapcar #'car kitty-kbp--suffix-alpha-map)))) ;; (setq dum2 (let ((map (make-sparse-keymap))) ;; (kitty-kbp--insert-decode-table map))) diff --git a/lisp/term/xterm-kitty.el b/lisp/term/xterm-kitty.el index c1f79f5..a9b5b25 100644 --- a/lisp/term/xterm-kitty.el +++ b/lisp/term/xterm-kitty.el @@ -52,6 +52,26 @@ function is almost equivalent to 'event-convert-list'." (vector (kitty-kbp--add-modifier-list modifiers key)) default)) +(defun xterm-kitty--handle-escape-code (prompt) + "Handle keycode; PROMPT is ignored" + (let ((keyc (kitty-kbp--handle-escape-code prompt))) + (pcase keyc + (`(200 0 ?~) (xterm-translate-bracketed-paste nil)) + (`(0 0 ?I) (xterm-translate-focus-in nil)) + (`(0 0 ?O) (xterm-translate-focus-out nil)) + ((pred listp) (message "Unknown key: keycode %d, modifiers %d, suffix %s" + (car keyc) (cadr keyc) (string (caddr keyc)))) + (_ keyc)))) + +(defun xterm-kitty--setup-basic-keymap (kmap) + ;; Terminal mouse handling + (define-key kitty-kbp-basic-map "\e[200~" #'xterm-translate-bracketed-paste) + (define-key kitty-kbp-basic-map "\e[I" #'xterm-translate-focus-in) + (define-key kitty-kbp-basic-map "\e[O" #'xterm-translate-focus-out) + ;; (xterm-kitty--insert-decode-table kmap) + ;; (setq input-decode-map kitty-kbp-basic-map) + (xterm--push-map kitty-kbp-basic-map kmap)) + ;; To do: debug the reason that the table method does not work ;; - the table does not seem to be reflected in input-decode-map ;; - the table method is needed for those packages which advice @@ -69,15 +89,10 @@ function is almost equivalent to 'event-convert-list'." key-translation-map)))) (when kmap (unless keymap ; default keymap was used - (message "Applying xterm-kitty changes") - (send-string-to-terminal "\e[>1;u") - (push "\e[>1;u" (terminal-parameter nil 'tty-mode-set-strings)) - (push "\e[<u" (terminal-parameter nil 'tty-mode-reset-strings))) + (kitty-kbp-setup-terminal t)) (if xterm-kitty-use-table-method - ;; (xterm-kitty--insert-decode-table kmap) - (xterm--push-map kitty-kbp-basic-map kmap) - ;; (setq input-decode-map xterm-kitty-basic-map) - (define-key kmap kitty-kbp-escape-prefix #'kitty-kbp--handle-escape-code))) + (xterm-kitty--setup-basic-keymap kmap) + (define-key kmap kitty-kbp-escape-prefix #'xterm-kitty--handle-escape-code))) (when (and alternate-kmap) (xterm--push-map kitty-kbp-legacy-control-map alternate-kmap)))) |