From af46ef56221814eead6ee5a2951cb455c444f923 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 30 Aug 2007 04:08:56 +0000 Subject: [PATCH] started refactoring to fix the preferences problem svn: r7226 --- collects/framework/framework.ss | 25 +++++++++++++++- collects/framework/preferences.ss | 2 +- collects/framework/private/frame.ss | 15 ++-------- collects/framework/private/group.ss | 46 ++++++++++++++++++----------- collects/framework/private/sig.ss | 4 ++- 5 files changed, 59 insertions(+), 33 deletions(-) diff --git a/collects/framework/framework.ss b/collects/framework/framework.ss index 7d61167114..37e096d4c6 100644 --- a/collects/framework/framework.ss +++ b/collects/framework/framework.ss @@ -344,7 +344,7 @@ (filename) "Generates a name for an backup file from \\var{filename}.") (finder:dialog-parent-parameter - any/c + (parameter/c (or/c false/c (is-ac dialog%) (is-a/c frame%))) () "This is a parameter (see " "\\Mzhyperref{parameters}{mz:parameters} for information about parameters)" @@ -602,6 +602,29 @@ () "This returns the frame group.") + (group:on-close-action + (-> void?) + () + "See also " + "@flink group:can-close-check %" + "." + "" + "Call this function from the" + "@ilink top-level-window can-close?" + "callback of a frame" + "in order for the group to properly close the application.") + (group:can-close-check + (-> boolean?) + () + "See also " + "@flink group:on-close-action %" + "." + "" + "Call this function from the" + "@ilink top-level-window can-close?" + "callback of a frame" + "in order for the group to properly close the application.") + (handler:handler? (any/c . -> . boolean?) (obj) diff --git a/collects/framework/preferences.ss b/collects/framework/preferences.ss index 462e822943..560d34375c 100644 --- a/collects/framework/preferences.ss +++ b/collects/framework/preferences.ss @@ -348,7 +348,7 @@ the state transitions / contracts are: "Determines if a value is an unknown preference exn.") (preferences:low-level-put-preferences - any/c + (parameter/c (-> (listof symbol?) (listof any?) any)) () "This is a parameter (see " "\\Mzhyperref{parameters}{mz:parameters} for information about parameters)" diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss index bd1671e3eb..4fa8915ee2 100644 --- a/collects/framework/private/frame.ss +++ b/collects/framework/private/frame.ss @@ -237,23 +237,14 @@ (mixin (basic<%>) (register-group<%>) (define/augment (can-close?) - (let ([number-of-frames - (length (send (group:get-the-frame-group) - get-frames))]) - (and (inner #t can-close?) - (or (not (preferences:get 'framework:exit-when-no-frames)) - (exit:exiting?) - (not (= 1 number-of-frames)) - (exit:user-oks-exit))))) + (and (inner #t can-close?) + (group:can-close-check))) (define/augment (on-close) (send (group:get-the-frame-group) remove-frame this) (inner (void) on-close) - (when (preferences:get 'framework:exit-when-no-frames) - (unless (exit:exiting?) - (when (null? (send (group:get-the-frame-group) get-frames)) - (exit:exit))))) + (group:on-close-action)) (define/override (on-activate on?) (super on-activate on?) diff --git a/collects/framework/private/group.ss b/collects/framework/private/group.ss index e746a61b19..de91b64b09 100644 --- a/collects/framework/private/group.ss +++ b/collects/framework/private/group.ss @@ -14,7 +14,8 @@ [prefix frame: framework:frame^] [prefix text: framework:text^] [prefix canvas: framework:canvas^] - [prefix menu: framework:menu^]) + [prefix menu: framework:menu^] + [prefix exit: framework:exit^]) (export framework:group^) (define-struct frame (frame id)) @@ -156,11 +157,7 @@ #f (frame-frame (car candidates))))])) - (public get-mdi-parent frame-label-changed for-each-frame - get-active-frame set-active-frame insert-frame - remove-frame clear on-close-all can-close-all? locate-file get-frames - frame-shown/hidden) - (define (get-mdi-parent) + (define/public (get-mdi-parent) (when (and (eq? (system-type) 'windows) (preferences:get 'framework:windows-mdi) (not mdi-parent)) @@ -170,35 +167,35 @@ (send mdi-parent show #t)) mdi-parent) - (define (get-frames) (map frame-frame frames)) + (define/public (get-frames) (map frame-frame frames)) - (define (frame-label-changed frame) + (define/public (frame-label-changed frame) (when (memq frame (map frame-frame frames)) (update-windows-menus))) - (define (frame-shown/hidden frame) + (define/public (frame-shown/hidden frame) (when (memq frame (map frame-frame frames)) (update-windows-menus))) - (define (for-each-frame f) + (define/public (for-each-frame f) (for-each (λ (x) (f (frame-frame x))) frames) (set! todo-to-new-frames (let ([old todo-to-new-frames]) (λ (frame) (old frame) (f frame))))) - (define (get-active-frame) + (define/public (get-active-frame) (cond [active-frame active-frame] [(null? frames) #f] [else (frame-frame (car frames))])) - (define (set-active-frame f) + (define/public (set-active-frame f) (when (and active-frame (not (eq? active-frame f))) (set! most-recent-window-box (make-weak-box active-frame))) (set! active-frame f)) - (define (insert-frame new-frame) + (define/public (insert-frame new-frame) (unless (memf (λ (fr) (eq? (frame-frame fr) new-frame)) frames) (set! frame-counter (add1 frame-counter)) @@ -210,7 +207,7 @@ (update-windows-menus)) (todo-to-new-frames new-frame))) - (define (remove-frame f) + (define/public (remove-frame f) (when (eq? f active-frame) (set! active-frame #f)) (let ([new-frames @@ -222,24 +219,24 @@ (remove-windows-menu f) (update-windows-menus))) - (define (clear) + (define/public (clear) (set! frames null) #t) - (define (on-close-all) + (define/public (on-close-all) (for-each (λ (f) (let ([frame (frame-frame f)]) (send frame on-close) (send frame show #f))) frames)) - (define (can-close-all?) + (define/public (can-close-all?) (andmap (λ (f) (let ([frame (frame-frame f)]) (send frame can-close?))) frames)) - (define (locate-file name) + (define/public (locate-file name) (let* ([normalized ;; allow for the possiblity of filenames that are urls (with-handlers ([(λ (x) #t) @@ -261,6 +258,19 @@ (super-new))) + (define (can-close-check) + (let ([number-of-frames (length (send (get-the-frame-group) get-frames))]) + (or (not (preferences:get 'framework:exit-when-no-frames)) + (exit:exiting?) + (not (= 1 number-of-frames)) + (exit:user-oks-exit)))) + + (define (on-close-action) + (when (preferences:get 'framework:exit-when-no-frames) + (unless (exit:exiting?) + (when (null? (send (get-the-frame-group) get-frames)) + (exit:exit))))) + (define (choose-a-frame parent) (letrec-values ([(sorted-frames) (sort diff --git a/collects/framework/private/sig.ss b/collects/framework/private/sig.ss index bcffaf1962..f99d8726ad 100644 --- a/collects/framework/private/sig.ss +++ b/collects/framework/private/sig.ss @@ -281,7 +281,9 @@ (define-signature group-class^ (%)) (define-signature group^ extends group-class^ - (get-the-frame-group)) + (get-the-frame-group + on-close-action + can-close-check)) (define-signature handler-class^ ())