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

add support for alt-as-meta to the mac os x drracket

Browse Source
This commit is contained in:
Robby Findler 2013-11-28 20:24:40 -06:00
parent fbb16de871
commit d95a6b02b0
5 changed files with 90 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
pkgs/drracket-pkgs/drracket/scribblings/drracket/keybindings.scrbl
View File

@ -37,8 +37,11 @@ key. Depending on your keyboard, Meta may be called ``Left,''
``Right,'' or have a diamond symbol, but it's usually on the bottom ``Right,'' or have a diamond symbol, but it's usually on the bottom
row next to the space bar. M-@nonterm{key} can also be performed as a row next to the space bar. M-@nonterm{key} can also be performed as a
two-character sequence: first, strike and release the Escape key, then two-character sequence: first, strike and release the Escape key, then
strike @nonterm{key}. On Windows and Mac OS X, Meta is only strike @nonterm{key}. On Mac OS X, Meta is, by default,
available through the Escape key. available only through the Escape key. But the preferences dialog
(in the @onscreen{General} sub-panel of the @onscreen{Editing} panel)
has check boxes that adjust the handling of the Alt key or the Command
key to be meta.
DEL is the Delete key. DEL is the Delete key.

14
pkgs/gui-pkgs/gui-lib/framework/main.rkt
View File

@ -1187,9 +1187,12 @@
(proc-doc/names (proc-doc/names
keymap:send-map-function-meta keymap:send-map-function-meta
(->* ((is-a?/c keymap%) string? string?) (boolean?) void?) (->* ((is-a?/c keymap%) string? string?)
(boolean? #:alt-as-meta-keymap (or/c (is-a?/c keymap%) #f))
void?)
((keymap key func) ((keymap key func)
((mask-control? #f))) ((mask-control? #f)
(alt-as-meta-keymap #f)))
@{@index{Meta} Most keyboard and mouse mappings are inserted into a keymap by @{@index{Meta} Most keyboard and mouse mappings are inserted into a keymap by
calling the keymap's @method[keymap% map-function] method. However, calling the keymap's @method[keymap% map-function] method. However,
``meta'' combinations require special attention. The @racket["m:"] prefix ``meta'' combinations require special attention. The @racket["m:"] prefix
@ -1200,6 +1203,13 @@
This procedure binds all of the key-bindings obtained by prefixing This procedure binds all of the key-bindings obtained by prefixing
@racket[key] with a meta-prefix to @racket[func] in @racket[keymap]. @racket[key] with a meta-prefix to @racket[func] in @racket[keymap].
If @racket[alt-as-meta-keymap] is a @racket[keymap%] object, then the
the key binding @racket[(string-append "?:a:" key)] is bound to
@racket[func] in @racket[alt-as-meta-keymap]. Additionally, if
@racket[func] has not been added (via @method[add-function keymap%])
to @racket[alt-as-meta-keymap], then @racket[keymap:send-map-function-meta]
signals an error.
If @racket[mask-control?] is @racket[#t], If @racket[mask-control?] is @racket[#t],
then the result strings include @racket["~c:"] in them. then the result strings include @racket["~c:"] in them.
This is important under Windows where international keyboards This is important under Windows where international keyboards

105
pkgs/gui-pkgs/gui-lib/framework/private/keymap.rkt
View File

@ -213,12 +213,12 @@
;; if two key bindings refer to the same key. ;; if two key bindings refer to the same key.
;; Assumes a well-formed keystring. ;; Assumes a well-formed keystring.
(define (canonicalize-keybinding-string str) (define (canonicalize-keybinding-string str)
(let* ([chars (map char-downcase (string->list str))] (define chars (map char-downcase (string->list str)))
[separated-keys (define separated-keys
(map (map
canonicalize-single-keybinding-string canonicalize-single-keybinding-string
(split-out #\; chars))]) (split-out #\; chars)))
(join-strings ";" separated-keys))) (join-strings ";" separated-keys))
;; join-strings : string (listof string) -> string ;; join-strings : string (listof string) -> string
;; concatenates strs with sep between each of them ;; concatenates strs with sep between each of them
@ -334,9 +334,16 @@
(string-append "~c:m:" key)) (string-append "~c:m:" key))
(string-append "ESC;" key))) (string-append "ESC;" key)))
(define (send-map-function-meta keymap key func [mask-control? #f]) (define (send-map-function-meta keymap key func [mask-control? #f]
#:alt-as-meta-keymap [alt-as-meta-keymap #f])
(for ([key (in-list (make-meta-prefix-list key mask-control?))]) (for ([key (in-list (make-meta-prefix-list key mask-control?))])
(send keymap map-function key func))) (send keymap map-function key func))
(when alt-as-meta-keymap
(unless (send alt-as-meta-keymap is-function-added? func)
(error 'send-map-function-meta
"expected to find ~s mapped in alt-as-meta-keymap"
func))
(send alt-as-meta-keymap map-function (string-append "?:a:" key) func)))
(define has-control-regexp #rx"(?:^|:)c:") (define has-control-regexp #rx"(?:^|:)c:")
@ -1045,16 +1052,19 @@
(when (= start (send txt get-end-position)) (when (= start (send txt get-end-position))
(center-in-unicode-ascii-art-box txt start)))]) (center-in-unicode-ascii-art-box txt start)))])
(λ (kmap) (λ (kmap #:alt-as-meta-keymap [alt-as-meta-keymap #f])
(let* ([map (λ (key func) (let* ([map (λ (key func)
(send kmap map-function key func))] (send kmap map-function key func))]
[map-meta (λ (key func) [map-meta (λ (key func)
(send-map-function-meta kmap key func (send-map-function-meta kmap key func
(regexp-match has-control-regexp key)))] (regexp-match has-control-regexp key)
#:alt-as-meta-keymap alt-as-meta-keymap))]
[add (λ (name func) [add (λ (name func)
(send kmap add-function name func))] (send kmap add-function name func))]
[add-m (λ (name func) [add-m (λ (name func)
(send kmap add-function name func))]) (send kmap add-function name func)
(when alt-as-meta-keymap
(send alt-as-meta-keymap add-function name func)))])
; Map names to keyboard functions ; Map names to keyboard functions
@ -1073,12 +1083,12 @@
(add "TeX compress" TeX-compress) (add "TeX compress" TeX-compress)
(add "newline" newline) (add "newline" newline)
(add "down-into-embedded-editor" down-into-embedded-editor) (add-m "down-into-embedded-editor" down-into-embedded-editor)
(add "up-out-of-embedded-editor" up-out-of-embedded-editor) (add-m "up-out-of-embedded-editor" up-out-of-embedded-editor)
(add "forward-to-next-embedded-editor" forward-to-next-embedded-editor) (add-m "forward-to-next-embedded-editor" forward-to-next-embedded-editor)
(add "back-to-prev-embedded-editor" back-to-prev-embedded-editor) (add-m "back-to-prev-embedded-editor" back-to-prev-embedded-editor)
(add "toggle-overwrite (when enabled in prefs)" toggle-overwrite) (add-m "toggle-overwrite (when enabled in prefs)" toggle-overwrite)
(add "exit" (λ (edit event) (add "exit" (λ (edit event)
(let ([frame (send edit get-frame)]) (let ([frame (send edit get-frame)])
@ -1092,23 +1102,23 @@
(add "toggle-anchor" toggle-anchor) (add "toggle-anchor" toggle-anchor)
(add "center-view-on-line" center-view-on-line) (add "center-view-on-line" center-view-on-line)
(add "collapse-space" collapse-space) (add-m "collapse-space" collapse-space)
(add "remove-space" remove-space) (add "remove-space" remove-space)
(add "collapse-newline" collapse-newline) (add "collapse-newline" collapse-newline)
(add "open-line" open-line) (add "open-line" open-line)
(add "transpose-chars" transpose-chars) (add "transpose-chars" transpose-chars)
(add "transpose-words" transpose-words) (add-m "transpose-words" transpose-words)
(add "capitalize-word" capitalize-word) (add-m "capitalize-word" capitalize-word)
(add "upcase-word" upcase-word) (add-m "upcase-word" upcase-word)
(add "downcase-word" downcase-word) (add-m "downcase-word" downcase-word)
(add "kill-word" kill-word) (add-m "kill-word" kill-word)
(add "backward-kill-word" backward-kill-word) (add-m "backward-kill-word" backward-kill-word)
(let loop ([n 9]) (let loop ([n 9])
(unless (negative? n) (unless (negative? n)
(let ([s (number->string n)]) (let ([s (number->string n)])
(add (string-append "command-repeat-" s) (add-m (string-append "command-repeat-" s)
(make-make-repeater n)) (make-make-repeater n))
(loop (sub1 n))))) (loop (sub1 n)))))
(add "keyboard-macro-run-saved" do-macro) (add "keyboard-macro-run-saved" do-macro)
@ -1125,7 +1135,7 @@
(add-m "select-click-word" select-click-word) (add-m "select-click-word" select-click-word)
(add-m "select-click-line" select-click-line) (add-m "select-click-line" select-click-line)
(add "goto-line" goto-line) (add-m "goto-line" goto-line)
(add "delete-key" delete-key) (add "delete-key" delete-key)
@ -1353,16 +1363,19 @@
(invoke-method frame) (invoke-method frame)
(bell))) (bell)))
#t))]) #t))])
(λ (kmap) (λ (kmap #:alt-as-meta-keymap [alt-as-meta-keymap #f])
(let* ([map (λ (key func) (let* ([map (λ (key func)
(send kmap map-function key func))] (send kmap map-function key func))]
[map-meta (λ (key func) [map-meta (λ (key func)
(send-map-function-meta kmap key func (send-map-function-meta kmap key func
(regexp-match has-control-regexp key)))] (regexp-match has-control-regexp key)
#:alt-as-meta-keymap alt-as-meta-keymap))]
[add (λ (name func) [add (λ (name func)
(send kmap add-function name func))] (send kmap add-function name func))]
[add-m (λ (name func) [add-m (λ (name func)
(send kmap add-function name func))]) (send kmap add-function name func)
(when alt-as-meta-keymap
(send alt-as-meta-keymap add-function name func)))])
(add "search forward" (add "search forward"
(send-frame (λ (f) (send f search 'forward)))) (send-frame (λ (f) (send f search 'forward))))
@ -1420,16 +1433,19 @@
(let-values ([(base name dir) (split-path fn)]) (let-values ([(base name dir) (split-path fn)])
base)))) base))))
#t)]) #t)])
(λ (kmap) (λ (kmap #:alt-as-meta-keymap [alt-as-meta-keymap #f])
(let* ([map (λ (key func) (let* ([map (λ (key func)
(send kmap map-function key func))] (send kmap map-function key func))]
[map-meta (λ (key func) [map-meta (λ (key func)
(send-map-function-meta kmap key func (send-map-function-meta kmap key func
(regexp-match has-control-regexp key)))] (regexp-match has-control-regexp key)
#:alt-as-meta-keymap alt-as-meta-keymap))]
[add (λ (name func) [add (λ (name func)
(send kmap add-function name func))] (send kmap add-function name func))]
[add-m (λ (name func) [add-m (λ (name func)
(send kmap add-function name func))]) (send kmap add-function name func)
(when alt-as-meta-keymap
(send alt-as-meta-keymap add-function name func)))])
(add "save-file" save-file) (add "save-file" save-file)
(add "save-file-as" save-file-as) (add "save-file-as" save-file-as)
@ -1457,7 +1473,7 @@
func))]) func))])
(add/map "editor-undo" 'undo "z") (add/map "editor-undo" 'undo "z")
(unless (eq? (system-type) 'macosx) (unless (eq? (system-type) 'macosx)
(add/map "editor-redo" 'redo "y")) (add/map "editor-redo" 'redo "y"))
(add/map "editor-cut" 'cut "x") (add/map "editor-cut" 'cut "x")
(add/map "editor-copy" 'copy "c") (add/map "editor-copy" 'copy "c")
(add/map "editor-paste" 'paste "v") (add/map "editor-paste" 'paste "v")
@ -1473,25 +1489,42 @@
(define global (make-object aug-keymap%)) (define global (make-object aug-keymap%))
(define global-main (make-object aug-keymap%)) (define global-main (make-object aug-keymap%))
(define global-alt-as-meta (make-object aug-keymap%))
(send global chain-to-keymap global-main #f) (send global chain-to-keymap global-main #f)
(generic-setup global-main) (generic-setup global-main)
(setup-global global-main) (generic-setup global-alt-as-meta)
(setup-global global-main #:alt-as-meta-keymap global-alt-as-meta)
(define (get-global) global) (define (get-global) global)
(define file (make-object aug-keymap%)) (define file (make-object aug-keymap%))
(define file-alt-as-meta (make-object aug-keymap%))
(generic-setup file) (generic-setup file)
(setup-file file) (setup-file file #:alt-as-meta-keymap file-alt-as-meta)
(define (-get-file) file) (define (-get-file) file)
(define search (make-object aug-keymap%)) (define search (make-object aug-keymap%))
(define search-alt-as-meta (make-object aug-keymap%))
(generic-setup search) (generic-setup search)
(setup-search search) (setup-search search #:alt-as-meta-keymap search-alt-as-meta)
(define (get-search) search) (define (get-search) search)
(define editor (make-object aug-keymap%)) (define editor (make-object aug-keymap%))
(setup-editor editor) (setup-editor editor)
(define (get-editor) editor) (define (get-editor) editor)
(preferences:set-default 'framework:alt-as-meta #f boolean?)
(define (adjust-alt-as-meta on?)
(send global-main remove-chained-keymap global-alt-as-meta)
(send file remove-chained-keymap file-alt-as-meta)
(send search remove-chained-keymap search-alt-as-meta)
(when on?
(send global-main chain-to-keymap global-alt-as-meta #f)
(send file chain-to-keymap file-alt-as-meta #f)
(send search chain-to-keymap search-alt-as-meta #f)))
(preferences:add-callback 'framework:alt-as-meta
(λ (p v) (adjust-alt-as-meta v)))
(adjust-alt-as-meta (preferences:get 'framework:alt-as-meta))
(define (call/text-keymap-initializer thunk) (define (call/text-keymap-initializer thunk)
(let ([ctki (current-text-keymap-initializer)]) (let ([ctki (current-text-keymap-initializer)])
(parameterize ([current-text-keymap-initializer (parameterize ([current-text-keymap-initializer

3
pkgs/gui-pkgs/gui-lib/framework/private/preferences.rkt
View File

@ -467,6 +467,9 @@ the state transitions / contracts are:
'framework:menu-bindings 'framework:menu-bindings
(string-constant enable-keybindings-in-menus)) (string-constant enable-keybindings-in-menus))
(when (memq (system-type) '(macosx)) (when (memq (system-type) '(macosx))
(add-check editor-panel
'framework:alt-as-meta
(string-constant alt-as-meta))
(add-check editor-panel (add-check editor-panel
'framework:special-meta-key 'framework:special-meta-key
(string-constant command-as-meta))) (string-constant command-as-meta)))

1
pkgs/string-constants-pkgs/string-constants-lib/string-constants/private/english-string-constants.rkt
View File

@ -531,6 +531,7 @@ please adhere to these guidelines:
(print-to-ps "Print to PostScript File") (print-to-ps "Print to PostScript File")
(print-to-pdf "Print to PDF File") (print-to-pdf "Print to PDF File")
(command-as-meta "Treat command key as meta") ;; macos/macos x only (command-as-meta "Treat command key as meta") ;; macos/macos x only
(alt-as-meta "Treat alt key as meta")
(reuse-existing-frames "Reuse existing frames when opening new files") (reuse-existing-frames "Reuse existing frames when opening new files")
(default-fonts "Default Fonts") (default-fonts "Default Fonts")
(basic-gray-paren-match-color "Basic gray parenthesis highlight color") ; in prefs dialog (basic-gray-paren-match-color "Basic gray parenthesis highlight color") ; in prefs dialog