diff --git a/collects/framework/editor.ss b/collects/framework/editor.ss index 6df99171..fb8af634 100644 --- a/collects/framework/editor.ss +++ b/collects/framework/editor.ss @@ -321,7 +321,8 @@ [remove-autosave (lambda () (when auto-saved-name - (delete-file auto-saved-name) + (when (file-exists? auto-saved-name) + (delete-file auto-saved-name)) (set! auto-saved-name #f)))]) (sequence (apply super-init args) diff --git a/collects/framework/finder.ss b/collects/framework/finder.ss index 65a7c3b1..a6498cb4 100644 --- a/collects/framework/finder.ss +++ b/collects/framework/finder.ss @@ -6,6 +6,7 @@ (import mred^ [preferences : framework:preferences^] [gui-utils : framework:gui-utils^] + [keymap : framework:keymap^] [mzlib:string : mzlib:string^] [mzlib:function : mzlib:function^] [mzlib:file : mzlib:file^]) @@ -456,12 +457,14 @@ [bottom-panel (make-object horizontal-panel% main-panel)] [directory-field - (make-object text-field% - "Full pathname" - directory-panel - (lambda (txt evt) - (when (eq? (send evt get-event-type) 'text-field-enter) - (do-ok))))] + (keymap:call/text-keymap-initializer + (lambda () + (make-object text-field% + "Full pathname" + directory-panel + (lambda (txt evt) + (when (eq? (send evt get-event-type) 'text-field-enter) + (do-ok))))))] [result-list (when multi-mode? diff --git a/collects/framework/frame.ss b/collects/framework/frame.ss index a3f6ecf8..e40632f8 100644 --- a/collects/framework/frame.ss +++ b/collects/framework/frame.ss @@ -364,84 +364,86 @@ (define (search-dialog frame) (init-find/replace-edits) - (let* ([to-be-searched-text (send frame get-text-to-search)] - [to-be-searched-canvas (send to-be-searched-text get-canvas)] + (keymap:call/text-keymap-initializer + (lambda () + (let* ([to-be-searched-text (send frame get-text-to-search)] + [to-be-searched-canvas (send to-be-searched-text get-canvas)] - [dialog (make-object dialog% "Find and Replace")] + [dialog (make-object dialog% "Find and Replace")] - [copy-text - (lambda (from to) - (send to erase) - (let loop ([snip (send from find-first-snip)]) - (when snip - (send to insert (send snip copy)) - (loop (send snip next)))))] - + [copy-text + (lambda (from to) + (send to erase) + (let loop ([snip (send from find-first-snip)]) + (when snip + (send to insert (send snip copy)) + (loop (send snip next)))))] + - [find-panel (make-object horizontal-panel% dialog)] - [find-message (make-object message% "Find" find-panel)] - [find-field (make-object text-field% #f find-panel void)] - [f-text (send find-field get-editor)] + [find-panel (make-object horizontal-panel% dialog)] + [find-message (make-object message% "Find" find-panel)] + [find-field (make-object text-field% #f find-panel void)] + [f-text (send find-field get-editor)] - [replace-panel (make-object horizontal-panel% dialog)] - [replace-message (make-object message% "Replace" replace-panel)] - [replace-field (make-object text-field% #f replace-panel void)] - [r-text (send replace-field get-editor)] + [replace-panel (make-object horizontal-panel% dialog)] + [replace-message (make-object message% "Replace" replace-panel)] + [replace-field (make-object text-field% #f replace-panel void)] + [r-text (send replace-field get-editor)] - [button-panel (make-object horizontal-panel% dialog)] - [pref-check (make-object check-box% - "Use separate dialog for searching" - dialog - (lambda (pref-check evt) - (preferences:set - 'framework:search-using-dialog? - (send pref-check get-value))))] + [button-panel (make-object horizontal-panel% dialog)] + [pref-check (make-object check-box% + "Use separate dialog for searching" + dialog + (lambda (pref-check evt) + (preferences:set + 'framework:search-using-dialog? + (send pref-check get-value))))] - [update-texts - (lambda () - (send find-edit stop-searching) - (copy-text f-text find-edit) - (send find-edit start-searching) - (copy-text r-text replace-edit))] + [update-texts + (lambda () + (send find-edit stop-searching) + (copy-text f-text find-edit) + (send find-edit start-searching) + (copy-text r-text replace-edit))] - [find-button (make-object button% "Find" button-panel - (lambda x - (update-texts) - (send frame search-again)) - '(border))] - [replace-button (make-object button% "Replace" button-panel + [find-button (make-object button% "Find" button-panel (lambda x (update-texts) - (send frame replace)))] - [replace-button (make-object button% "Replace && Find Again" button-panel - (lambda x - (update-texts) - (send frame replace&search)))] - [replace-button (make-object button% "Replace to End" button-panel - (lambda x - (update-texts) - (send frame replace-all)))] - [close-button (make-object button% "Close" button-panel - (lambda x - (send to-be-searched-canvas force-display-focus #f) - (send dialog show #f)))]) - (copy-text find-edit f-text) - (copy-text replace-edit r-text) - (send find-field min-width 400) - (send replace-field min-width 400) - (let ([msg-width (max (send find-message get-width) - (send replace-message get-width))]) - (send find-message min-width msg-width) - (send replace-message min-width msg-width)) - (send find-field focus) - (send (send find-field get-editor) set-position - 0 - (send (send find-field get-editor) last-position)) - (send pref-check set-value (preferences:get 'framework:search-using-dialog?)) - (send button-panel set-alignment 'right 'center) - (send dialog center 'both) - (send to-be-searched-canvas force-display-focus #t) - (send dialog show #t))) + (send frame search-again)) + '(border))] + [replace-button (make-object button% "Replace" button-panel + (lambda x + (update-texts) + (send frame replace)))] + [replace-button (make-object button% "Replace && Find Again" button-panel + (lambda x + (update-texts) + (send frame replace&search)))] + [replace-button (make-object button% "Replace to End" button-panel + (lambda x + (update-texts) + (send frame replace-all)))] + [close-button (make-object button% "Close" button-panel + (lambda x + (send to-be-searched-canvas force-display-focus #f) + (send dialog show #f)))]) + (copy-text find-edit f-text) + (copy-text replace-edit r-text) + (send find-field min-width 400) + (send replace-field min-width 400) + (let ([msg-width (max (send find-message get-width) + (send replace-message get-width))]) + (send find-message min-width msg-width) + (send replace-message min-width msg-width)) + (send find-field focus) + (send (send find-field get-editor) set-position + 0 + (send (send find-field get-editor) last-position)) + (send pref-check set-value (preferences:get 'framework:search-using-dialog?)) + (send button-panel set-alignment 'right 'center) + (send dialog center 'both) + (send to-be-searched-canvas force-display-focus #t) + (send dialog show #t))))) (define searchable<%> (interface (text<%>) get-text-to-search diff --git a/collects/framework/frameworks.ss b/collects/framework/frameworks.ss index 6e1f66e5..ca25623d 100644 --- a/collects/framework/frameworks.ss +++ b/collects/framework/frameworks.ss @@ -218,7 +218,9 @@ get-global get-search - get-file)) + get-file + + call/text-keymap-initializer)) (define-signature framework:match-cache^ (%)) diff --git a/collects/framework/keymap.ss b/collects/framework/keymap.ss index 8be6850c..a9df6a58 100644 --- a/collects/framework/keymap.ss +++ b/collects/framework/keymap.ss @@ -374,9 +374,12 @@ [goto-line (lambda (edit event) - (let ([num-str (get-text-from-user - "Goto Line" - "Goto Line:")]) + (let ([num-str + (call/text-keymap-initializer + (lambda () + (get-text-from-user + "Goto Line" + "Goto Line:")))]) (if (string? num-str) (let ([line-num (string->number num-str)]) (if line-num @@ -386,9 +389,12 @@ #t)] [goto-position (lambda (edit event) - (let ([num-str (get-text-from-user - "Goto Position" - "Goto Position:")]) + (let ([num-str + (call/text-keymap-initializer + (lambda () + (get-text-from-user + "Goto Position" + "Goto Position:")))]) (if (string? num-str) (let ([pos (string->number num-str)]) (if pos @@ -516,6 +522,16 @@ "delete-next-character" "delete-previous-character") edit event #t)))] + + [cut-to-end-of-paragraph + (lambda (text event) + (let* ([start (send text get-start-position)] + [para (send text position-paragraph start)] + [end (send text paragraph-end-position para)]) + (if (= start end) + (send text cut #f (send event get-time-stamp) start (+ start 1)) + (send text cut #f (send event get-time-stamp) start end))))] + [toggle-overwrite (lambda (edit event) (send edit set-overwrite-mode @@ -583,6 +599,8 @@ (add "delete-key" delete-key) + (add "cut-to-end-of-paragraph" cut-to-end-of-paragraph) + ; Map keys to functions (map "c:g" "ring-bell") (map-meta "c:g" "ring-bell") @@ -689,7 +707,7 @@ (map "c:l" "center-view-on-line") - (map "c:k" "delete-to-end-of-line") + (map "c:k" "cut-to-end-of-paragraph") (map "c:y" "paste-clipboard") (map-meta "y" "paste-next") (map "a:v" "paste-clipboard") @@ -855,4 +873,12 @@ (define search (make-object keymap%)) (generic-setup search) (setup-search search) - (define (get-search) search)) + (define (get-search) search) + + (define (call/text-keymap-initializer thunk) + (let ([ctki (current-text-keymap-initializer)]) + (parameterize ([current-text-keymap-initializer + (lambda (keymap) + (send keymap chain-to-keymap global #t) + (ctki keymap))]) + (thunk))))) diff --git a/collects/framework/main.ss b/collects/framework/main.ss index 63caf180..5cb6a7cd 100644 --- a/collects/framework/main.ss +++ b/collects/framework/main.ss @@ -14,7 +14,7 @@ (preferences:set-default 'framework:verify-change-format #f boolean?) - (preferences:set-default 'framework:auto-set-wrap? #f boolean?) + (preferences:set-default 'framework:auto-set-wrap? #t boolean?) (preferences:set-default 'framework:display-line-numbers #t boolean?) diff --git a/collects/framework/prefs.ss b/collects/framework/prefs.ss index ccafa111..c8258dbc 100644 --- a/collects/framework/prefs.ss +++ b/collects/framework/prefs.ss @@ -321,7 +321,9 @@ [font-size-entry "defaultFontSize"] [font-default-string "Default Value"] - [font-default-size 12] + [font-default-size (case (system-type) + [(windows) 10] + [else 12])] [font-section "mred"] [build-font-entry (lambda (x) (string-append "Screen" x "__"))] [font-file (find-graphical-system-path 'setup-file)] diff --git a/collects/framework/scheme.ss b/collects/framework/scheme.ss index a2978fe5..91684df9 100644 --- a/collects/framework/scheme.ss +++ b/collects/framework/scheme.ss @@ -920,9 +920,12 @@ (let* ([add-callback (lambda (keyword-type keyword-symbol list-box) (lambda (button command) - (let ([new-one (get-text-from-user - (string-append "Enter new " keyword-type "-like keyword:") - (string-append keyword-type " Keyword"))]) + (let ([new-one + (keymap:call/text-keymap-initializer + (lambda () + (get-text-from-user + (string-append "Enter new " keyword-type "-like keyword:") + (string-append keyword-type " Keyword"))))]) (when new-one (let ([parsed (with-handlers ((exn:read? (lambda (x) #f))) (read (open-input-string new-one)))]) diff --git a/collects/framework/text.ss b/collects/framework/text.ss index 4831eb10..4c52cdd4 100644 --- a/collects/framework/text.ss +++ b/collects/framework/text.ss @@ -310,9 +310,26 @@ (public [initial-autowrap-bitmap (lambda () (icon:get-autowrap-bitmap))]) + (rename [super-on-close on-close]) + (override + [on-close + (lambda () + (remove-callback) + (super-on-close))]) + (sequence (apply super-init args) - (set-autowrap-bitmap (initial-autowrap-bitmap))))) + (set-autowrap-bitmap (initial-autowrap-bitmap))) + + (private + [remove-callback + (preferences:add-callback + 'framework:auto-set-wrap? + (lambda (p v) + (auto-wrap v)))]) + (inherit auto-wrap) + (sequence + (auto-wrap (preferences:get 'framework:auto-set-wrap?))))) (define searching<%> (interface (editor:keymap<%> basic<%>))) (define searching-mixin