diff --git a/collects/framework/finder.ss b/collects/framework/finder.ss index b18b2d00..a0c12511 100644 --- a/collects/framework/finder.ss +++ b/collects/framework/finder.ss @@ -10,7 +10,7 @@ [mzlib:function : mzlib:function^] [mzlib:file : mzlib:file^]) - (define dialog-parent-parameter (make-parameter null)) + (define dialog-parent-parameter (make-parameter #f)) (define filter-match? (lambda (filter name msg) @@ -83,8 +83,8 @@ (let-values ([(dir-list menu-list) (let loop ([this-dir dir] - [dir-list ()] - [menu-list ()]) + [dir-list null] + [menu-list null]) (let-values ([(base-dir in-dir dir?) (split-path this-dir)]) (if (eq? (system-type) 'windows) @@ -136,9 +136,9 @@ (lambda () (let* ([file (send name-list get-string-selection)] [dir-and-file - (if (null? file) - current-dir - (build-path current-dir file))]) + (if file + (build-path current-dir file) + current-dir)]) (send* directory-edit (begin-edit-sequence) (erase) @@ -182,7 +182,7 @@ (let ([dir-name (send directory-edit get-text)]) (if (directory-exists? dir-name) (set-directory (mzlib:file:normalize-path dir-name)) - (let loop ([n (sub1 select-counter)][result ()]) + (let loop ([n (sub1 select-counter)][result null]) (if (< n 0) (begin (set-box! result-box result) @@ -231,7 +231,7 @@ (let* ([relative-name (make-relative name)] [file-in-edit (file-exists? dir-name)] [file (if (or file-in-edit - (null? relative-name) + (not relative-name) save-mode?) dir-name (build-path current-dir relative-name))]) @@ -334,7 +334,7 @@ [_1 (make-object message% top-panel prompt)] - [dir-choice (make-object choice% top-panel do-dir '())] + [dir-choice (make-object choice% #f null top-panel do-dir)] [middle-panel (make-object horizontal-panel% main-panel)] [left-middle-panel (make-object vertical-panel% middle-panel)] @@ -431,7 +431,7 @@ (set-selection-and-edit (min (sub1 num-items) (+ curr-pos num-vis))))] - [else #f])))] + [else #f]))] [on-default-action (lambda () @@ -501,8 +501,7 @@ [do-updir (lambda () (set-directory (build-updir current-dir)) - (set-focus-to-name-list)) - ]) + (set-focus-to-name-list))]) (sequence @@ -576,7 +575,6 @@ (sequence (cond [(and start-dir - (not (null? start-dir)) (directory-exists? start-dir)) (set-directory (mzlib:file:normalize-path start-dir))] [last-directory (set-directory last-directory)] @@ -604,16 +602,16 @@ (define common-put-file (make-common (opt-lambda (result-box - [name ()] - [directory ()] + [name #f] + [directory #f] [replace? #f] [prompt "Select file"] [filter #f] [filter-msg "Invalid form"] [parent-win (dialog-parent-parameter)]) - (let* ([directory (if (and (null? directory) + (let* ([directory (if (and (not directory) (string? name)) - (or (mzlib:file:path-only name) null) + (mzlib:file:path-only name) directory)] [name (or (and (string? name) (mzlib:file:file-name-from-path name)) @@ -634,7 +632,7 @@ (make-common (opt-lambda (result-box - [directory ()] + [directory #f] [prompt "Select file"] [filter #f] [filter-msg "Bad name"] @@ -646,7 +644,7 @@ #f ; multi-mode? result-box ; boxed results directory ; start-dir - '() ; start-name + #f ; start-name prompt ; prompt filter ; file-filter filter-msg ; file-filter-msg @@ -655,7 +653,7 @@ (define common-get-file-list (make-common (opt-lambda (result-box - [directory ()] + [directory #f] [prompt "Select files"] [filter #f] [filter-msg "Bad name"] @@ -668,7 +666,7 @@ #t ; multi-mode? result-box ; boxed results directory ; directory - '() ; start-name + #f ; start-name prompt ; prompt filter ; file-filter filter-msg ; file-filter-msg @@ -685,9 +683,9 @@ [filter #f] [filter-msg "That filename does not have the right form."] [parent-win (dialog-parent-parameter)]) - (let* ([directory (if (and (null? directory) + (let* ([directory (if (and (not directory) (string? name)) - (or (mzlib:file:path-only name) null) + (mzlib:file:path-only name) directory)] [name (or (and (string? name) (mzlib:file:file-name-from-path name)) @@ -726,8 +724,7 @@ prompt parent-win directory)]) - (if (null? f) - #f + (or f (if (or (not filter) (filter-match? filter f filter-msg)) (let ([f (mzlib:file:normalize-path f)]) (cond diff --git a/collects/framework/group.ss b/collects/framework/group.ss index e66c4c28..a984978d 100644 --- a/collects/framework/group.ss +++ b/collects/framework/group.ss @@ -1,50 +1,3 @@ - (private [get-standard-menu-close-item - (lambda (frame) - (let* ([close-string (if (eq? (system-type) 'windows) - "&Close" - "Close")] - [file-menu (ivar frame file-menu)]) - (if file-menu - (send file-menu find-item close-string) - #f)))] - [set-close-menu-item-state! - (lambda (frame state) - (when (is-a? frame frame:standard-menus<%>) - (let ([close-menu-item - (get-standard-menu-close-item frame)]) - (when close-menu-item - (send (ivar frame file-menu) - enable close-menu-item state)))))]) - -when removing a frame, do this: - - - (let ([frames (send mred:group:the-frame-group - get-frames)]) - - ; disable File|Close if remaining frame is singleton - - (when (eq? (length frames) 1) - (set-close-menu-item-state! (car frames) #f))) - -when adding a frame, do this: - - (let ([frames (send mred:group:the-frame-group get-frames)]) - - (if (eq? (length frames) 1) - - ; disable File|Close if frame is singleton - - (set-close-menu-item-state! this #f) - - ; otherwise, enable for all frames - - (send mred:group:the-frame-group - for-each-frame - (lambda (a-frame) - (set-close-menu-item-state! a-frame #t))))) - - (unit/sig mred:group^ (import [exit : framework:exit^] [mzlib:function : mzlib:function^] @@ -122,7 +75,20 @@ when adding a frame, do this: (cons menu new-ids)))) windows-menus))))]) - + (private + [update-close-menu-item-state + (lambda () + (let* ([set-close-menu-item-state! + (lambda (frame state) + (when (is-a? frame frame:standard-menus<%>) + (let ([close-menu-item (ivar frame file-menu:close-menu)]) + (when close-menu-item + (send close-menu-item enable state)))))]) + (if (eq? (length frames) 1) + (set-close-menu-item-state! (car frames) #f) + (for-each (lambda (a-frame) + (set-close-menu-item-state! a-frame #t)) + frames))))]) (public [set-empty-callbacks (lambda (test close-down) @@ -156,6 +122,7 @@ when adding a frame, do this: (let ([new-frames (cons (make-frame f frame-counter) frames)]) (set! frames new-frames) + (update-close-menu-item-state) (insert-windows-menu f) (update-windows-menus)) (todo-to-new-frames f))] @@ -178,6 +145,7 @@ when adding a frame, do this: f frames (lambda (f fr) (eq? f (frame-frame fr))))]) (set! frames new-frames) + (update-close-menu-item-state) (remove-windows-menu f) (update-windows-menus) (when (null? frames) diff --git a/collects/framework/handler.ss b/collects/framework/handler.ss index 78aaaade..a9410c62 100644 --- a/collects/framework/handler.ss +++ b/collects/framework/handler.ss @@ -184,18 +184,18 @@ (define *open-directory* ; object to remember last directory (make-object (class null () - (private - [the-dir #f]) - (public - [get (lambda () the-dir)] - [set-from-file! - (lambda (file) - (set! the-dir (mzlib:file:path-only file)))] - [set-to-default - (lambda () - (set! the-dir (current-directory)))]) - (sequence - (set-to-default))))) + (private + [the-dir #f]) + (public + [get (lambda () the-dir)] + [set-from-file! + (lambda (file) + (set! the-dir (mzlib:file:path-only file)))] + [set-to-default + (lambda () + (set! the-dir (current-directory)))]) + (sequence + (set-to-default))))) (define open-file (lambda () diff --git a/collects/framework/keys.ss b/collects/framework/keys.ss index 7c28ca27..cbcf38bd 100644 --- a/collects/framework/keys.ss +++ b/collects/framework/keys.ss @@ -102,9 +102,9 @@ #t)] [save-file (lambda (edit event) - (if (null? (send edit get-filename)) - (save-file-as edit event) - (send edit save-file)) + (if (send edit get-filename) + (send edit save-file) + (save-file-as edit event)) #t)] [load-file (lambda (edit event) @@ -364,7 +364,7 @@ [real-end (send edit last-position)]) (when (= sel-start sel-end) (let ([word-end (let ([b (box sel-start)]) - (send edit find-wordbreak () b 'caret) + (send edit find-wordbreak #f b 'caret) (min real-end (unbox b)))]) (send edit begin-edit-sequence) (let loop ([pos sel-start] @@ -399,7 +399,7 @@ (let ([sel-start (send edit get-start-position)] [sel-end (send edit get-end-position)]) (let ([end-box (box sel-end)]) - (send edit find-wordbreak () end-box 'caret) + (send edit find-wordbreak #f end-box 'caret) (send edit kill 0 sel-start (unbox end-box)))))] [backward-kill-word @@ -407,7 +407,7 @@ (let ([sel-start (send edit get-start-position)] [sel-end (send edit get-end-position)]) (let ([start-box (box sel-start)]) - (send edit find-wordbreak start-box () 'caret) + (send edit find-wordbreak start-box #f 'caret) (send edit kill 0 (unbox start-box) sel-end))))] [region-click @@ -513,7 +513,19 @@ (send km remove-grab-key-function))]) (send km set-grab-key-function (lambda (name local-km edit event) - (if (null? name) + (if name + (begin + (done) + (dynamic-wind + (lambda () + (send edit begin-edit-sequence)) + (lambda () + (let loop ([n n]) + (unless (zero? n) + (send local-km call-function name edit event) + (loop (sub1 n))))) + (lambda () + (send edit end-edit-sequence)))) (let ([k (send event get-key-code)]) (if (<= (char->integer #\0) k (char->integer #\9)) (set! n (+ (* n 10) (- k (char->integer #\0)))) @@ -528,19 +540,7 @@ (send edit on-char event) (loop (sub1 n))))) (lambda () - (send edit end-edit-sequence)))))) - (begin - (done) - (dynamic-wind - (lambda () - (send edit begin-edit-sequence)) - (lambda () - (let loop ([n n]) - (unless (zero? n) - (send local-km call-function name edit event) - (loop (sub1 n))))) - (lambda () - (send edit end-edit-sequence))))) + (send edit end-edit-sequence))))))) #t)) (send km set-break-sequence-callback done) #t))] @@ -568,11 +568,10 @@ (lambda (f) (let ([name (car f)] [event (cdr f)]) - (if (null? name) - (send edit on-char event) - (if (not (send km call-function - name edit event #t)) - (escape #t))))) + (if name + (unless (send km call-function name edit event #t) + (escape #t)) + (send edit on-char event)))) current-macro))) (lambda () (send edit end-edit-sequence) @@ -599,9 +598,9 @@ (lambda () (set! build-protect? #t)) (lambda () - (if (null? name) - (send edit on-default-char event) - (send local-km call-function name edit event))) + (if name + (send local-km call-function name edit event) + (send edit on-default-char event))) (lambda () (set! build-protect? #f))) (when building-macro diff --git a/collects/framework/prefs.ss b/collects/framework/prefs.ss index 55af5ed5..3ea00e3a 100644 --- a/collects/framework/prefs.ss +++ b/collects/framework/prefs.ss @@ -488,8 +488,7 @@ (unless (= value (send size-slider get-value)) (send size-slider set-value value)) #t)) - (make-object message% main - "Restart to see font changes") + (make-object message% main "Restart to see font changes") main)) #f)))