More complete implementation of tables

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))