suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

started refactoring to fix the preferences problem

Browse Source 
svn: r7226
This commit is contained in:
Robby Findler 2007-08-30 04:08:56 +00:00
parent ed1e7e7ef6
commit af46ef5622
5 changed files with 59 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/framework/framework.ss
View File

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

2
collects/framework/preferences.ss
View File

@ -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)"

15
collects/framework/private/frame.ss
View File

@ -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?)

46
collects/framework/private/group.ss
View File

@ -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

4
collects/framework/private/sig.ss
View File

@ -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^
())