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))))
#t)]
[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)
(letrec ([end-pos (send edit last-position)]
[find-nonwhite
(lambda (pos d)
(letrec ([last-pos (send edit last-position)]
[sel-start (send edit get-start-position)]
[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])
(if (or (and (= d -1)
(= pos 0))
(and (= pos end-pos)
(= d 1)))
pos
(let ([c (send edit get-character pos)])
(cond
[(char=? #\newline c) pos]
[(char-whitespace? c) (loop (+ pos d))]
[else pos])))))])
(let ([sel-start (send edit get-start-position)]
[sel-end (send edit get-end-position)])
(when (= sel-start sel-end)
(let ([start
(if (= sel-start 0)
0
(+ (find-nonwhite (- sel-start 1) -1) 1))]
[end (find-nonwhite sel-start 1)])
(cond [(< pos 0) -1]
[(>= pos last-pos) last-pos]
[(collapsible? (send edit get-character pos))
(loop (+ pos dir))]
[else pos])))])
(when (= sel-start sel-end) ; Only when no selection:
(let* ([start (add1 (find-noncollapsible (sub1 sel-start) -1))]
[end-heeding-eol (find-noncollapsible sel-start +1)]
; This is the end of the range, were we to always heed newlines.
; Special case: if we're sitting at EOL,
; and we're not affecting much else,
; then delete that EOL and collapse spaces
; at the start of next line, too:
[end (if (and (<= (- end-heeding-eol start)
(if leave-one? 1 0))
(char=? #\newline (send edit get-character end-heeding-eol))
; 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)
(cond
;; 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 set-position end) ; Even after delete, caret will be at "end".
(send edit delete start end)
(cond
[leave-one?
(send edit insert #\space start)
(send edit set-position (+ start 1))]
[else
(send edit set-position start)])])
(when leave-one? (send edit insert #\space start))
(send edit end-edit-sequence))))))]
[collapse-space
@ -976,7 +985,7 @@
(map "s:insert" "paste-clipboard")
(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:o" "open-line")
(map "c:t" "transpose-chars")