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

fixed up code that populates the keybindings menu, added more bindings for the greek letters

Browse Source 
svn: r7486

original commit: 2b6bcf6025f746c61a6f6cd689beb29b22019613
This commit is contained in:
Robby Findler 2007-10-11 13:00:57 +00:00
parent 5d6b0a0dec
commit 16ebbf15d4
1 changed files with 39 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
collects/framework/private/keymap.ss
View File

@ -128,15 +128,9 @@
function-table
(λ (keyname fname)
(unless (hash-table-get table keyname (λ () #f))
(cond
[(and (eq? (system-type) 'windows)
(let ([cs (canonicalize-keybinding-string (format "~a" keyname))])
(or (regexp-match #rx"a:c" cs)
(regexp-match #rx"c:m" cs))))
(void) ;; don't show these keybindigns -- they don't work
]
[else
(hash-table-put! table keyname fname)]))))
(when (on-this-platform? cs)
(hash-table-put! table keyname fname))))))
(for-each
(λ (chained-keymap)
(when (is-a? chained-keymap aug-keymap<%>)
@ -144,6 +138,38 @@
chained-keymaps)
table)
(define/private (on-this-platform? cs)
(let* ([splits (map (λ (x) (all-but-last (split-out #\: x))) (split-out #\; (string->list cs)))]
[has-key? (λ (k) (ormap (λ (x) (member (list k) x)) splits))])
(cond
[(eq? (system-type) 'windows)
(cond
[(or (regexp-match #rx"a:c" cs)
(regexp-match #rx"c:m" cs))
#f]
[(or (has-key? #\a) (has-key? #\d))
#f]
[else #t])]
[(eq? (system-type) 'macosx)
(cond
[(has-key? #\m)
#f]
[else #t])]
[(eq? (system-type) 'unix)
(cond
[(or (has-key? #\a) (has-key? #\d))
#f]
[else #t])]
[else
;; just in case new platforms come along ....
#t])))
(define/private (all-but-last l)
(cond
[(null? l) l]
[(null? (cdr l)) l]
[else (cons (car l) (all-but-last (cdr l)))]))
(super-new)))
(define aug-keymap% (aug-keymap-mixin keymap%))
@ -1023,6 +1049,10 @@
(if shift? "s:" "")
roman-char)
(format "insert ~a" greek-char))
(map (format "m:x;c:g;~a~a"
(if shift? "s:" "")
roman-char)
(format "insert ~a" greek-char))
(map (format "c:x;c:g;~a~a"
(if shift? "s:" "")
roman-char)