From 6fff8a3030bfaddd0eb8113c9f67d6b7e70500ff Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 22 Nov 2012 17:32:19 -0600 Subject: [PATCH] make right-clicking on non-text offer copy and cut in the popup menu Extends append-editor-operation-menu-items so that when you pass an editor and a position, it checks to see if that spot has a non-string% snip and, if so, copies that one position (or cuts it, depending). Then, use that extension in DrRacket closes PR 12791 --- collects/framework/private/keymap.rkt | 5 +- collects/mred/private/editor.rkt | 102 +++++++++++++------- collects/scribblings/gui/editor-funcs.scrbl | 16 ++- 3 files changed, 82 insertions(+), 41 deletions(-) diff --git a/collects/framework/private/keymap.rkt b/collects/framework/private/keymap.rkt index 21042cdac1..bca0f24024 100644 --- a/collects/framework/private/keymap.rkt +++ b/collects/framework/private/keymap.rkt @@ -344,7 +344,10 @@ ((add-to-right-button-menu/before) m edit event) - (append-editor-operation-menu-items m) + (append-editor-operation-menu-items + m #:popup-position + (list edit + (send edit find-position (send event get-x) (send event get-y)))) (for-each (λ (i) (when (is-a? i selectable-menu-item<%>) diff --git a/collects/mred/private/editor.rkt b/collects/mred/private/editor.rkt index b2b18b6853..05296fa046 100644 --- a/collects/mred/private/editor.rkt +++ b/collects/mred/private/editor.rkt @@ -7,6 +7,7 @@ (for-syntax racket/base) (prefix-in wx: "kernel.rkt") (prefix-in wx: racket/snip/private/style) + (prefix-in wx: racket/snip/private/snip) (prefix-in wx: "wxme/keymap.rkt") (prefix-in wx: "wxme/editor.rkt") (prefix-in wx: "wxme/text.rkt") @@ -592,42 +593,71 @@ ;; ------------------------- Menus ---------------------------------------- -(define append-editor-operation-menu-items - (case-lambda - [(m) (append-editor-operation-menu-items m #t)] - [(m text-only?) - (menu-parent-only 'append-editor-operation-menu-items m) - (let* ([mk (lambda (name key op) - (make-object (class menu-item% - (inherit enable) - (define/override (on-demand) - (let ([o (find-item-editor this)]) - (enable (and o - (send o can-do-edit-operation? op))))) - (super-make-object - name m - (lambda (i e) - (let* ([o (find-item-editor i)]) - (and o - (send o do-edit-operation op)))) - key))))] - [mk-sep (lambda () (make-object separator-menu-item% m))]) - (mk "&Undo" #\z 'undo) - (mk "Redo" #f 'redo) - (mk-sep) - (mk "&Copy" #\c 'copy) - (mk "Cu&t" #\x 'cut) - (mk "&Paste" #\v 'paste) - (if (eq? (system-type) 'windows) - (mk "Delete" #f 'clear) - (mk "Clear" #f 'clear)) - (mk "Select &All" #\a 'select-all) - (unless text-only? - (mk-sep) - (mk "Insert Text Box" #f 'insert-text-box) - (mk "Insert Pasteboard Box" #f 'insert-pasteboard-box) - (mk "Insert Image..." #f 'insert-image)) - (void))])) +(define (append-editor-operation-menu-items m + [text-only? #t] + #:popup-position [popup-position #f]) + (unless (or (not popup-position) + (and (list? popup-position) + (= 2 (length popup-position)) + (is-a? (list-ref popup-position 0) text%) + (exact-nonnegative-integer? (list-ref popup-position 1)))) + (raise-argument-error 'append-editor-operation-menu-items + (format "~s" '(or/c #f (list/c (is-a?/c text%) exact-nonnegative-integer?))) + popup-position)) + (menu-parent-only 'append-editor-operation-menu-items m) + (let* ([mk (lambda (name key op [special-case? (λ () #f)] [special-go void]) + (make-object (class menu-item% + (inherit enable) + (define/override (on-demand) + (let ([o (find-item-editor this)]) + (enable (and o + (or (send o can-do-edit-operation? op) + (special-case?)))))) + (super-make-object + name m + (lambda (i e) + (let* ([o (find-item-editor i)]) + (and o + (if (special-case?) + (special-go) + (send o do-edit-operation op))))) + key))))] + [mk-sep (lambda () (make-object separator-menu-item% m))]) + (define (special-case?) + (cond + [popup-position + (define snp (send (list-ref popup-position 0) find-snip + (list-ref popup-position 1) + 'after-or-none)) + (and snp (not (is-a? snp wx:string-snip%)))] + [else + #f])) + (define (copy-special-go) + (send (list-ref popup-position 0) + copy #f 0 + (list-ref popup-position 1) + (+ (list-ref popup-position 1) 1))) + (define (cut-special-go) + (send (list-ref popup-position 0) + cut #f 0 + (list-ref popup-position 1) + (+ (list-ref popup-position 1) 1))) + (mk "&Undo" #\z 'undo) + (mk "Redo" #f 'redo) + (mk-sep) + (mk "&Copy" #\c 'copy special-case? copy-special-go) + (mk "Cu&t" #\x 'cut special-case? cut-special-go) + (mk "&Paste" #\v 'paste) + (if (eq? (system-type) 'windows) + (mk "Delete" #f 'clear) + (mk "Clear" #f 'clear)) + (mk "Select &All" #\a 'select-all) + (unless text-only? + (mk-sep) + (mk "Insert Text Box" #f 'insert-text-box) + (mk "Insert Pasteboard Box" #f 'insert-pasteboard-box) + (mk "Insert Image..." #f 'insert-image)) + (void))) (define (append-editor-font-menu-items m) (menu-parent-only 'append-editor-font-menu-items m) diff --git a/collects/scribblings/gui/editor-funcs.scrbl b/collects/scribblings/gui/editor-funcs.scrbl index a41c42629d..0f4188b58c 100644 --- a/collects/scribblings/gui/editor-funcs.scrbl +++ b/collects/scribblings/gui/editor-funcs.scrbl @@ -103,7 +103,11 @@ Appends menu items to @racket[menu] to implement a } @defproc[(append-editor-operation-menu-items [menu (or/c (is-a?/c menu%) (is-a?/c popup-menu%))] - [text-only? any/c #t]) + [text-only? any/c #t] + [#:popup-position + popup-position + (or/c #f (list/c (is-a?/c text%) exact-nonnegative-integer?)) + #f]) void?]{ Appends menu items to @racket[menu] to implement the standard editor operations, such as cut and paste. The callback for @@ -112,13 +116,17 @@ Appends menu items to @racket[menu] to implement the reached); if the result is an @racket[editor<%>] object, @xmethod[editor<%> do-edit-operation] is called on the editor. - - If @racket[text-only?] is @racket[#f], then menu items that insert non-text snips (such as @onscreen{Insert Image...}) are appended to the menu. - +If @racket[popup-position] is not @racket[#f], then @racket[append-editor-operation-menu-items] +is expected to have been called to build a popup menu and the two elements +of the list should be the @racket[text%] object where the mouse was clicked +for the popup menu and the position where the click happened. In that case, +the @onscreen{Copy} and @onscreen{Cut} menus are enabled when the click +lands on a snip that is not a @racket[string-snip%], and the corresponding +callbacks will copy and cut that one snip. }