diff --git a/kitty-key.json b/kitty-key.json new file mode 100644 index 0000000..939ead6 --- /dev/null +++ b/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" +} diff --git a/kitty.rkt b/kitty.rkt index 97ab3ad..1a9d928 100644 --- a/kitty.rkt +++ b/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) diff --git a/lux-chaos.rkt b/lux-chaos.rkt index 417e3fe..1336d3c 100644 --- a/lux-chaos.rkt +++ b/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))]) diff --git a/t/key.rkt b/t/key.rkt index cf3d008..7ec45cf 100644 --- a/t/key.rkt +++ b/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."))