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

...

Browse Source 
original commit: 69a89f50d3661bb05754f31f0fccd91f34b8dadc
This commit is contained in:
Robby Findler 2000-02-21 04:14:37 +00:00
parent 6abbf695a5
commit a8c97f43f0
3 changed files with 62 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

111
collects/framework/keymap.ss
View File

@ -310,69 +310,64 @@
(lambda (edit event)
(letrec ([find-nonwhite
(lambda (pos d offset)
(call/ec
(lambda (escape)
(let ([max (if (> offset 0)
(send edit last-position)
-1)])
(let loop ([pos pos])
(if (= pos max)
(escape pos)
(let ([c (send edit get-character
(+ pos offset))])
(cond
[(char=? #\newline c)
(loop (+ pos d))
(escape pos)]
[(char-whitespace? c)
(loop (+ pos d))]
[else pos]))))))))])
(let/ec escape
(let ([max (if (> offset 0)
(send edit last-position)
0)])
(let loop ([pos pos])
(if (= pos max)
(escape pos)
(let ([_ (printf "get-char.1: ~s~n" (+ pos offset))]
[c (send edit get-character (+ pos offset))])
(cond
[(char=? #\newline c)
(loop (+ pos d))
(escape pos)]
[(char-whitespace? c)
(loop (+ pos d))]
[else pos])))))))])
(let ([sel-start (send edit get-start-position)]
[sel-end (send edit get-end-position)])
(if (= sel-start sel-end)
(let* ([pos-line
(send edit position-line sel-start #f)]
[pos-line-start
(send edit line-start-position pos-line)]
[pos-line-end
(send edit line-end-position pos-line)]
(when (= sel-start sel-end)
(let* ([pos-line (send edit position-line sel-start #f)]
[pos-line-start (send edit line-start-position pos-line)]
[pos-line-end (send edit line-end-position pos-line)]
[whiteline?
(let loop ([pos pos-line-start])
(if (>= pos pos-line-end)
#t
(and (char-whitespace?
(send edit get-character pos))
(loop (add1 pos)))))]
[whiteline?
(let loop ([pos pos-line-start])
(if (>= pos pos-line-end)
#t
(and (char-whitespace? (send edit get-character pos))
(loop (add1 pos)))))]
[start (find-nonwhite pos-line-start -1 -1)]
[end (find-nonwhite pos-line-end 1 0)]
[start (find-nonwhite pos-line-start -1 -1)]
[end (find-nonwhite pos-line-end 1 0)]
[start-line
(send edit position-line start #f)]
[start-line-start
(send edit line-start-position start-line)]
[end-line
(send edit position-line end #f)]
[end-line-start
(send edit line-start-position (add1 end-line))])
(cond
[(and whiteline?
(= start-line pos-line)
(= end-line pos-line))
; Special case: just delete this line
(send edit delete pos-line-start (add1 pos-line-end))]
[(and whiteline? (< start-line pos-line))
; Can delete before & after
(send* edit
(begin-edit-sequence)
(delete (add1 pos-line-end) end-line-start)
(delete start-line-start pos-line-start)
(end-edit-sequence))]
[else
; Only delete after
(send edit delete (add1 pos-line-end)
end-line-start)]))))))]
[start-line
(send edit position-line start #f)]
[start-line-start
(send edit line-start-position start-line)]
[end-line
(send edit position-line end #f)]
[end-line-start
(send edit line-start-position (add1 end-line))])
(cond
[(and whiteline?
(= start-line pos-line)
(= end-line pos-line))
; Special case: just delete this line
(send edit delete pos-line-start (add1 pos-line-end))]
[(and whiteline? (< start-line pos-line))
; Can delete before & after
(send* edit
(begin-edit-sequence)
(delete (add1 pos-line-end) end-line-start)
(delete start-line-start pos-line-start)
(end-edit-sequence))]
[else
; Only delete after
(send edit delete (add1 pos-line-end)
end-line-start)]))))))]
[open-line
(lambda (edit event)

2
collects/framework/scheme.ss
View File

@ -893,7 +893,7 @@
(map-meta "c:down" "down-sexp")
(map-meta "s:down" "select-down-sexp")
(map "a:s:down" "select-down-sexp")
(map-meta "s:c:down" "down-sexp")
(map-meta "s:c:down" "select-down-sexp")
(map-meta "right" "forward-sexp")
(map "a:right" "forward-sexp")

26
collects/framework/text.ss
View File

@ -421,16 +421,8 @@
(define clever-file-format-mixin
(mixin ((class->interface text%)) (clever-file-format<%>) args
(inherit get-file-format set-file-format find-first-snip)
(rename [super-on-save-file on-save-file]
[super-after-save-file after-save-file])
(private [restore-file-format void])
(rename [super-on-save-file on-save-file])
(override
[after-save-file
(lambda (success)
(restore-file-format)
(super-after-save-file success))]
[on-save-file
(let ([all-string-snips
(lambda ()
@ -447,23 +439,15 @@
(or (eq? format 'same) (eq? format 'copy))
(eq? 'standard (get-file-format))
(or (not (preferences:get 'framework:verify-change-format))
(gui-utils:get-choice "Save this file as plain text?" "No" "Yes")))
(set! restore-file-format
(let ([ff (get-file-format)])
(lambda ()
(set! restore-file-format void)
(set-file-format ff))))
(gui-utils:get-choice
"Save this file as plain text?" "Yes" "No")))
(set-file-format 'text)]
[(and (not all-strings?)
(or (eq? format 'same) (eq? format 'copy))
(eq? 'text (get-file-format))
(or (not (preferences:get 'framework:verify-change-format))
(gui-utils:get-choice "Save this file in drscheme-specific non-text format?" "No" "Yes")))
(set! restore-file-format
(let ([ff (get-file-format)])
(lambda ()
(set! restore-file-format void)
(set-file-format ff))))
(gui-utils:get-choice
"Save this file in drscheme-specific non-text format?" "Yes" "No")))
(set-file-format 'standard)]
[else (void)]))
(super-on-save-file name format)))])