diff options
Diffstat (limited to 'lisp/term')
| -rw-r--r-- | lisp/term/xterm-kitty.el | 133 |
1 files changed, 120 insertions, 13 deletions
diff --git a/lisp/term/xterm-kitty.el b/lisp/term/xterm-kitty.el index c696cd0..e08d358 100644 --- a/lisp/term/xterm-kitty.el +++ b/lisp/term/xterm-kitty.el @@ -135,6 +135,7 @@ would swap meta and super.") (?B . down) (?C . right) (?D . left) + ;; (?E . kp-begin) (?F . end) (?H . home) (?P . f1) @@ -152,6 +153,76 @@ would swap meta and super.") ,@(mapcar #'car xterm-kitty-shift-alist)) "All characters in non-private unicode space") +(defvar xterm-kitty--suffix-u-private + `(,@(mapcar (lambda (n) (cons (+ n (- 57376 13)) (intern (format "f%d" n)))) + (number-sequence 13 35)) + ,@(mapcar (lambda (n) (cons (+ 57399 n) (intern (format "kp-%d" n)))) + (number-sequence 0 9)) + (57409 . kp-decimal) + (57410 . kp-divide) + (57411 . kp-multiply) + (57412 . kp-subtract) + (57413 . kp-add) + (57414 . kp-enter) + (57415 . kp-equal) + (57416 . kp-separator) + (57417 . kp-left) + (57418 . kp-right) + (57419 . kp-up) + (57420 . kp-down) + (57421 . kp-prior) + (57422 . kp-next) + (57423 . kp-home) + (57424 . kp-end) + (57425 . kp-insert) + (57426 . kp-delete) + (57427 . kp-begin)) + "Entries with unicode private area mapping") +(defvar xterm-kitty--suffix-u-private-bounds + (let ((codes (mapcar #'car xterm-kitty--suffix-u-private))) + (vector (apply #'min codes) (apply #'max codes))) + "Bounds of private area unicode keycodes") + +(defvar xterm-kitty--suffix-u-private-precomputed + (apply #'vector + (mapcar + (lambda (n) + (when-let (key (alist-get n xterm-kitty--suffix-u-private)) + (xterm-kitty--precompute-with-modifiers key))) + (number-sequence + (aref xterm-kitty--suffix-u-private-bounds 0) + (aref xterm-kitty--suffix-u-private-bounds 1)) + )) + "Precomputed vectors for unicode private area mapping.") + +(defvar xterm-kitty--suffix-u-private-unsupported + '((57428 . media-play ) + (57429 . media-pause ) + (57430 . media-play-pause ) + (57431 . media-reverse ) + (57432 . media-stop ) + (57433 . media-fast-forward ) + (57434 . media-rewind ) + (57435 . media-track-next ) + (57436 . media-track-previous ) + (57437 . media-record ) + (57438 . lower-volume ) + (57439 . raise-volume ) + (57440 . mute-volume ) + (57441 . left-shift ) + (57442 . left-control ) + (57443 . left-alt ) + (57444 . left-super ) + (57445 . left-hyper ) + (57446 . left-meta ) + (57447 . right-shift ) + (57448 . right-control ) + (57449 . right-alt ) + (57450 . right-super ) + (57451 . right-hyper ) + (57452 . right-meta )) + "Entries with unicode private area mapping without emacs equivalents") + (defconst xterm-kitty--shift-modifier (car (rassoc 'shift xterm-kitty-modifiers-alist)) "Value of the shift modifier.") @@ -167,10 +238,9 @@ would swap meta and super.") (let ((keystr (format "%d" key))) (mapc (lambda (mod) - (unless (zerop mod) - (define-key keymap - (concat xterm-kitty-escape-prefix keystr (aref all-mod-suffixes mod) "u") - (xterm-kitty-decode-key-stroke key mod ?u)))) + (define-key keymap + (concat xterm-kitty-escape-prefix keystr (aref all-mod-suffixes mod) "u") + (xterm-kitty-decode-key-stroke key mod ?u))) all-modifiers))) xterm-kitty--suffix-u-non-private) (mapc @@ -179,23 +249,41 @@ would swap meta and super.") (mapc (lambda (mod) (define-key keymap + (concat xterm-kitty-escape-prefix keystr (aref all-mod-suffixes mod) "u") + nil)) + all-modifiers))) + (mapcar #'car xterm-kitty--suffix-u-private-unsupported)) + (mapc + (lambda (key) + (let ((keystr (format "%d" key))) + (mapc + (lambda (mod) + (define-key keymap (concat xterm-kitty-escape-prefix keystr (aref all-mod-suffixes mod) "~") (xterm-kitty-decode-key-stroke key mod ?~))) all-modifiers))) (mapcar #'car xterm-kitty--suffix-tilde-map)) (mapc (lambda (suffix) - (let ((keystr (format "%d" suffix))) + (let ((keystr (char-to-string suffix))) + ;; If we let kitty send legacy escape codes, we will need the following: + ;; (define-key keymap (concat "\eO" keystr) + ;; (xterm-kitty-decode-key-stroke 0 0 suffix)) (mapc (lambda (mod) (define-key keymap (concat xterm-kitty-escape-prefix (if (zerop mod) "" "1") (aref all-mod-suffixes mod) - (string suffix)) + keystr) (xterm-kitty-decode-key-stroke 0 mod suffix))) all-modifiers))) - (mapcar #'car xterm-kitty--suffix-alpha-map)))) + (mapcar #'car xterm-kitty--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)) ;; (setq dum2 (let ((map (make-sparse-keymap))) ;; (xterm-kitty--insert-decode-table map))) @@ -207,7 +295,7 @@ would swap meta and super.") ;; Ignore modifiers that we cannot understand (CapsLock and NumLock status) (let ((mods (logand modifiers (1- (length xterm-kitty--numeric-modifiers))))) (if (eql suffix ?u) - (when (< keycode 57344) + (if (< keycode 57344) ;; To do: support remaining keycodes in unicode private use area ;; (send-string-to-terminal (format "%s" (logior keycode (aref xterm-kitty--numeric-modifiers mods)))) (let* ((shifted-key (and (eql (logand mods xterm-kitty--shift-modifier) @@ -216,7 +304,14 @@ would swap meta and super.") ;; The following is equivalent to mods & ~shift (new-modifiers (and shifted-key (- mods xterm-kitty--shift-modifier)))) (vector (logior (or shifted-key keycode) - (aref xterm-kitty--numeric-modifiers (if shifted-key new-modifiers mods)))))) + (aref xterm-kitty--numeric-modifiers (if shifted-key new-modifiers mods))))) + (when (<= + (aref xterm-kitty--suffix-u-private-bounds 0) + keycode + (aref xterm-kitty--suffix-u-private-bounds 1)) + (aref (aref xterm-kitty--suffix-u-private-precomputed + (- keycode (aref xterm-kitty--suffix-u-private-bounds 0))) + mods))) (if (eql suffix ?~) (if (eql keycode 200) (xterm-translate-bracketed-paste nil) @@ -276,7 +371,7 @@ would swap meta and super.") ;; (message "Code: %d modifiers %d suffix: %s" keycode modifiers suffix) (xterm-kitty-decode-key-stroke keycode modifiers suffix))) -(defvar xterm-kitty-legacy-control-map +(defvar xterm-kitty-legacy-control-mapping '(;(?\@ . 0) (?a . 1) (?b . 2) @@ -345,7 +440,17 @@ would swap meta and super.") (define-key keymap (vector (xterm-kitty--add-modifier-list '(control meta) (car bind))) (vector (xterm-kitty--add-modifier-list '(meta) (cdr bind))))) - xterm-kitty-legacy-control-map)) + xterm-kitty-legacy-control-mapping)) +(defvar xterm-kitty-legacy-control-map + (let ((map (make-sparse-keymap))) + (xterm-kitty--setup-legacy-control-maps map) + map) + "Legacy control and control-meta remapping for shifted versions") +(defvar xterm-kitty-basic-map + (let ((map (make-sparse-keymap))) + (xterm-kitty--insert-decode-table map) + map) + "Basic decode map for kitty") (defun xterm-kitty-make-binding-sequence (default key &rest modifiers) "Make a key vector for KEY with VECTORS suitable for binding with 'define-key' if xterm-kitty is active. @@ -385,10 +490,12 @@ function is almost equivalent to 'event-convert-list'." (push "\e[>1;u" (terminal-parameter nil 'tty-mode-set-strings)) (push "\e[<u" (terminal-parameter nil 'tty-mode-reset-strings))) (if xterm-kitty-use-table-method - (xterm-kitty--insert-decode-table kmap) + ;; (xterm-kitty--insert-decode-table kmap) + (xterm--push-map xterm-kitty-basic-map kmap) + ;; (setq input-decode-map xterm-kitty-basic-map) (define-key kmap xterm-kitty-escape-prefix #'xterm-kitty--handle-escape-code))) (when (and alternate-kmap) - (xterm-kitty--setup-legacy-control-maps alternate-kmap)))) + (xterm--push-map xterm-kitty-legacy-control-map alternate-kmap)))) (defun xterm-kitty-window-id (&optional terminal) ; public API (terminal-parameter terminal 'kitty-window-id)) |