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

finish implementing display of menu shortcuts

Browse Source 
that involve non-chars shortcuts and alternate prefixes
This commit is contained in:
Matthew Flatt 2011-01-22 10:14:09 -07:00
parent 814a847323
commit 69859850f3
16 changed files with 305 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/mred/private/kernel.rkt
View File

@ -10,9 +10,6 @@
racket/class
racket/draw)
(define (key-symbol-to-integer k)
(error 'key-symbol-to-integer "not yet implemented"))
(provide (all-from-out "wx/platform.rkt")
clipboard<%>
(all-from-out "wx/common/event.rkt"
@ -37,7 +34,6 @@
begin-busy-cursor
is-busy?
end-busy-cursor
key-symbol-to-integer
application-file-handler
application-quit-handler
application-about-handler

6
collects/mred/private/mrmenu.rkt
View File

@ -183,7 +183,7 @@
(unless (or (not c)
(char? c)
(and (symbol? c)
(positive? (wx:key-symbol-to-integer c))))
(wx:key-symbol-to-menu-key c)))
(raise-type-error (who->name who) "character, key-code symbol, or #f" c)))
(define (check-shortcut-prefix who p)
@ -259,7 +259,7 @@
(if (memq 'meta prefix) "Meta+" "")
(if (memq 'alt prefix) "Alt+" "")
(if (symbol? shortcut)
(string-titlecase (symbol->string shortcut))
(wx:key-symbol-to-menu-key shortcut)
(char-name
(char-upcase shortcut)
#t)))]
@ -273,7 +273,7 @@
(char->integer #\A)))
(if (char? shortcut)
(char->integer (char-upcase shortcut))
(wx:key-symbol-to-integer shortcut)))]))
(wx:key-symbol-to-menu-key shortcut)))]))
(strip-tab label))]
[key-binding (and shortcut
(let ([base (if (symbol? shortcut)

145
collects/mred/private/wx/cocoa/keycode.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(provide map-key-code)
(provide map-key-code
key-symbol-to-menu-key)
(define (map-key-code v)
(hash-ref
@ -54,3 +55,145 @@
(92 . numpad9))
v
#f))
(define (key-symbol-to-menu-key k)
(hash-ref keysyms k #f))
(define keysyms
(let ()
(define NSUpArrowFunctionKey #xF700)
(define NSDownArrowFunctionKey #xF701)
(define NSLeftArrowFunctionKey #xF702)
(define NSRightArrowFunctionKey #xF703)
(define NSF1FunctionKey #xF704)
(define NSF2FunctionKey #xF705)
(define NSF3FunctionKey #xF706)
(define NSF4FunctionKey #xF707)
(define NSF5FunctionKey #xF708)
(define NSF6FunctionKey #xF709)
(define NSF7FunctionKey #xF70A)
(define NSF8FunctionKey #xF70B)
(define NSF9FunctionKey #xF70C)
(define NSF10FunctionKey #xF70D)
(define NSF11FunctionKey #xF70E)
(define NSF12FunctionKey #xF70F)
(define NSF13FunctionKey #xF710)
(define NSF14FunctionKey #xF711)
(define NSF15FunctionKey #xF712)
(define NSF16FunctionKey #xF713)
(define NSF17FunctionKey #xF714)
(define NSF18FunctionKey #xF715)
(define NSF19FunctionKey #xF716)
(define NSF20FunctionKey #xF717)
(define NSF21FunctionKey #xF718)
(define NSF22FunctionKey #xF719)
(define NSF23FunctionKey #xF71A)
(define NSF24FunctionKey #xF71B)
(define NSF25FunctionKey #xF71C)
(define NSF26FunctionKey #xF71D)
(define NSF27FunctionKey #xF71E)
(define NSF28FunctionKey #xF71F)
(define NSF29FunctionKey #xF720)
(define NSF30FunctionKey #xF721)
(define NSF31FunctionKey #xF722)
(define NSF32FunctionKey #xF723)
(define NSF33FunctionKey #xF724)
(define NSF34FunctionKey #xF725)
(define NSF35FunctionKey #xF726)
(define NSInsertFunctionKey #xF727)
(define NSDeleteFunctionKey #xF728)
(define NSHomeFunctionKey #xF729)
(define NSBeginFunctionKey #xF72A)
(define NSEndFunctionKey #xF72B)
(define NSPageUpFunctionKey #xF72C)
(define NSPageDownFunctionKey #xF72D)
(define NSPrintScreenFunctionKey #xF72E)
(define NSScrollLockFunctionKey #xF72F)
(define NSPauseFunctionKey #xF730)
(define NSSysReqFunctionKey #xF731)
(define NSBreakFunctionKey #xF732)
(define NSResetFunctionKey #xF733)
(define NSStopFunctionKey #xF734)
(define NSMenuFunctionKey #xF735)
(define NSUserFunctionKey #xF736)
(define NSSystemFunctionKey #xF737)
(define NSPrintFunctionKey #xF738)
(define NSClearLineFunctionKey #xF739)
(define NSClearDisplayFunctionKey #xF73A)
(define NSInsertLineFunctionKey #xF73B)
(define NSDeleteLineFunctionKey #xF73C)
(define NSInsertCharFunctionKey #xF73D)
(define NSDeleteCharFunctionKey #xF73E)
(define NSPrevFunctionKey #xF73F)
(define NSNextFunctionKey #xF740)
(define NSSelectFunctionKey #xF741)
(define NSExecuteFunctionKey #xF742)
(define NSUndoFunctionKey #xF743)
(define NSRedoFunctionKey #xF744)
(define NSFindFunctionKey #xF745)
(define NSHelpFunctionKey #xF746)
(define NSModeSwitchFunctionKey #xF747)
(hasheq
'start NSResetFunctionKey
'cancel NSStopFunctionKey
'clear NSClearDisplayFunctionKey
'menu NSMenuFunctionKey
'pause NSPauseFunctionKey
'prior NSPrevFunctionKey
'next NSNextFunctionKey
'end NSEndFunctionKey
'home NSHomeFunctionKey
'left NSLeftArrowFunctionKey
'up NSUpArrowFunctionKey
'right NSRightArrowFunctionKey
'down NSDownArrowFunctionKey
'escape 0
'select NSSelectFunctionKey
'print NSPrintFunctionKey
'execute NSExecuteFunctionKey
'snapshot 0
'insert NSInsertFunctionKey
'help NSHelpFunctionKey
'numpad0 0
'numpad1 0
'numpad2 0
'numpad3 0
'numpad4 0
'numpad5 0
'numpad6 0
'numpad7 0
'numpad8 0
'numpad9 0
'numpad-enter 0
'multiply 0
'add 0
'separator 0
'subtract 0
'decimal 0
'divide 0
'f1 NSF1FunctionKey
'f2 NSF2FunctionKey
'f3 NSF3FunctionKey
'f4 NSF4FunctionKey
'f5 NSF5FunctionKey
'f6 NSF6FunctionKey
'f7 NSF7FunctionKey
'f8 NSF8FunctionKey
'f9 NSF9FunctionKey
'f10 NSF10FunctionKey
'f11 NSF11FunctionKey
'f12 NSF12FunctionKey
'f13 NSF13FunctionKey
'f14 NSF14FunctionKey
'f15 NSF15FunctionKey
'f16 NSF16FunctionKey
'f17 NSF17FunctionKey
'f18 NSF18FunctionKey
'f19 NSF19FunctionKey
'f20 NSF20FunctionKey
'f21 NSF21FunctionKey
'f22 NSF22FunctionKey
'f23 NSF23FunctionKey
'f24 NSF24FunctionKey
'scroll NSScrollLockFunctionKey)))

3
collects/mred/private/wx/cocoa/platform.rkt
View File

@ -85,4 +85,5 @@
get-highlight-text-color
make-screen-bitmap
make-gl-bitmap
check-for-break))
check-for-break
key-symbol-to-menu-key))

4
collects/mred/private/wx/cocoa/procs.rkt
View File

@ -17,6 +17,7 @@
"menu-bar.rkt"
"agl.rkt"
"sound.rkt"
"keycode.rkt"
"../../lock.rkt"
"../common/handlers.rkt"
(except-in "../common/default-procs.rkt"
@ -59,7 +60,8 @@
flush-display
play-sound
file-creator-and-type
file-selector)
file-selector
key-symbol-to-menu-key)
(import-class NSScreen NSCursor)

53
collects/mred/private/wx/gtk/keycode.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(provide map-key-code)
(provide map-key-code
key-symbol-to-menu-key)
(define (map-key-code v)
(hash-ref
@ -27,7 +28,7 @@
(#xff93 . f3)
(#xff94 . f4)
(#xff95 . home) ; keypad
(#xff96 . left) ; keypd
(#xff96 . left) ; keypad
(#xff97 . up) ; keypad
(#xff98 . right) ; keypad
(#xff99 . down) ; keypad
@ -67,3 +68,51 @@
(#xffcc . f15))
v
#f))
(define (key-symbol-to-menu-key v)
(hash-ref
#hash((escape . #xff1b)
(home . #xff50)
(left . #xff51)
(up . #xff52)
(right . #xff53)
(down . #xff54)
(prior . #xff55)
(next . #xff56)
(end . #xff57)
(insert . #xff63)
(f1 . #xff91)
(f2 . #xff92)
(f3 . #xff93)
(f4 . #xff94)
(multiply . #xffaa)
(add . #xffab)
(subtract . #xffad)
(divide . #xffaf)
(numpad0 . #xffb0)
(numpad1 . #xffb1)
(numpad2 . #xffb2)
(numpad3 . #xffb3)
(numpad4 . #xffb4)
(numpad5 . #xffb5)
(numpad6 . #xffb6)
(numpad7 . #xffb7)
(numpad8 . #xffb8)
(numpad9 . #xffb9)
(f1 . #xffbe)
(f2 . #xffbf)
(f3 . #xffc0)
(f4 . #xffc1)
(f5 . #xffc2)
(f6 . #xffc3)
(f7 . #xffc4)
(f8 . #xffc5)
(f9 . #xffc6)
(f10 . #xffc7)
(f11 . #xffc8)
(f12 . #xffc9)
(f13 . #xffca)
(f14 . #xffcb)
(f15 . #xffcc))
v
#f))

31
collects/mred/private/wx/gtk/menu.rkt
View File

@ -166,18 +166,25 @@
(cb this e)))))))
(define/private (adjust-shortcut item-gtk title)
(cond
[(regexp-match #rx"\tCtrl[+](.)$" title)
=> (lambda (m)
(let ([code (gdk_unicode_to_keyval
(char->integer
(string-ref (cadr m) 0)))])
(unless (zero? code)
(let ([accel-path (format "<GRacket>/Hardwired/~a" title)])
(gtk_accel_map_add_entry accel-path
code
GDK_CONTROL_MASK)
(gtk_menu_item_set_accel_path item-gtk accel-path)))))]))
(printf "~s\n" title)
(let ([m (regexp-match #rx"\t(Ctrl[+])?(Shift[+])?(Meta[+])?(Alt[+])?(.|[0-9]+)$"
title)])
(when m
(let ([mask (+ (if (list-ref m 1) GDK_CONTROL_MASK 0)
(if (list-ref m 2) GDK_SHIFT_MASK 0)
(if (list-ref m 3) GDK_MOD1_MASK 0)
(if (list-ref m 4) GDK_META_MASK 0))]
[code (let ([s (list-ref m 5)])
(if (= 1 (string-length s))
(gdk_unicode_to_keyval
(char->integer (string-ref s 0)))
(string->number s)))])
(unless (zero? code)
(let ([accel-path (format "<GRacket>/Hardwired/~a" title)])
(gtk_accel_map_add_entry accel-path
code
mask)
(gtk_menu_item_set_accel_path item-gtk accel-path)))))))
(public [append-item append])
(define (append-item i label help-str-or-submenu chckable?)

3
collects/mred/private/wx/gtk/platform.rkt
View File

@ -86,4 +86,5 @@
get-highlight-text-color
make-screen-bitmap
make-gl-bitmap
check-for-break))
check-for-break
key-symbol-to-menu-key))

4
collects/mred/private/wx/gtk/procs.rkt
View File

@ -16,6 +16,7 @@
"queue.rkt"
"printer-dc.rkt"
"gl-context.rkt"
"keycode.rkt"
"../common/default-procs.rkt"
"../common/handlers.rkt")
@ -56,7 +57,8 @@
special-option-key
get-panel-background
fill-private-color
get-color-from-user)
get-color-from-user
key-symbol-to-menu-key)
(define (find-graphical-system-path what)
(case what

3
collects/mred/private/wx/platform.rkt
View File

@ -72,5 +72,6 @@
get-highlight-text-color
make-screen-bitmap
make-gl-bitmap
check-for-break)
check-for-break
key-symbol-to-menu-key)
((dynamic-require platform-lib 'platform-values)))

66
collects/mred/private/wx/win32/key.rkt
View File

@ -9,7 +9,8 @@
(provide
(protect-out make-key-event
generates-key-event?
reset-key-mapping))
reset-key-mapping
key-symbol-to-menu-key))
(define-user32 GetKeyState (_wfun _int -> _SHORT))
(define-user32 MapVirtualKeyW (_wfun _UINT _UINT -> _UINT))
@ -256,3 +257,66 @@
(send e set-other-shift-altgr-key-code (as-key other-shift-altgr)))
e))))))
(define (key-symbol-to-menu-key k)
(hash-ref keysyms k #f))
(define keysyms
'#hash((numpad5 . |Numpad 5|)
(numpad1 . |Numpad 1|)
(escape . Escape)
(right . Right)
(prior . Prior)
(cancel . Cancel)
(start . Start)
(f22 . F22)
(f17 . F17)
(f13 . F13)
(f8 . F8)
(f3 . F3)
(divide . Divide)
(add . Add)
(numpad8 . |Numpad 8|)
(numpad3 . |Numpad 3|)
(select . Select)
(down . Down)
(next . Next)
(clear . Clear)
(scroll . Scroll)
(f21 . F21)
(f16 . F16)
(f12 . F12)
(f9 . F9)
(f4 . F4)
(f1 . F1)
(separator . Separator)
(numpad9 . |Numpad 9|)
(numpad4 . |Numpad 4|)
(help . Help)
(execute . Execute)
(left . Left)
(end . End)
(menu . Menu)
(print . Print)
(f23 . F23)
(f18 . F18)
(f14 . F14)
(f7 . F7)
(f2 . F2)
(decimal . Decimal)
(multiply . Multiply)
(numpad7 . |Numpad 7|)
(numpad2 . |Numpad 2|)
(insert . Insert)
(snapshot . Snapshot)
(up . Up)
(home . Home)
(pause . Pause)
(f24 . F24)
(f19 . F19)
(f15 . F15)
(f11 . F11)
(f6 . F6)
(f5 . F5)
(subtract . Subtract)
(numpad-enter . |Numpad Enter|)
(numpad6 . |Numpad 6|)))

3
collects/mred/private/wx/win32/platform.rkt
View File

@ -86,4 +86,5 @@
get-highlight-text-color
make-screen-bitmap
make-gl-bitmap
check-for-break))
check-for-break
key-symbol-to-menu-key))

5
collects/mred/private/wx/win32/procs.rkt
View File

@ -16,6 +16,7 @@
"filedialog.rkt"
"colordialog.rkt"
"sound.rkt"
"key.rkt"
racket/draw)
(provide
@ -55,8 +56,8 @@
make-gl-bitmap
special-control-key
special-option-key
get-color-from-user)
get-color-from-user
key-symbol-to-menu-key)
(define (find-graphical-system-path what)
#f)

2
collects/scribblings/gui/checkable-menu-item-class.scrbl
View File

@ -13,7 +13,7 @@ A @scheme[checkable-menu-item%] is a string-labelled menu item that
[parent (or/c (is-a?/c menu% popup-menu%))]
[callback ((is-a?/c checkable-menu-item%) (is-a?/c control-event%) . -> . any)
(lambda (i e) (void))]
[shortcut (or/c char? false/c) #f]
[shortcut (or/c char? symbol? false/c) #f]
[help-string (or/c label-string? false/c) #f]
[demand-callback ((is-a?/c menu-item%) . -> . any)
(lambda (i) (void))]

2
collects/scribblings/gui/menu-item-class.scrbl
View File

@ -12,7 +12,7 @@ A @scheme[menu-item%] is a plain string-labelled menu item. Its
[parent (or/c (is-a?/c menu% popup-menu%))]
[callback ((is-a?/c menu-item%) (is-a?/c control-event%) . -> . any)
(lambda (i e) (void))]
[shortcut (or/c char? false/c) #f]
[shortcut (or/c char? symbol? false/c) #f]
[help-string (or/c label-string? false/c) #f]
[demand-callback ((is-a?/c menu-item%) . -> . any)
(lambda (i) (void))]

5
collects/scribblings/gui/selectable-menu-item-intf.scrbl
View File

@ -35,7 +35,10 @@ The shortcut part of a menu item name is not included in the label
returned by @method[labelled-menu-item<%> get-label].
For a list of allowed key symbols, see @xmethod[key-event%
get-key-code].
get-key-code], except that the following are disallowed:
@scheme['shift], @scheme['control], @scheme['numlock],
@scheme['scroll], @scheme['wheel-up], @scheme['wheel-down],
@scheme['release], and @scheme['press].
}