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

..

Browse Source 
original commit: bcf8165f200e02e9ed2ebd7bfe7af6b538c9e160
This commit is contained in:
Robby Findler 2002-02-16 14:30:16 +00:00
parent a6da57796d
commit 2a1ecc6448
1 changed files with 195 additions and 186 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
collects/framework/private/keymap.ss
View File

@ -302,46 +302,55 @@
(send edit flash-on pos (+ 1 pos)))) (send edit flash-on pos (+ 1 pos))))
#t)] #t)]
[collapse-variable-space [collapse-variable-space
;; As per emacs: collapse tabs & spaces around the point,
;; perhaps leaving a single space.
;; drscheme bonus: if at end-of-line, collapse into the next line.
(lambda (leave-one? edit event) (lambda (leave-one? edit event)
(letrec ([end-pos (send edit last-position)] (letrec ([last-pos (send edit last-position)]
[find-nonwhite [sel-start (send edit get-start-position)]
(lambda (pos d) [sel-end (send edit get-end-position)]
[collapsible? (lambda (c) (and (char-whitespace? c)
(not (char=? #\newline c))))]
[find-noncollapsible
; Return index of next non-collapsible char,
; starting at pos in direction dir.
; NB returns -1 or last-pos, if examining
; initial/final whitespace
; (or, when initial pos is outside of [0,last-pos).)
(lambda (pos dir)
(let loop ([pos pos]) (let loop ([pos pos])
(if (or (and (= d -1) (cond [(< pos 0) -1]
(= pos 0)) [(>= pos last-pos) last-pos]
(and (= pos end-pos) [(collapsible? (send edit get-character pos))
(= d 1))) (loop (+ pos dir))]
pos [else pos])))])
(let ([c (send edit get-character pos)]) (when (= sel-start sel-end) ; Only when no selection:
(cond (let* ([start (add1 (find-noncollapsible (sub1 sel-start) -1))]
[(char=? #\newline c) pos] [end-heeding-eol (find-noncollapsible sel-start +1)]
[(char-whitespace? c) (loop (+ pos d))] ; This is the end of the range, were we to always heed newlines.
[else pos])))))])
(let ([sel-start (send edit get-start-position)] ; Special case: if we're sitting at EOL,
[sel-end (send edit get-end-position)]) ; and we're not affecting much else,
(when (= sel-start sel-end) ; then delete that EOL and collapse spaces
(let ([start ; at the start of next line, too:
(if (= sel-start 0) [end (if (and (<= (- end-heeding-eol start)
0 (if leave-one? 1 0))
(+ (find-nonwhite (- sel-start 1) -1) 1))] (char=? #\newline (send edit get-character end-heeding-eol))
[end (find-nonwhite sel-start 1)]) ; If you wish to avoid deleting an newline at EOF, do so here.
)
(find-noncollapsible (add1 end-heeding-eol) +1)
end-heeding-eol)]
[making-no-difference?
; Don't introduce edits into undo-chain, if no effect.
(if leave-one?
(and (= (- end start) 1)
(char=? #\space (send edit get-character start)))
(= (- end start) 0))])
(unless making-no-difference?
(send edit begin-edit-sequence) (send edit begin-edit-sequence)
(cond (send edit set-position end) ; Even after delete, caret will be at "end".
;; funny case when to delete the newline
[(and leave-one?
(= (+ start 1) end)
(< end end-pos)
(char=? #\space (send edit get-character start))
(char=? #\newline (send edit get-character end)))
(send edit delete end (+ end 1))]
[else
(send edit delete start end) (send edit delete start end)
(cond (when leave-one? (send edit insert #\space start))
[leave-one?
(send edit insert #\space start)
(send edit set-position (+ start 1))]
[else
(send edit set-position start)])])
(send edit end-edit-sequence))))))] (send edit end-edit-sequence))))))]
[collapse-space [collapse-space
@ -976,7 +985,7 @@
(map "s:insert" "paste-clipboard") (map "s:insert" "paste-clipboard")
(map-meta "space" "collapse-space") (map-meta "space" "collapse-space")
;(map-meta "\\" "remove-space") ;; conflicts with european keyboards ;(map-meta "\\" "remove-space") ; Conflicts with european keyboards.
(map "c:x;c:o" "collapse-newline") (map "c:x;c:o" "collapse-newline")
(map "c:o" "open-line") (map "c:o" "open-line")
(map "c:t" "transpose-chars") (map "c:t" "transpose-chars")