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

..

Browse Source 
original commit: 485ebbf9dc5eb0512983ba8dd38af61270402a2c
This commit is contained in:
Robby Findler 2003-04-29 20:59:58 +00:00
parent fd724f435d
commit a161a9c9df
4 changed files with 21 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -172,18 +172,21 @@
(let ([number-of-frames
(length (send (group:get-the-frame-group)
get-frames))])
(and (super-can-close?)
(or (exit:exiting?)
(not (= 1 number-of-frames))
(exit:user-oks-exit)))))
(if (preferences:get 'framework:exit-when-no-frames)
(and (super-can-close?)
(or (exit:exiting?)
(not (= 1 number-of-frames))
(exit:user-oks-exit)))
#t)))
(define (on-close)
(super-on-close)
(send (group:get-the-frame-group)
remove-frame
this)
(unless (exit:exiting?)
(when (null? (send (group:get-the-frame-group) get-frames))
(exit:exit))))
(when (preferences:get 'framework:exit-when-no-frames)
(unless (exit:exiting?)
(when (null? (send (group:get-the-frame-group) get-frames))
(exit:exit)))))
(define (on-focus on?)
(super-on-focus on?)

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

@ -16,9 +16,9 @@
(define (get-anchor-bitmap) (force anchor-bitmap))
(define lock-bitmap (delay (include-bitmap (lib "lock.gif" "icons"))))
(define-values (get-lock-bitmap) (force lock-bitmap))
(define (get-lock-bitmap) (force lock-bitmap))
(define unlock-bitmap (delay (include-bitmap (lib "unlock.gif" "icons"))))
(define-values (get-unlock-bitmap) (force unlock-bitmap))
(define (get-unlock-bitmap) (force unlock-bitmap))
(define autowrap-bitmap (delay (include-bitmap (lib "return.xbm" "icons"))))
(define (get-autowrap-bitmap) (force autowrap-bitmap))

8
collects/tests/framework/group-test.ss
View File

@ -74,7 +74,7 @@
(test
'windows-menu
(lambda (x)
(equal? x (list "Bring Frame to Front..." "Most Recent Window" "Next Window" "Previous Window"
(equal? x (list "Bring Frame to Front..." "Most Recent Window"
#f "first" "test")))
(lambda ()
(send-sexp-to-mred
@ -91,7 +91,7 @@
(test
'windows-menu-unshown
(lambda (x)
(equal? x (list "Bring Frame to Front..." "Most Recent Window" "Next Window" "Previous Window"
(equal? x (list "Bring Frame to Front..." "Most Recent Window"
#f "first" "test")))
(lambda ()
(send-sexp-to-mred
@ -109,7 +109,7 @@
(test
'windows-menu-sorted1
(lambda (x)
(equal? x (list "Bring Frame to Front..." "Most Recent Window" "Next Window" "Previous Window"
(equal? x (list "Bring Frame to Front..." "Most Recent Window"
#f "aaa" "bbb" "first")))
(lambda ()
(send-sexp-to-mred
@ -134,7 +134,7 @@
(test
'windows-menu-sorted2
(lambda (x)
(equal? x (list "Bring Frame to Front..." "Most Recent Window" "Next Window" "Previous Window"
(equal? x (list "Bring Frame to Front..." "Most Recent Window"
#f "aaa" "bbb" "first")))
(lambda ()
(send-sexp-to-mred

10
collects/tests/framework/mem.ss
View File

@ -117,11 +117,11 @@
(test-frame-allocate 'frame:pasteboard-info%)
(test-frame-allocate 'frame:standard-menus%)
;(test-frame-allocate 'frame:text%)
;(test-frame-allocate 'frame:text-info-file%)
;(test-frame-allocate 'frame:searchable%)
(test-frame-allocate 'frame:text%)
(test-frame-allocate 'frame:text-info-file%)
(test-frame-allocate 'frame:searchable%)
;(test-frame-allocate 'frame:pasteboard%)
;(test-frame-allocate 'frame:pasteboard-info-file%)
(test-frame-allocate 'frame:pasteboard%)
(test-frame-allocate 'frame:pasteboard-info-file%)
(done)
)