used capability interface for a bunch more special menu items
svn: r3205 original commit: c948e8cbc6f9437bbcf824766658497b1fdf5c11
This commit is contained in:
parent
d15b16628a
commit
bc61310933
|
@ -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?)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user