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

Rackety: shrink max linewidth to below 102

Browse Source
This commit is contained in:
Robby Findler 2013-06-22 15:31:30 -05:00
parent a8473ec1aa
commit 2a644957c2
1 changed files with 50 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
pkgs/gui-pkgs/gui-lib/framework/private/keymap.rkt
View File

@ -165,30 +165,32 @@
table) table)
(define/private (on-this-platform? cs) (define/private (on-this-platform? cs)
(let* ([splits (map (λ (x) (all-but-last (split-out #\: x))) (split-out #\; (string->list cs)))] (define splits
[has-key? (λ (k) (ormap (λ (x) (member (list k) x)) splits))]) (for/list ([x (in-list (split-out #\; (string->list cs)))])
(cond (all-but-last (split-out #\: x))))
[(eq? (system-type) 'windows) (define (has-key? k) (ormap (λ (x) (member (list k) x)) splits))
(cond (cond
[(or (regexp-match #rx"a:c" cs) [(eq? (system-type) 'windows)
(regexp-match #rx"c:m" cs)) (cond
#f] [(or (regexp-match #rx"a:c" cs)
[(or (has-key? #\a) (has-key? #\d)) (regexp-match #rx"c:m" cs))
#f] #f]
[else #t])] [(or (has-key? #\a) (has-key? #\d))
[(eq? (system-type) 'macosx) #f]
(cond [else #t])]
[(has-key? #\m) [(eq? (system-type) 'macosx)
#f] (cond
[else #t])] [(has-key? #\m)
[(eq? (system-type) 'unix) #f]
(cond [else #t])]
[(or (has-key? #\a) (has-key? #\d)) [(eq? (system-type) 'unix)
#f] (cond
[else #t])] [(or (has-key? #\a) (has-key? #\d))
[else #f]
;; just in case new platforms come along .... [else #t])]
#t]))) [else
;; just in case new platforms come along ....
#t]))
(define/private (all-but-last l) (define/private (all-but-last l)
(cond (cond
@ -962,29 +964,30 @@
(define (meet s t) (define (meet s t)
(substring s 0 (string-prefix-length s t 0))) (substring s 0 (string-prefix-length s t 0)))
(λ (text event) (λ (text event)
(let ([pos (send text get-start-position)]) (define 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)))]) (define slash (send text find-string "\\" 'backward pos (max 0 (- pos biggest 1))))
(when slash (when slash
(define entered (send text get-text slash pos)) (define entered (send text get-text slash pos))
(define completions (define completions
(filter (λ (shortcut) (string-prefix? entered (first shortcut))) (filter (λ (shortcut) (string-prefix? entered (first shortcut)))
tex-shortcut-table)) tex-shortcut-table))
(unless (empty? completions) (unless (empty? completions)
(define-values (replacement partial?) (define-values (replacement partial?)
(let ([complete-match (let ([complete-match
(findf (λ (shortcut) (equal? entered (first shortcut))) (findf (λ (shortcut) (equal? entered (first shortcut)))
completions)]) completions)])
(if complete-match (if complete-match
(values (second complete-match) #f) (values (second complete-match) #f)
(if (= 1 (length completions)) (if (= 1 (length completions))
(values (second (first completions)) #f) (values (second (first completions)) #f)
(let ([tex-names (map first completions)]) (let ([tex-names (map first completions)])
(values (foldl meet (first tex-names) (rest tex-names)) #t)))))) (values (foldl meet (first tex-names) (rest tex-names))
(send text begin-edit-sequence) #t))))))
(send text delete (if partial? slash (- slash 1)) pos) (send text begin-edit-sequence)
(send text insert replacement) (send text delete (if partial? slash (- slash 1)) pos)
(send text end-edit-sequence))))))))] (send text insert replacement)
(send text end-edit-sequence))))))]
[greek-letters "αβγδεζηθι κλμνξοπρςστυφχψω"] [greek-letters "αβγδεζηθι κλμνξοπρςστυφχψω"]
[Greek-letters "ΑΒΓΔΕΖΗΘΙ ΚΛΜΝΞΟΠΡ ΣΤΥΦΧΨΩ"] [Greek-letters "ΑΒΓΔΕΖΗΘΙ ΚΛΜΝΞΟΠΡ ΣΤΥΦΧΨΩ"]