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

...

Browse Source 
original commit: 1996bc0bfb75e399dbda8225a14c72bcff4458d2
This commit is contained in:
Robby Findler 2000-06-16 19:55:18 +00:00
parent a2b229b634
commit f073367576
1 changed files with 22 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/framework/keymap.ss
View File

@ -188,6 +188,25 @@
(lambda (edit event)
(bell))]
[mouse-popup-menu
(lambda (edit event)
(when (send event button-up?)
(let ([a (send edit get-admin)])
(when a
(let ([m (make-object popup-menu%)])
(append-editor-operation-menu-items m)
(for-each
(lambda (i)
(when (is-a? i selectable-menu-item<%>)
(send i set-shortcut #f)))
(send m get-items))
(let-values ([(x y) (send edit
dc-location-to-editor-location
(send event get-x)
(send event get-y))])
(send a popup-menu m (+ x 1) (+ y 1))))))))]
[up-out-of-editor-snip
(lambda (text event)
(let ([editor-admin (send text get-admin)])
@ -790,6 +809,8 @@
(add "goto-position" goto-position)
(add "delete-key" delete-key)
(add "mouse-popup-menu" mouse-popup-menu)
; Map keys to functions
(map "c:g" "ring-bell")
@ -951,10 +972,8 @@
(map "leftbuttontriple" "select-click-line")
(map "leftbuttondouble" "select-click-word")
(map "rightbutton" "copy-click-region")
(map "rightbuttondouble" "cut-click-region")
(map "middlebutton" "paste-click-region")
(map "c:rightbutton" "copy-clipboard")))))
(map ":rightbuttonseq" "mouse-popup-menu")))))
(define setup-search
(let* ([send-frame