original commit: 6f23f1a968d7347568a5d63a413eb1cd5c8839ff
This commit is contained in:
Robby Findler 2002-05-13 21:58:32 +00:00
parent 228fe03841
commit 1b13f2cff9
4 changed files with 50 additions and 35 deletions

View File

@ -514,6 +514,16 @@
""
"See section \\ref{selecting-a-filename} for more information.")
(frame:add-snip-menu-items
((is-a?/c menu%) (subclass?/c menu-item%) . -> . void?)
(menu menu-item%)
"Inserts three menu items into \\var{menu},"
"one that inserts a text box, one that inserts a"
"pasteboard box, and one that inserts an image"
"into the currently focused editor (if there is one)."
"Uses \\var{menu-item\\%} as the class for"
"the menu items.")
(frame:reorder-menus
((is-a?/c frame%) . -> . void?)
(frame)

View File

@ -66,6 +66,41 @@
(for-each (lambda (item) (send item delete)) items)
(for-each (lambda (item) (send item restore)) re-ordered)))
(define (add-snip-menu-items edit-menu c%)
(let* ([get-edit-target-object
(lambda ()
(let ([menu-bar
(let loop ([p (send edit-menu get-parent)])
(cond
[(is-a? p menu-bar%)
p]
[(is-a? p menu%)
(loop (send p get-parent))]
[else #f]))])
(and menu-bar
(let ([frame (send menu-bar get-frame)])
(send frame get-edit-target-object)))))]
[edit-menu:do
(lambda (const)
(lambda (menu evt)
(let ([edit (get-edit-target-object)])
(when (and edit
(is-a? edit editor<%>))
(send edit do-edit-operation const)))
#t))]
[on-demand
(lambda (menu-item)
(let ([edit (get-edit-target-object)])
(send menu-item enable (and edit (is-a? edit editor<%>)))))])
(make-object c% (string-constant insert-text-box-item)
edit-menu (edit-menu:do 'insert-text-box) #f #f on-demand)
(make-object c% (string-constant insert-pb-box-item)
edit-menu (edit-menu:do 'insert-pasteboard-box) #f #f on-demand)
(make-object c% (string-constant insert-image-item)
edit-menu (edit-menu:do 'insert-image) #f #f on-demand)
(void)))
(define frame-width 600)
(define frame-height 650)
(let ([window-trimming-upper-bound-width 20]
@ -611,9 +646,7 @@
save
save-as
get-canvas
get-editor
add-edit-menu-snip-items))
get-editor))
(define editor-mixin
(mixin (standard-menus<%>) (-editor<%>)
@ -770,38 +803,9 @@
#t))
(define file-menu:create-print? (lambda () #t))
(define edit-menu:do (lambda (const)
(lambda (menu evt)
(let ([edit (get-edit-target-object)])
(when (and edit
(is-a? edit editor<%>))
(send edit do-edit-operation const)))
#t)))
(public add-edit-menu-snip-items)
(define add-edit-menu-snip-items
(lambda (edit-menu)
(let ([c% (get-menu-item%)]
[on-demand
(lambda (menu-item)
(let ([edit (get-edit-target-object)])
(send menu-item enable (and edit (is-a? edit editor<%>)))))])
(make-object c% (string-constant insert-text-box-item)
edit-menu (edit-menu:do 'insert-text-box) #f #f on-demand)
(make-object c% (string-constant insert-pb-box-item)
edit-menu (edit-menu:do 'insert-pasteboard-box) #f #f on-demand)
(make-object c% (string-constant insert-image-item)
edit-menu (edit-menu:do 'insert-image) #f #f on-demand))))
(override edit-menu:between-select-all-and-find)
(define edit-menu:between-select-all-and-find
(lambda (edit-menu)
(make-object separator-menu-item% edit-menu)
(add-edit-menu-snip-items edit-menu)
(let* ([c% (get-checkable-menu-item%)]
[on-demand
(lambda (menu-item)

View File

@ -289,12 +289,12 @@
[hl (make-object recent-items-hierarchical-list% (get-area-container) '())]
[sort-by-name-button
(make-object button%
(string-constant sort-by-name)
(string-constant recent-items-sort-by-name)
bp
(lambda (x y) (set-sort-by 'name)))]
[sort-by-age-button
(make-object button%
(string-constant sort-by-age)
(string-constant recent-items-sort-by-age)
bp
(lambda (x y) (set-sort-by 'age)))])

View File

@ -339,7 +339,8 @@
pasteboard-info-mixin
file-mixin))
(define-signature framework:frame-fun^
(reorder-menus))
(reorder-menus
add-snip-menu-items))
(define-signature framework:frame^
((open framework:frame-class^)
(open framework:frame-fun^)))