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

25
collects/framework/keymap.ss
View File

@ -310,39 +310,34 @@
(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)
-1)]) 0)])
(let loop ([pos pos]) (let loop ([pos pos])
(if (= pos max) (if (= pos max)
(escape pos) (escape pos)
(let ([c (send edit get-character (let ([_ (printf "get-char.1: ~s~n" (+ pos offset))]
(+ pos offset))]) [c (send edit get-character (+ 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)]

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)))])