suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Adds auto-completion to LaTeX and TeX inspired keybindings

Browse Source 
original commit: bd0ebc7511c7b66dfdd0b24d68dbe27077a9a7dd
This commit is contained in:
Casey Klein 2010-11-02 22:34:05 -05:00
parent b444c0726d
commit 7c445ec6e4
2 changed files with 41 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/framework/private/keymap.rkt
View File

@ -7,6 +7,7 @@
mzlib/match mzlib/match
"../preferences.ss" "../preferences.ss"
mrlib/tex-table mrlib/tex-table
(only-in srfi/13 string-prefix? string-prefix-length)
"sig.ss") "sig.ss")
(import mred^ (import mred^
@ -984,17 +985,32 @@
[TeX-compress [TeX-compress
(let* ([biggest (apply max (map (λ (x) (string-length (car x))) tex-shortcut-table))]) (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) (λ (text event)
(let ([pos (send text get-start-position)]) (let ([pos (send text get-start-position)])
(when (= pos (send text get-end-position)) (when (= pos (send text get-end-position))
(let ([slash (send text find-string "\\" 'backward pos (max 0 (- pos biggest 1)))]) (let ([slash (send text find-string "\\" 'backward pos (max 0 (- pos biggest 1)))])
(when slash (when slash
(let ([to-replace (assoc (send text get-text slash pos) tex-shortcut-table)]) (define entered (send text get-text slash pos))
(when to-replace (define completions
(send text begin-edit-sequence) (filter (λ (shortcut) (string-prefix? entered (first shortcut)))
(send text delete (- slash 1) pos) tex-shortcut-table))
(send text insert (cadr to-replace)) (unless (empty? completions)
(send text end-edit-sequence)))))))))] (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 "αβγδεζηθι κλμνξοπρςστυφχψω"]
[Greek-letters "ΑΒΓΔΕΖΗΘΙ ΚΛΜΝΞΟΠΡ ΣΤΥΦΧΨΩ"]) ;; don't have a capital ς, just comes out as \u03A2 (or junk) [Greek-letters "ΑΒΓΔΕΖΗΘΙ ΚΛΜΝΞΟΠΡ ΣΤΥΦΧΨΩ"]) ;; don't have a capital ς, just comes out as \u03A2 (or junk)

20
collects/tests/framework/keys.rkt
View File

@ -105,7 +105,25 @@
(make-buff-spec "abc" 2 2) (make-buff-spec "abc" 2 2)
(list '((#\f control)) '((right))) (list '((#\f control)) '((right)))
(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) (define (build-open-bracket-spec str pos char)
(make-key-spec (make-buff-spec str pos pos) (make-key-spec (make-buff-spec str pos pos)