suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

make right-clicking on non-text offer copy and cut in the

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/framework/private/keymap.rkt
View File

@ -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<%>)

102
collects/mred/private/editor.rkt
View File

@ -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)

16
collects/scribblings/gui/editor-funcs.scrbl
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%))]
[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.
}