.
original commit: ccf252d3514ffdcd9a3f97cb162c94fda2e3afac
This commit is contained in:
parent
6e628325ca
commit
e315b44675
|
@ -564,7 +564,7 @@
|
||||||
(set! DELETE-COCONUT-0 (new "Delete Coconut"))
|
(set! DELETE-COCONUT-0 (new "Delete Coconut"))
|
||||||
(make-object menu-item% "Delete Apple" menu
|
(make-object menu-item% "Delete Apple" menu
|
||||||
(lambda (m e)
|
(lambda (m e)
|
||||||
(send (send apple-menu get-item) delete)
|
(send apple-menu delete)
|
||||||
(set! apple-installed? #f)))
|
(set! apple-installed? #f)))
|
||||||
|
|
||||||
(sep)
|
(sep)
|
||||||
|
@ -585,13 +585,13 @@
|
||||||
(let ([make-menu
|
(let ([make-menu
|
||||||
(opt-lambda (title parent help-string)
|
(opt-lambda (title parent help-string)
|
||||||
(let ([m (make-object menu% title parent help-string)])
|
(let ([m (make-object menu% title parent help-string)])
|
||||||
(send (send m get-item) delete)
|
(send m delete)
|
||||||
m))])
|
m))])
|
||||||
(set! apple-menu (make-menu "Apple" mb #f))
|
(set! apple-menu (make-menu "Apple" mb #f))
|
||||||
(set! banana-menu (make-menu "Banana" mb #f))
|
(set! banana-menu (make-menu "Banana" mb #f))
|
||||||
(set! coconut-menu (make-menu "Coconut" apple-menu "Submenu")))
|
(set! coconut-menu (make-menu "Coconut" apple-menu "Submenu")))
|
||||||
|
|
||||||
(set! COCONUT-ID (send coconut-menu get-item))
|
(set! COCONUT-ID coconut-menu)
|
||||||
|
|
||||||
(set! DELETE-ONCE (new "Delete Once" #f apple-menu))
|
(set! DELETE-ONCE (new "Delete Once" #f apple-menu))
|
||||||
(set! DELETE-APPLE (new "Delete Apple" "Deletes the Apple menu" apple-menu))
|
(set! DELETE-APPLE (new "Delete Apple" "Deletes the Apple menu" apple-menu))
|
||||||
|
@ -607,19 +607,19 @@
|
||||||
(lambda (op ev)
|
(lambda (op ev)
|
||||||
(cond
|
(cond
|
||||||
[(eq? op ADD-APPLE)
|
[(eq? op ADD-APPLE)
|
||||||
(send (send apple-menu get-item) restore)
|
(send apple-menu restore)
|
||||||
(set! apple-installed? #t)]
|
(set! apple-installed? #t)]
|
||||||
[(eq? op ADD-BANANA)
|
[(eq? op ADD-BANANA)
|
||||||
(send (send banana-menu get-item) restore)]
|
(send banana-menu restore)]
|
||||||
[(eq? op ADD-COCONUT)
|
[(eq? op ADD-COCONUT)
|
||||||
(send (send coconut-menu get-item) restore)]
|
(send coconut-menu restore)]
|
||||||
[(eq? op DELETE-ONCE)
|
[(eq? op DELETE-ONCE)
|
||||||
(send DELETE-ONCE delete)]
|
(send DELETE-ONCE delete)]
|
||||||
[(eq? op DELETE-APPLE)
|
[(eq? op DELETE-APPLE)
|
||||||
(send (send apple-menu get-item) delete)
|
(send apple-menu delete)
|
||||||
(set! apple-installed? #f)]
|
(set! apple-installed? #f)]
|
||||||
[(eq? op DELETE-BANANA)
|
[(eq? op DELETE-BANANA)
|
||||||
(send (send banana-menu get-item) delete)]
|
(send banana-menu delete)]
|
||||||
[(eq? op DELETE-EXTRA-BANANA)
|
[(eq? op DELETE-EXTRA-BANANA)
|
||||||
(send (car (send banana-menu get-items)) delete)]
|
(send (car (send banana-menu get-items)) delete)]
|
||||||
[(or (eq? op DELETE-COCONUT) (eq? op DELETE-COCONUT-0))
|
[(or (eq? op DELETE-COCONUT) (eq? op DELETE-COCONUT-0))
|
||||||
|
@ -663,7 +663,7 @@
|
||||||
(unless (eq? (send id get-parent) menu)
|
(unless (eq? (send id get-parent) menu)
|
||||||
(error 'check-parent "parent mismatch: for ~a, ~a != ~a"
|
(error 'check-parent "parent mismatch: for ~a, ~a != ~a"
|
||||||
(send id get-label)
|
(send id get-label)
|
||||||
(send (send menu get-item) get-label)
|
(send menu get-label)
|
||||||
(send (send (send id get-parent) get-item) get-label)))))]
|
(send (send (send id get-parent) get-item) get-label)))))]
|
||||||
[label-test
|
[label-test
|
||||||
(lambda (menu id expect)
|
(lambda (menu id expect)
|
||||||
|
@ -696,13 +696,13 @@
|
||||||
(or (find menu str)
|
(or (find menu str)
|
||||||
(let ([items (send menu get-items)])
|
(let ([items (send menu get-items)])
|
||||||
(ormap (lambda (i)
|
(ormap (lambda (i)
|
||||||
(and (is-a? i submenu-item<%>)
|
(and (is-a? i menu%)
|
||||||
(find-item (send i get-menu) str)))
|
(find-item i str)))
|
||||||
items))))]
|
items))))]
|
||||||
[v (if use-menubar?
|
[v (if use-menubar?
|
||||||
(let ([item (find menu-bar title)])
|
(let ([item (find menu-bar title)])
|
||||||
(if item
|
(if item
|
||||||
(find-item (send item get-menu) string)
|
(find-item item string)
|
||||||
-1))
|
-1))
|
||||||
(find-item menu string))])
|
(find-item menu string))])
|
||||||
(compare expect v (format "label search: ~a" string))))]
|
(compare expect v (format "label search: ~a" string))))]
|
||||||
|
@ -720,12 +720,12 @@
|
||||||
(sequence
|
(sequence
|
||||||
(make-menu-bar)
|
(make-menu-bar)
|
||||||
|
|
||||||
(send (send apple-menu get-item) restore)
|
(send apple-menu restore)
|
||||||
|
|
||||||
(make-object button%
|
(make-object button%
|
||||||
"Delete Tester" sbp
|
"Delete Tester" sbp
|
||||||
(lambda args
|
(lambda args
|
||||||
(send (send main-menu get-item) delete)))
|
(send main-menu delete)))
|
||||||
(make-object button%
|
(make-object button%
|
||||||
"Delete First Menu" sbp
|
"Delete First Menu" sbp
|
||||||
(lambda args
|
(lambda args
|
||||||
|
@ -733,7 +733,7 @@
|
||||||
(make-object button%
|
(make-object button%
|
||||||
"Add Tester" sbp
|
"Add Tester" sbp
|
||||||
(lambda args
|
(lambda args
|
||||||
(send (send main-menu get-item) restore)))
|
(send main-menu restore)))
|
||||||
(make-object button%
|
(make-object button%
|
||||||
"Add Delete Banana" sbp
|
"Add Delete Banana" sbp
|
||||||
(lambda args
|
(lambda args
|
||||||
|
@ -761,7 +761,7 @@
|
||||||
(make-object button%
|
(make-object button%
|
||||||
"Toggle Apple Enable" mfbp
|
"Toggle Apple Enable" mfbp
|
||||||
(lambda args
|
(lambda args
|
||||||
(send (send apple-menu get-item) enable (not (send (send apple-menu get-item) is-enabled?)))))
|
(send apple-menu enable (not (send apple-menu is-enabled?)))))
|
||||||
|
|
||||||
(make-object button%
|
(make-object button%
|
||||||
"Test Labels" lblp
|
"Test Labels" lblp
|
||||||
|
@ -803,7 +803,7 @@
|
||||||
(send DELETE-APPLE set-help-string (tmp-pick "DELETER" "Deletes the Apple menu"))
|
(send DELETE-APPLE set-help-string (tmp-pick "DELETER" "Deletes the Apple menu"))
|
||||||
(send COCONUT-ID set-help-string (tmp-pick "SUBMENU" "Submenu"))
|
(send COCONUT-ID set-help-string (tmp-pick "SUBMENU" "Submenu"))
|
||||||
(send DELETE-COCONUT set-help-string (tmp-pick "CDELETER" #f))
|
(send DELETE-COCONUT set-help-string (tmp-pick "CDELETER" #f))
|
||||||
(send (send main-menu get-item) set-label (if temp-labels? "Hi" "&Tester")))))
|
(send main-menu set-label (if temp-labels? "Hi" "&Tester")))))
|
||||||
(letrec ([by-bar (make-object check-box%
|
(letrec ([by-bar (make-object check-box%
|
||||||
"Via Menubar" lblp
|
"Via Menubar" lblp
|
||||||
(lambda args
|
(lambda args
|
||||||
|
|
|
@ -301,7 +301,7 @@
|
||||||
|
|
||||||
(printf "Menu 1~n")
|
(printf "Menu 1~n")
|
||||||
(let* ([m (make-object menu% "&File" mb)]
|
(let* ([m (make-object menu% "&File" mb)]
|
||||||
[i (send m get-item)]
|
[i m]
|
||||||
[delete-enable-test (lambda (i parent empty)
|
[delete-enable-test (lambda (i parent empty)
|
||||||
(printf "Item~n")
|
(printf "Item~n")
|
||||||
(st #f i is-deleted?)
|
(st #f i is-deleted?)
|
||||||
|
@ -340,7 +340,6 @@
|
||||||
(stv i set-label l)))]
|
(stv i set-label l)))]
|
||||||
[hit #f])
|
[hit #f])
|
||||||
(st (list i) mb get-items)
|
(st (list i) mb get-items)
|
||||||
(st m i get-menu)
|
|
||||||
(st mb i get-parent)
|
(st mb i get-parent)
|
||||||
|
|
||||||
(st "&File" i get-label)
|
(st "&File" i get-label)
|
||||||
|
@ -419,9 +418,8 @@
|
||||||
|
|
||||||
(printf "Menu 2~n")
|
(printf "Menu 2~n")
|
||||||
(let* ([m2 (make-object menu% "&Edit" mb "Help Edit")]
|
(let* ([m2 (make-object menu% "&Edit" mb "Help Edit")]
|
||||||
[i2 (send m2 get-item)])
|
[i2 m2])
|
||||||
(st (list i i2) mb get-items)
|
(st (list i i2) mb get-items)
|
||||||
(st m2 i2 get-menu)
|
|
||||||
(st mb i2 get-parent)
|
(st mb i2 get-parent)
|
||||||
|
|
||||||
(st "&Edit" i2 get-label)
|
(st "&Edit" i2 get-label)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user