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

..

Browse Source 
original commit: 5e0bc6e9e3857a0c1ea72d80db3d20570830d421
This commit is contained in:
Robby Findler 2004-01-13 20:13:20 +00:00
parent 374a5610a1
commit dd84f014e1
1 changed files with 29 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -520,24 +520,41 @@
(rename [super-on-close on-close]) (rename [super-on-close on-close])
[define outer-info-panel 'top-info-panel-uninitialized] [define outer-info-panel 'top-info-panel-uninitialized]
;; this flag is specific to this frame
;; the true state of the info panel is
;; the conjunction of this flag and the
;; the 'framework:show-status-line preference
(define info-hidden? #f)
(define/public (hide-info) (define/public (hide-info)
(send super-root change-children (set! info-hidden? #t)
(lambda (l) (update-info-visibility (preferences:get 'framework:show-status-line)))
(list rest-panel))))
(define/public (show-info) (define/public (show-info)
(send super-root change-children (set! info-hidden? #f)
(lambda (l) (update-info-visibility (preferences:get 'framework:show-status-line)))
(list rest-panel outer-info-panel)))) (define/private (update-info-visibility pref-value)
(cond
[(or info-hidden? (not pref-value))
(send super-root change-children
(lambda (l)
(if (memq outer-info-panel l)
(begin (unregister-collecting-blit gc-canvas)
(list rest-panel))
l)))]
[else
(send super-root change-children
(lambda (l)
(if (memq outer-info-panel l)
l
(begin
(register-gc-blit)
(list rest-panel outer-info-panel)))))]))
[define close-panel-callback [define close-panel-callback
(preferences:add-callback (preferences:add-callback
'framework:show-status-line 'framework:show-status-line
(lambda (p v) (lambda (p v)
(if v (update-info-visibility v)))]
(register-gc-blit)
(unregister-collecting-blit gc-canvas))
(if v
(show-info)
(hide-info))))]
[define memory-cleanup void] ;; only for CVSers; used with memory-text [define memory-cleanup void] ;; only for CVSers; used with memory-text
(override on-close) (override on-close)
[define on-close [define on-close