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
This commit is contained in:
Robby Findler 2012-11-22 17:32:19 -06:00
parent 25e92e2cc2
commit 6fff8a3030
3 changed files with 82 additions and 41 deletions

View File

@ -344,7 +344,10 @@
((add-to-right-button-menu/before) m edit event) ((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 (for-each
(λ (i) (λ (i)
(when (is-a? i selectable-menu-item<%>) (when (is-a? i selectable-menu-item<%>)

View File

@ -7,6 +7,7 @@
(for-syntax racket/base) (for-syntax racket/base)
(prefix-in wx: "kernel.rkt") (prefix-in wx: "kernel.rkt")
(prefix-in wx: racket/snip/private/style) (prefix-in wx: racket/snip/private/style)
(prefix-in wx: racket/snip/private/snip)
(prefix-in wx: "wxme/keymap.rkt") (prefix-in wx: "wxme/keymap.rkt")
(prefix-in wx: "wxme/editor.rkt") (prefix-in wx: "wxme/editor.rkt")
(prefix-in wx: "wxme/text.rkt") (prefix-in wx: "wxme/text.rkt")
@ -592,42 +593,71 @@
;; ------------------------- Menus ---------------------------------------- ;; ------------------------- Menus ----------------------------------------
(define append-editor-operation-menu-items (define (append-editor-operation-menu-items m
(case-lambda [text-only? #t]
[(m) (append-editor-operation-menu-items m #t)] #:popup-position [popup-position #f])
[(m text-only?) (unless (or (not popup-position)
(menu-parent-only 'append-editor-operation-menu-items m) (and (list? popup-position)
(let* ([mk (lambda (name key op) (= 2 (length popup-position))
(make-object (class menu-item% (is-a? (list-ref popup-position 0) text%)
(inherit enable) (exact-nonnegative-integer? (list-ref popup-position 1))))
(define/override (on-demand) (raise-argument-error 'append-editor-operation-menu-items
(let ([o (find-item-editor this)]) (format "~s" '(or/c #f (list/c (is-a?/c text%) exact-nonnegative-integer?)))
(enable (and o popup-position))
(send o can-do-edit-operation? op))))) (menu-parent-only 'append-editor-operation-menu-items m)
(super-make-object (let* ([mk (lambda (name key op [special-case? (λ () #f)] [special-go void])
name m (make-object (class menu-item%
(lambda (i e) (inherit enable)
(let* ([o (find-item-editor i)]) (define/override (on-demand)
(and o (let ([o (find-item-editor this)])
(send o do-edit-operation op)))) (enable (and o
key))))] (or (send o can-do-edit-operation? op)
[mk-sep (lambda () (make-object separator-menu-item% m))]) (special-case?))))))
(mk "&Undo" #\z 'undo) (super-make-object
(mk "Redo" #f 'redo) name m
(mk-sep) (lambda (i e)
(mk "&Copy" #\c 'copy) (let* ([o (find-item-editor i)])
(mk "Cu&t" #\x 'cut) (and o
(mk "&Paste" #\v 'paste) (if (special-case?)
(if (eq? (system-type) 'windows) (special-go)
(mk "Delete" #f 'clear) (send o do-edit-operation op)))))
(mk "Clear" #f 'clear)) key))))]
(mk "Select &All" #\a 'select-all) [mk-sep (lambda () (make-object separator-menu-item% m))])
(unless text-only? (define (special-case?)
(mk-sep) (cond
(mk "Insert Text Box" #f 'insert-text-box) [popup-position
(mk "Insert Pasteboard Box" #f 'insert-pasteboard-box) (define snp (send (list-ref popup-position 0) find-snip
(mk "Insert Image..." #f 'insert-image)) (list-ref popup-position 1)
(void))])) '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) (define (append-editor-font-menu-items m)
(menu-parent-only 'append-editor-font-menu-items m) (menu-parent-only 'append-editor-font-menu-items m)

View File

@ -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%))] @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?]{ void?]{
Appends menu items to @racket[menu] to implement the Appends menu items to @racket[menu] to implement the
standard editor operations, such as cut and paste. The callback for 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, reached); if the result is an @racket[editor<%>] object,
@xmethod[editor<%> do-edit-operation] is called on the editor. @xmethod[editor<%> do-edit-operation] is called on the editor.
If @racket[text-only?] is @racket[#f], then menu items that insert If @racket[text-only?] is @racket[#f], then menu items that insert
non-text snips (such as @onscreen{Insert Image...}) are appended to non-text snips (such as @onscreen{Insert Image...}) are appended to
the menu. 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.
} }