Fix key-chords (case-insensitive) and top coreutils registration
ober
9d0ae141a78945c474c952bb25c32aa15b6da1d3
--- a/lib/jerboa-emacs/qt/commands-shell.sls +++ b/lib/jerboa-emacs/qt/commands-shell.sls @@ -68,8 +68,9 @@ *abbrevs-path* abbrevs-save! abbrevs-load! cmd-abbrev-mode cmd-define-abbrev cmd-delete-horizontal-space cmd-consult-line cmd-consult-grep cmd-consult-buffer - cmd-consult-outline *top-buffer-name* *top-active* - top-capture-output top-refresh! cmd-top cmd-top-quit) + cmd-consult-outline *top-buffer-name* *coreutils-registered* + *top-active* ensure-coreutils! top-capture-output + top-refresh! cmd-top cmd-top-quit) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -2152,9 +2153,22 @@ (qt-plain-text-edit-ensure-cursor-visible! ed)))))))))) (define *top-buffer-name*--cell (vector "*top*")) + (define *coreutils-registered*--cell (vector #f)) (define *top-active*--cell (vector #f)) + (def (ensure-coreutils!) + "Lazily register coreutils builtins on first use.\n Uses eval to avoid a compile-time dependency on (jsh coreutils)\n which requires jerboa-coreutils (not available in Docker builds)." + (unless *coreutils-registered* + (with-catch + (lambda (e) #f) + (lambda () + (eval + '(begin + (import (only (jsh coreutils) register-coreutils!)) + (register-coreutils!))) + (set! *coreutils-registered* #t))))) (def (top-capture-output) "Run coreutils top in batch mode (-b -n 1) and capture output as a string.\n Uses builtin-lookup to get the jsh-registered handler." + (ensure-coreutils!) (let ([handler (builtin-lookup "top")]) (if handler (let ([output (with-output-to-string @@ -2164,7 +2178,7 @@ (lambda () (handler '("-b" "-n" "1") #f)))))]) output) - "top: command not available (coreutils not registered)\n"))) + "top: command not available (coreutils not installed)\n"))) (def (top-refresh! app) "Refresh the *top* buffer with current coreutils top output." (let* ([ed (current-qt-editor app)] @@ -2350,6 +2364,13 @@ *top-buffer-name*--cell 0 val)])) + (define-syntax *coreutils-registered* + (identifier-syntax + [id (vector-ref *coreutils-registered*--cell 0)] + [(set! id val) (vector-set! + *coreutils-registered*--cell + 0 + val)])) (define-syntax *top-active* (identifier-syntax [id (vector-ref *top-active*--cell 0)] --- a/src/jerboa-emacs/core.ss +++ b/src/jerboa-emacs/core.ss @@ -2182,26 +2182,35 @@ (def (key-chord-define-global two-char-str cmd) "Bind a 2-character chord to a command symbol. - Case-sensitive: 'MT' only matches Shift+M then Shift+T, not lowercase. + Case-insensitive: 'MT' matches mt, Mt, mT, and MT. Like Emacs key-chord.el, registers BOTH orderings so the chord fires regardless of which key arrives first (e.g. 'MT' matches M→T and T→M)." - (let ((c1 (string-ref two-char-str 0)) - (c2 (string-ref two-char-str 1))) - ;; Register both orderings - (hash-put! *chord-map* (string c1 c2) cmd) - (when (not (char=? c1 c2)) - (hash-put! *chord-map* (string c2 c1) cmd)) - ;; Both characters can start a chord - (hash-put! *chord-first-chars* c1 #t) - (hash-put! *chord-first-chars* c2 #t))) + (let* ((c1 (string-ref two-char-str 0)) + (c2 (string-ref two-char-str 1)) + ;; All case variants of each character + (c1s (if (char-alphabetic? c1) + (list (char-upcase c1) (char-downcase c1)) + (list c1))) + (c2s (if (char-alphabetic? c2) + (list (char-upcase c2) (char-downcase c2)) + (list c2)))) + ;; Register all case combinations in both orderings + (for-each (lambda (a) + (for-each (lambda (b) + (hash-put! *chord-map* (string a b) cmd) + (when (not (char=? a b)) + (hash-put! *chord-map* (string b a) cmd)) + (hash-put! *chord-first-chars* a #t) + (hash-put! *chord-first-chars* b #t)) + c2s)) + c1s))) (def (chord-lookup ch1 ch2) - "Look up a chord by two characters. Case-sensitive match." + "Look up a chord by two characters." (hash-get *chord-map* (string ch1 ch2))) (def (chord-start-char? ch) - "Can this character start a chord? Only when chord-mode is on. - Case-sensitive: uppercase chord starters only match uppercase input." + "Can this character start a chord? Only when chord-mode is on." (and *chord-mode* (hash-get *chord-first-chars* ch))) --- a/src/jerboa-emacs/qt/commands-shell.ss +++ b/src/jerboa-emacs/qt/commands-shell.ss @@ -1849,11 +1849,26 @@ SPC = page down, DEL = page up, q = quit view-mode." ;;;============================================================================ (def *top-buffer-name* "*top*") +(def *coreutils-registered* #f) (def *top-active* #f) ;; the app when top is running, or #f +(def (ensure-coreutils!) + "Lazily register coreutils builtins on first use. + Uses eval to avoid a compile-time dependency on (jsh coreutils) + which requires jerboa-coreutils (not available in Docker builds)." + (unless *coreutils-registered* + (with-catch + (lambda (e) #f) ;; silently fail if coreutils not available + (lambda () + (eval '(begin + (import (only (jsh coreutils) register-coreutils!)) + (register-coreutils!))) + (set! *coreutils-registered* #t))))) + (def (top-capture-output) "Run coreutils top in batch mode (-b -n 1) and capture output as a string. Uses builtin-lookup to get the jsh-registered handler." + (ensure-coreutils!) (let ((handler (builtin-lookup "top"))) (if handler (let ((output (with-output-to-string @@ -1862,7 +1877,7 @@ SPC = page down, DEL = page up, q = quit view-mode." (lambda (e) (display "top: error\n")) (lambda () (handler '("-b" "-n" "1") #f))))))) output) - "top: command not available (coreutils not registered)\n"))) + "top: command not available (coreutils not installed)\n"))) (def (top-refresh! app) "Refresh the *top* buffer with current coreutils top output."