finish implementing display of menu shortcuts

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

View File

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

View File

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

View File

@ -1,6 +1,7 @@
#lang racket/base #lang racket/base
(provide map-key-code) (provide map-key-code
key-symbol-to-menu-key)
(define (map-key-code v) (define (map-key-code v)
(hash-ref (hash-ref
@ -54,3 +55,145 @@
(92 . numpad9)) (92 . numpad9))
v v
#f)) #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)))

View File

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

View File

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

View File

@ -1,6 +1,7 @@
#lang racket/base #lang racket/base
(provide map-key-code) (provide map-key-code
key-symbol-to-menu-key)
(define (map-key-code v) (define (map-key-code v)
(hash-ref (hash-ref
@ -27,7 +28,7 @@
(#xff93 . f3) (#xff93 . f3)
(#xff94 . f4) (#xff94 . f4)
(#xff95 . home) ; keypad (#xff95 . home) ; keypad
(#xff96 . left) ; keypd (#xff96 . left) ; keypad
(#xff97 . up) ; keypad (#xff97 . up) ; keypad
(#xff98 . right) ; keypad (#xff98 . right) ; keypad
(#xff99 . down) ; keypad (#xff99 . down) ; keypad
@ -67,3 +68,51 @@
(#xffcc . f15)) (#xffcc . f15))
v v
#f)) #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))

View File

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

View File

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

View File

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

View File

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

View File

@ -9,7 +9,8 @@
(provide (provide
(protect-out make-key-event (protect-out make-key-event
generates-key-event? generates-key-event?
reset-key-mapping)) reset-key-mapping
key-symbol-to-menu-key))
(define-user32 GetKeyState (_wfun _int -> _SHORT)) (define-user32 GetKeyState (_wfun _int -> _SHORT))
(define-user32 MapVirtualKeyW (_wfun _UINT _UINT -> _UINT)) (define-user32 MapVirtualKeyW (_wfun _UINT _UINT -> _UINT))
@ -256,3 +257,66 @@
(send e set-other-shift-altgr-key-code (as-key other-shift-altgr))) (send e set-other-shift-altgr-key-code (as-key other-shift-altgr)))
e)))))) 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|)))

View File

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

View File

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

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%))] [parent (or/c (is-a?/c menu% popup-menu%))]
[callback ((is-a?/c checkable-menu-item%) (is-a?/c control-event%) . -> . any) [callback ((is-a?/c checkable-menu-item%) (is-a?/c control-event%) . -> . any)
(lambda (i e) (void))] (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] [help-string (or/c label-string? false/c) #f]
[demand-callback ((is-a?/c menu-item%) . -> . any) [demand-callback ((is-a?/c menu-item%) . -> . any)
(lambda (i) (void))] (lambda (i) (void))]

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%))] [parent (or/c (is-a?/c menu% popup-menu%))]
[callback ((is-a?/c menu-item%) (is-a?/c control-event%) . -> . any) [callback ((is-a?/c menu-item%) (is-a?/c control-event%) . -> . any)
(lambda (i e) (void))] (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] [help-string (or/c label-string? false/c) #f]
[demand-callback ((is-a?/c menu-item%) . -> . any) [demand-callback ((is-a?/c menu-item%) . -> . any)
(lambda (i) (void))] (lambda (i) (void))]

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]. returned by @method[labelled-menu-item<%> get-label].
For a list of allowed key symbols, see @xmethod[key-event% 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].
} }