Enforce exact-case key chords
ober
05e9007b4728095c940e34eebadd5c4f152aa91c
--- a/lib/jerboa-emacs/qt/app.sls +++ b/lib/jerboa-emacs/qt/app.sls @@ -2635,6 +2635,7 @@ (cons '*chord-map* *chord-map*) (cons '*chord-mode* *chord-mode*) (cons '*chord-timeout* *chord-timeout*) + (cons 'key-chord-define-global key-chord-define-global) (cons 'chord-start-char? chord-start-char?) (cons 'chord-lookup chord-lookup) (cons 'chord-pending-char (lambda () *chord-pending-char*)) --- a/lib/jerboa-emacs/qt/commands-aliases.sls +++ b/lib/jerboa-emacs/qt/commands-aliases.sls @@ -1963,10 +1963,7 @@ (key-chord-define-global chord-str sym) (echo-message! (app-state-echo app) - (string-append - (string-upcase chord-str) - " → " - cmd-name))) + (string-append chord-str " → " cmd-name))) (echo-error! (app-state-echo app) (string-append "Unknown command: " cmd-name))))))))) --- a/src/jerboa-emacs/qt/app.ss +++ b/src/jerboa-emacs/qt/app.ss @@ -2028,6 +2028,7 @@ (cons '*chord-map* *chord-map*) (cons '*chord-mode* *chord-mode*) (cons '*chord-timeout* *chord-timeout*) + (cons 'key-chord-define-global key-chord-define-global) (cons 'chord-start-char? chord-start-char?) (cons 'chord-lookup chord-lookup) ;; Chord state accessors (live values, not frozen snapshots) --- a/src/jerboa-emacs/qt/commands-aliases.ss +++ b/src/jerboa-emacs/qt/commands-aliases.ss @@ -1401,7 +1401,7 @@ (begin (key-chord-define-global chord-str sym) (echo-message! (app-state-echo app) - (string-append (string-upcase chord-str) " → " cmd-name))) + (string-append chord-str " → " cmd-name))) (echo-error! (app-state-echo app) (string-append "Unknown command: " cmd-name))))))))) --- a/tests/test-core.ss +++ b/tests/test-core.ss @@ -172,8 +172,10 @@ (display "--- key-chord ---\n") (key-chord-define-global "jk" 'keyboard-quit) (check (chord-lookup #\j #\k) => 'keyboard-quit) -(check (chord-lookup #\J #\K) => 'keyboard-quit) +(check (chord-lookup #\k #\j) => 'keyboard-quit) +(check (chord-lookup #\J #\K) => #f) (check-true (chord-start-char? #\j)) +(check-false (chord-start-char? #\J)) (check-false (chord-start-char? #\z)) ;;; --- Repeat mode --- --- a/tests/test-functional.ss +++ b/tests/test-functional.ss @@ -1582,7 +1582,7 @@ ;;; Key Chord Tests ;;;============================================================================ -(display "\n--- key-chord: case-insensitive registration ---\n") +(display "\n--- key-chord: exact-case registration ---\n") ;; Clear chord state (set! *chord-map* (make-hash-table)) (set! *chord-first-chars* (make-hash-table)) @@ -1590,11 +1590,11 @@ ;; Define a chord with uppercase letters (key-chord-define-global "EE" 'eshell) -;; Test: all case combinations should resolve to the same command +;; Test: only exact case resolves to the command (check (chord-lookup #\E #\E) => 'eshell) -(check (chord-lookup #\e #\e) => 'eshell) -(check (chord-lookup #\E #\e) => 'eshell) -(check (chord-lookup #\e #\E) => 'eshell) +(check (chord-lookup #\e #\e) => #f) +(check (chord-lookup #\E #\e) => #f) +(check (chord-lookup #\e #\E) => #f) (display "--- key-chord: both orderings registered ---\n") (set! *chord-map* (make-hash-table)) @@ -1602,24 +1602,26 @@ (key-chord-define-global "MT" 'vterm) ;; Both orderings: M→T and T→M -(check (chord-lookup #\m #\t) => 'vterm) -(check (chord-lookup #\t #\m) => 'vterm) (check (chord-lookup #\M #\T) => 'vterm) (check (chord-lookup #\T #\M) => 'vterm) +(check (chord-lookup #\m #\t) => #f) +(check (chord-lookup #\t #\m) => #f) +(check (chord-lookup #\M #\t) => #f) +(check (chord-lookup #\t #\M) => #f) (display "--- key-chord: start-char detects both chars ---\n") -(check (chord-start-char? #\m) => #t) -(check (chord-start-char? #\t) => #t) (check (chord-start-char? #\M) => #t) (check (chord-start-char? #\T) => #t) +(check (chord-start-char? #\m) => #f) +(check (chord-start-char? #\t) => #f) (check (chord-start-char? #\z) => #f) (display "--- key-chord: same-char chord ---\n") (set! *chord-map* (make-hash-table)) (set! *chord-first-chars* (make-hash-table)) (key-chord-define-global "GG" 'keyboard-quit) -(check (chord-lookup #\g #\g) => 'keyboard-quit) (check (chord-lookup #\G #\G) => 'keyboard-quit) +(check (chord-lookup #\g #\g) => #f) (display "--- key-chord: non-alpha chars ---\n") (set! *chord-map* (make-hash-table)) @@ -1634,12 +1636,15 @@ (key-chord-define-global "EE" 'eshell) (key-chord-define-global "MT" 'vterm) (key-chord-define-global "GG" 'keyboard-quit) -(check (chord-lookup #\e #\e) => 'eshell) -(check (chord-lookup #\m #\t) => 'vterm) -(check (chord-lookup #\g #\g) => 'keyboard-quit) +(check (chord-lookup #\E #\E) => 'eshell) +(check (chord-lookup #\M #\T) => 'vterm) +(check (chord-lookup #\G #\G) => 'keyboard-quit) ;; Non-chord pairs should return #f -(check (chord-lookup #\e #\m) => #f) -(check (chord-lookup #\g #\t) => #f) +(check (chord-lookup #\E #\M) => #f) +(check (chord-lookup #\G #\T) => #f) +(check (chord-lookup #\e #\e) => #f) +(check (chord-lookup #\m #\t) => #f) +(check (chord-lookup #\g #\g) => #f) ;;;============================================================================ ;;; Coreutils Top Tests --- a/tests/test-qt-functional.sh +++ b/tests/test-qt-functional.sh @@ -160,9 +160,9 @@ sleep 0.3 # --- Tests --- echo "--- Text insertion ---" -# Use chars that are NOT chord-start characters to avoid chord pending delay -# Chord-start chars cover: A B C E F G I J K L M N O R S T V W X Z -# Safe chars: d h p q u y +# Use chars that are NOT chord-start characters to avoid chord pending delay. +# Chord-start chars are exact-case; uppercase user chords do not reserve +# lowercase letters. send_type "dhp" sleep 0.5 AFTER_TEXT=$(get_text) @@ -224,10 +224,25 @@ send_key ctrl+shift+k sleep 0.2 echo "" -echo "--- Key chord TM → vterm ---" +echo "--- Key chord exact-case guard ---" go_scratch sleep 0.3 +repl '(key-chord-define-global "TM" (quote vterm))' >/dev/null 2>&1 send_key --delay 20 t m +sleep 0.5 +BUF=$(get_buffer) +assert_not_contains "lowercase tm does not trigger uppercase TM" "terminal" "$BUF" +send_key ctrl+a +sleep 0.1 +send_key ctrl+shift+k +sleep 0.2 + +echo "" +echo "--- Key chord TM → vterm ---" +go_scratch +sleep 0.3 +repl '(key-chord-define-global "TM" (quote vterm))' >/dev/null 2>&1 +send_key --delay 20 T M sleep 0.8 BUF=$(get_buffer) assert_contains "chord TM triggers vterm (switches to terminal)" "terminal" "$BUF" @@ -238,7 +253,7 @@ CHORD_PASS=0 for i in $(seq 1 5); do go_scratch sleep 0.3 - send_key --delay 30 t m + send_key --delay 30 T M sleep 0.5 BUF=$(get_buffer) if echo "$BUF" | grep -q "terminal"; then