diff --git a/collects/framework/framework.ss b/collects/framework/framework.ss index cfdc429c..d7f361e9 100644 --- a/collects/framework/framework.ss +++ b/collects/framework/framework.ss @@ -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) diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss index 0c1c7f81..05b0b61c 100644 --- a/collects/framework/private/frame.ss +++ b/collects/framework/private/frame.ss @@ -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) diff --git a/collects/framework/private/handler.ss b/collects/framework/private/handler.ss index 0dc64d77..8f126069 100644 --- a/collects/framework/private/handler.ss +++ b/collects/framework/private/handler.ss @@ -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)))]) diff --git a/collects/framework/private/sig.ss b/collects/framework/private/sig.ss index 8c8052b0..e47a7d31 100644 --- a/collects/framework/private/sig.ss +++ b/collects/framework/private/sig.ss @@ -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^)))