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

used capability interface for a bunch more special menu items

Browse Source 
svn: r3205

original commit: c948e8cbc6f9437bbcf824766658497b1fdf5c11
This commit is contained in:
Robby Findler 2006-06-03 19:44:18 +00:00
parent d15b16628a
commit bc61310933
2 changed files with 56 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/framework/framework.ss
View File

@ -666,14 +666,18 @@
"The first argument should be the preferences symbol, and the second an third" "The first argument should be the preferences symbol, and the second an third"
"should be the default width and height, respectively.") "should be the default width and height, respectively.")
(frame:add-snip-menu-items (frame:add-snip-menu-items
((is-a?/c menu%) (subclass?/c menu-item%) . -> . void?) (opt-> ((is-a?/c menu%) (subclass?/c menu-item%))
(menu menu-item%) ((-> (is-a?/c menu-item%) void?))
void?)
(menu menu-item% func)
"Inserts three menu items into \\var{menu}," "Inserts three menu items into \\var{menu},"
"one that inserts a text box, one that inserts a" "one that inserts a text box, one that inserts a"
"pasteboard box, and one that inserts an image" "pasteboard box, and one that inserts an image"
"into the currently focused editor (if there is one)." "into the currently focused editor (if there is one)."
"Uses \\var{menu-item\\%} as the class for" "Uses \\var{menu-item\\%} as the class for"
"the menu items.") "the menu items."
""
"Calls \\var{func} right after inserting each menu item.")
(frame:reorder-menus (frame:reorder-menus
((is-a?/c frame%) . -> . void?) ((is-a?/c frame%) . -> . void?)

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

@ -62,48 +62,56 @@
(when (pair? (send menu get-items)) (send menu restore))) (when (pair? (send menu get-items)) (send menu restore)))
menus)) menus))
(define (add-snip-menu-items edit-menu c%) (define add-snip-menu-items
(let* ([get-edit-target-object (opt-lambda (edit-menu c% [func void])
(λ () (let* ([get-edit-target-object
(let ([menu-bar (λ ()
(let loop ([p (send edit-menu get-parent)]) (let ([menu-bar
(cond (let loop ([p (send edit-menu get-parent)])
[(is-a? p menu-bar%) (cond
p] [(is-a? p menu-bar%)
[(is-a? p menu%) p]
(loop (send p get-parent))] [(is-a? p menu%)
[else #f]))]) (loop (send p get-parent))]
(and menu-bar [else #f]))])
(let ([frame (send menu-bar get-frame)]) (and menu-bar
(send frame get-edit-target-object)))))] (let ([frame (send menu-bar get-frame)])
[edit-menu:do (send frame get-edit-target-object)))))]
(λ (const) [edit-menu:do
(λ (menu evt) (λ (const)
(λ (menu evt)
(let ([edit (get-edit-target-object)])
(when (and edit
(is-a? edit editor<%>))
(send edit do-edit-operation const)))
#t))]
[on-demand
(λ (menu-item)
(let ([edit (get-edit-target-object)]) (let ([edit (get-edit-target-object)])
(when (and edit (send menu-item enable (and edit (is-a? edit editor<%>)))))]
(is-a? edit editor<%>)) [insert-comment-box
(send edit do-edit-operation const))) (λ ()
#t))] (let ([text (get-edit-target-object)])
[on-demand (when text
(λ (menu-item) (let ([snip (make-object comment-box:snip%)])
(let ([edit (get-edit-target-object)]) (send text insert snip)
(send menu-item enable (and edit (is-a? edit editor<%>)))))] (send text set-caret-owner snip 'global)))))])
[insert-comment-box
(λ ()
(let ([text (get-edit-target-object)])
(when text
(let ([snip (make-object comment-box:snip%)])
(send text insert snip)
(send text set-caret-owner snip 'global)))))])
(make-object c% (string-constant insert-comment-box-menu-item-label) (let ([item
edit-menu (new c%
(λ (x y) (insert-comment-box)) [label (string-constant insert-comment-box-menu-item-label)]
#f #f [parent edit-menu]
on-demand) [callback (λ (x y) (insert-comment-box))]
(make-object c% (string-constant insert-image-item) [demand-callback on-demand])])
edit-menu (edit-menu:do 'insert-image) #f #f on-demand) (func item))
(void))) (let ([item
(new c%
[label (string-constant insert-image-item)]
[parent edit-menu]
[callback (edit-menu:do 'insert-image)]
[demand-callback on-demand])])
(func item))
(void))))
(define frame-width 600) (define frame-width 600)
(define frame-height 650) (define frame-height 650)