From a8c97f43f063bc30d2c4d6a45b9ac2f791dc37aa Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 21 Feb 2000 04:14:37 +0000 Subject: [PATCH] ... original commit: 69a89f50d3661bb05754f31f0fccd91f34b8dadc --- collects/framework/keymap.ss | 117 +++++++++++++++++------------------ collects/framework/scheme.ss | 2 +- collects/framework/text.ss | 26 ++------ 3 files changed, 62 insertions(+), 83 deletions(-) diff --git a/collects/framework/keymap.ss b/collects/framework/keymap.ss index 7f11bd67..f11b010b 100644 --- a/collects/framework/keymap.ss +++ b/collects/framework/keymap.ss @@ -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)] - - [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-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)]))))))] + (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)))))] + + [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)]))))))] [open-line (lambda (edit event) diff --git a/collects/framework/scheme.ss b/collects/framework/scheme.ss index bb2b335a..5dc6e663 100644 --- a/collects/framework/scheme.ss +++ b/collects/framework/scheme.ss @@ -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") diff --git a/collects/framework/text.ss b/collects/framework/text.ss index e781586a..b5c88f99 100644 --- a/collects/framework/text.ss +++ b/collects/framework/text.ss @@ -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)))])