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

2
collects/framework/scheme.ss
View File

@ -893,7 +893,7 @@
(map-meta "c:down" "down-sexp") (map-meta "c:down" "down-sexp")
(map-meta "s:down" "select-down-sexp") (map-meta "s:down" "select-down-sexp")
(map "a: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-meta "right" "forward-sexp")
(map "a:right" "forward-sexp") (map "a:right" "forward-sexp")

26
collects/framework/text.ss
View File

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