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

fixed cmd-space bug

Browse Source 
original commit: cac32c3a556f6f57710ad2d048f20dc9ea971569
This commit is contained in:
Robby Findler 1998-08-09 15:17:06 +00:00
parent e7b4b7f84d
commit 6476f4e6e0
1 changed files with 40 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
collects/mred/keys.ss
View File

@ -252,48 +252,55 @@
#t)] #t)]
[collapse-variable-space [collapse-variable-space
(lambda (leave-one? edit event) (lambda (leave-one? edit event)
(letrec ([find-nonwhite (letrec ([end-pos (send edit last-position)]
[find-nonwhite
(lambda (pos d) (lambda (pos d)
(let ([c (send edit get-character pos)]) (let ([c (send edit get-character pos)])
(cond (cond
[(char=? #\newline c) pos] [(char=? #\newline c) pos]
[(or (and (< pos 0) (= d -1))
(and (> pos end-pos) (= d 1)))
(if (= d -1)
-1
end-pos)]
[(char-whitespace? c) [(char-whitespace? c)
(find-nonwhite (+ pos d) d)] (find-nonwhite (+ pos d) d)]
[else pos])))]) [else pos])))])
(let ([sel-start (send edit get-start-position)] (let ([sel-start (send edit get-start-position)]
[sel-end (send edit get-end-position)]) [sel-end (send edit get-end-position)])
(if (= sel-start sel-end) (when (= sel-start sel-end)
(let ([start (+ (find-nonwhite (- sel-start 1) -1) (let ([start (+ (find-nonwhite (- sel-start 1) -1)
(if leave-one? 2 1))] (if leave-one? 2 1))]
[end (find-nonwhite sel-start 1)]) [end (find-nonwhite sel-start 1)])
(if (< start end) (if (< start end)
(begin (begin
(send edit begin-edit-sequence) (send edit begin-edit-sequence)
(send edit delete start end) (send edit delete start end)
(if (and leave-one? (if (and leave-one?
(not (char=? #\space (not (char=? #\space
(send edit get-character (send edit get-character
(sub1 start))))) (sub1 start)))))
(send edit insert " " (sub1 start) start)) (send edit insert " " (sub1 start) start))
(send edit set-position start) (send edit set-position start)
(send edit end-edit-sequence)) (send edit end-edit-sequence))
(if leave-one? (when leave-one?
(let ([at-start (let ([at-start
(send edit get-character sel-start)] (send edit get-character sel-start)]
[after-start [after-start
(send edit get-character (send edit get-character
(sub1 sel-start))]) (sub1 sel-start))])
(cond (cond
[(char-whitespace? at-start) [(char-whitespace? at-start)
(if (not (char=? at-start #\space)) (if (not (char=? at-start #\space))
(send edit insert " " sel-start (send edit insert " " sel-start
(add1 sel-start))) (add1 sel-start)))
(send edit set-position (add1 sel-start))] (send edit set-position (add1 sel-start))]
[(char-whitespace? after-start) [(char-whitespace? after-start)
(if (not (char=? after-start #\space)) (if (not (char=? after-start #\space))
(send edit insert " " (sub1 sel-start) (send edit insert " " (sub1 sel-start)
sel-start))] sel-start))]
[else (send edit insert " ")])))))))))] [else
(send edit insert " ")])))))))))]
[collapse-space [collapse-space
(lambda (edit event) (lambda (edit event)