diff --git a/collects/framework/private/keymap.rkt b/collects/framework/private/keymap.rkt index acfbe10d1c..e6e298fded 100644 --- a/collects/framework/private/keymap.rkt +++ b/collects/framework/private/keymap.rkt @@ -7,6 +7,7 @@ mzlib/match "../preferences.ss" mrlib/tex-table + (only-in srfi/13 string-prefix? string-prefix-length) "sig.ss") (import mred^ @@ -984,17 +985,32 @@ [TeX-compress (let* ([biggest (apply max (map (λ (x) (string-length (car x))) tex-shortcut-table))]) + (define (meet s t) + (substring s 0 (string-prefix-length s t 0))) (λ (text event) (let ([pos (send text get-start-position)]) (when (= pos (send text get-end-position)) (let ([slash (send text find-string "\\" 'backward pos (max 0 (- pos biggest 1)))]) (when slash - (let ([to-replace (assoc (send text get-text slash pos) tex-shortcut-table)]) - (when to-replace - (send text begin-edit-sequence) - (send text delete (- slash 1) pos) - (send text insert (cadr to-replace)) - (send text end-edit-sequence)))))))))] + (define entered (send text get-text slash pos)) + (define completions + (filter (λ (shortcut) (string-prefix? entered (first shortcut))) + tex-shortcut-table)) + (unless (empty? completions) + (define-values (replacement partial?) + (let ([complete-match + (findf (λ (shortcut) (equal? entered (first shortcut))) + completions)]) + (if complete-match + (values (second complete-match) #f) + (if (= 1 (length completions)) + (values (second (first completions)) #f) + (let ([tex-names (map first completions)]) + (values (foldl meet (first tex-names) (rest tex-names)) #t)))))) + (send text begin-edit-sequence) + (send text delete (if partial? slash (- slash 1)) pos) + (send text insert replacement) + (send text end-edit-sequence))))))))] [greek-letters "αβγδεζηθι κλμνξοπρςστυφχψω"] [Greek-letters "ΑΒΓΔΕΖΗΘΙ ΚΛΜΝΞΟΠΡ ΣΤΥΦΧΨΩ"]) ;; don't have a capital ς, just comes out as \u03A2 (or junk) diff --git a/collects/scribblings/drracket/keybindings.scrbl b/collects/scribblings/drracket/keybindings.scrbl index 8b6f3053b2..6b32c6949b 100644 --- a/collects/scribblings/drracket/keybindings.scrbl +++ b/collects/scribblings/drracket/keybindings.scrbl @@ -175,8 +175,14 @@ as the @tech{definitions window} plus a few more: @itemize[ @keybinding['("C-\\" "M-\\")]{traces backwards from the insertion -point, looking for a backslash followed by a @index["LaTeX"]{LaTeX} macro name; if one is -found, it replaces the backslash and the macro's name with the keybinding. +point, looking for a backslash followed by a @index["LaTeX"]{LaTeX} +macro name or a prefix of such a name. If a macro name is found, +it replaces the backslash and the name with the corresponding key in +the table below; if a (proper) prefix @math{p} is found, it replaces @math{p} +with the longest common prefix of all macro names that have @math{p} as a +prefix (unless there is only one such name, in which case it behaves as if +@math{p} were a complete macro name). + These are the currently supported macro names and the keys they map into: @(make-table '() diff --git a/collects/tests/framework/keys.rkt b/collects/tests/framework/keys.rkt index 6ba89dec0b..2ff6c5fa50 100644 --- a/collects/tests/framework/keys.rkt +++ b/collects/tests/framework/keys.rkt @@ -105,7 +105,25 @@ (make-buff-spec "abc" 2 2) (list '((#\f control)) '((right))) (list '((#\f control)) '((right))) - (list '((#\f control)) '((right)))))) + (list '((#\f control)) '((right)))) + + ;; TeX-compress tests + (make-key-spec/allplatforms + (make-buff-spec "\\ome" 4 4) + (make-buff-spec "ω" 1 1) + '(((#\\ control)))) + (make-key-spec/allplatforms + (make-buff-spec "\\sub" 4 4) + (make-buff-spec "\\subset" 7 7) + '(((#\\ control)))) + (make-key-spec/allplatforms + (make-buff-spec "\\subset" 7 7) + (make-buff-spec "⊂" 1 1) + '(((#\\ control)))) + (make-key-spec/allplatforms + (make-buff-spec "\\sub" 4 4) + (make-buff-spec "⊆" 1 1) + '(((#\\ control) (#\e) (#\\ control)))))) (define (build-open-bracket-spec str pos char) (make-key-spec (make-buff-spec str pos pos)