kitty input

kitty-key.json

@@ -0,0 +1,121 @@
+{
+  "0": "G",
+  "1": "H",
+  "2": "I",
+  "3": "J",
+  "4": "K",
+  "5": "L",
+  "6": "M",
+  "7": "N",
+  "8": "O",
+  "9": "P",
+  "A": "S",
+  "'": "B",
+  "B": "T",
+  "C": "U",
+  ",": "C",
+  "D": "V",
+  "E": "W",
+  "=": "R",
+  "F": "X",
+  "f1": "/",
+  "f10": "]",
+  "f11": "{",
+  "f12": "}",
+  "f13": "@",
+  "f14": "%",
+  "f15": "$",
+  "f16": "#",
+  "f17": "BA",
+  "f18": "BB",
+  "f19": "BC",
+  "f2": "*",
+  "f20": "BD",
+  "f21": "BE",
+  "f22": "BF",
+  "f23": "BG",
+  "f24": "BH",
+  "f25": "BI",
+  "f3": "?",
+  "f4": "&",
+  "f5": "<",
+  "f6": ">",
+  "f7": "(",
+  "f8": ")",
+  "f9": "[",
+  "G": "Y",
+  "`": "v",
+  "H": "Z",
+  "home": ".",
+  "I": "a",
+  "insert": "2",
+  "J": "b",
+  "K": "c",
+  "kp0": "BJ",
+  "kp1": "BK",
+  "kp2": "BL",
+  "kp3": "BM",
+  "kp4": "BN",
+  "kp5": "BO",
+  "kp6": "BP",
+  "kp7": "BQ",
+  "kp8": "BR",
+  "kp9": "BS",
+  "kp+": "BX",
+  "kp.": "BT",
+  "kp/": "BU",
+  "kpret": "BY",
+  "kp=": "BZ",
+  "kp*": "BV",
+  "kp-": "BW",
+  "L": "d",
+  "left": "5",
+  "left-alt": "Bc",
+  "[": "s",
+  "left-ctrl": "Bb",
+  "left-shift": "Ba",
+  "left-super": "Bd",
+  "M": "e",
+  "-": "D",
+  "N": "f",
+  "numlock": "=",
+  "O": "g",
+  "P": "h",
+  "page-down": "9",
+  "page-up": "8",
+  "pause": "!",
+  ".": "E",
+  "print-screen": "^",
+  "Q": "i",
+  "R": "j",
+  "right": "4",
+  "right-alt": "Bg",
+  "]": "u",
+  "right-ctrl": "Bf",
+  "right-shift": "Be",
+  "right-super": "Bh",
+  "S": "k",
+  "scroll-lock": "+",
+  ";": "Q",
+  "/": "F",
+  " ": "A",
+  "T": "l",
+  "tab": "0",
+  "U": "m",
+  "up": "7",
+  "V": "n",
+  "W": "o",
+  "world1": "w",
+  "world2": "x",
+  "X": "p",
+  "Y": "q",
+    "Z": "r",
+  "\\": "t",
+  "backspace": "1",
+  "caps-lock": ":",
+  "delete": "3",
+  "down": "6",
+  "end": "-",
+  "return": "z",
+  "esc": "y"
+}

kitty.rkt

@@ -1,5 +1,8 @@
 #lang racket/base
 (require racket/match
+         racket/set
+         racket/runtime-path
+         json
          (prefix-in pict: pict)
          file/convertible
          racket/class
@@ -15,9 +18,12 @@
 ;; with
 ;; "racket -I raart/kitty-init -i -t file -e '(exit 0)'"
 
-(define (install-kitty-print!)
+(define (term-is-kitty?)
   (define t (environment-variables-ref (current-environment-variables) #"TERM"))
-  (when (equal? t #"xterm-kitty")
+  (equal? t #"xterm-kitty"))
+
+(define (install-kitty-print!)  
+  (when (term-is-kitty?)
     ;; XXX This could do better and use
     #;(pretty-print-size-hook)
     ;; and
@@ -50,4 +56,28 @@
         [v (old-print v)]))
     (current-print new-print)))
 
-(provide install-kitty-print!)
+(define-runtime-path kk.j "kitty-key.json")
+(define kk-ht
+  (for/hash ([(s e) (in-hash (with-input-from-file kk.j read-json))])
+    (define o (symbol->string s))
+    (values (string->bytes/utf-8 e)
+            (cond
+              [(= 1 (string-length o))
+               (string-ref o 0)]
+              [else o]))))
+(define (kitty-key-lookup k)
+  (hash-ref kk-ht k (λ () k)))
+
+(define (kitty-mods-lookup mb)
+  (define mn
+    (- (bytes-ref mb 0) (char->integer #\A)))
+  (for/fold ([s (seteq)])
+            ([m (in-list '(shift meta control super))]
+             [i (in-list '(1 2 4 8))])
+    (if (zero? (bitwise-and mn i)) s
+        (set-add s m))))
+
+(provide install-kitty-print!
+         term-is-kitty?
+         kitty-key-lookup
+         kitty-mods-lookup)

lux-chaos.rkt

@@ -5,13 +5,15 @@
          racket/set
          racket/async-channel
          racket/system
+         net/base64
          ansi
          unix-signals
          lux/chaos
          raart/draw
          raart/buffer
          (submod raart/buffer internal)
-         struct-define)
+         struct-define
+         "kitty.rkt")
 
 (struct term (f in out))
 
@@ -70,7 +72,8 @@
 (define (convert-key v)
   (match v
     [(key value mods)
-     (format "~a~a~a~a"
+     (format "~a~a~a~a~a"
+             (if (set-member? mods 'super) "s-" "")
              (if (set-member? mods 'meta) "M-" "")
              (if (set-member? mods 'control) "C-" "")
              (if (set-member? mods 'shift) "S-" "")
@@ -111,7 +114,10 @@
      (set! cols 80)
      (set! buf (make-cached-buffer rows cols #:output (term-out t)))
 
-     ;; Save the current title
+     ;; Save the current title and colors
+     (when (term-is-kitty?)
+       (display/term t "\e[?2017h")
+       (display/term t "\e]30001\e\\"))
      (display/term t "\e[22t")
 
      ;; Initialize term
@@ -127,8 +133,25 @@
      (set! input-th
            (thread
             (λ ()
+              (define iport (term-in t))
+              (define (std-lex1)
+                (lex-lcd-input iport #:utf-8? #t))
+              (define (kitty-lex1)
+                (cond
+                  [(regexp-try-match #rx#"^\e_K([prt])(.)(..?)\e\\\\" iport)
+                   => (match-lambda
+                        [(list lexeme type mods-b64 key-b64)
+                         (cond
+                           [(bytes=? type #"p")
+                            (key (kitty-key-lookup key-b64)
+                                 (kitty-mods-lookup mods-b64))]
+                           [else
+                            (kitty-lex1)])])]
+                  [else
+                   (std-lex1)]))
+              (define lex1 (if (term-is-kitty?) kitty-lex1 std-lex1))
               (let loop ()
-                (define v (lex-lcd-input (term-in t) #:utf-8? #t))
+                (define v (lex1))
                 (unless (eof-object? v)
                   (when (or (any-mouse-event? v)
                             (screen-size-report? v)
@@ -166,6 +189,9 @@
 
      ;; Restore the old title
      (display/term t "\e[23t")
+     (when (term-is-kitty?)
+       (display/term t "\e]30101\e\\")
+       (display/term t "\e[?2017l"))
 
      (close-term t))])
 

t/key.rkt

@@ -13,7 +13,7 @@
           #:output (text (~a k))
           #:event
           (match-lambda
-            ["q" #f]
+            [(or "C-C" "q") #f]
             [x (show-key x)])))
 
   (show-key "Please enter a key."))