Adds auto-completion to LaTeX and TeX inspired keybindings

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) 

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
   '()

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)