fixed bug in the way aug:keymap extracts the names

now it should return only the canonical names of the keybindings
(instead of potentially returning both the canonical and
non-canonicalized names)
This commit is contained in:
Robby Findler 2012-01-08 07:07:56 -06:00
parent 3bc1e8f3c0
commit 95ac3c86f7
2 changed files with 25 additions and 12 deletions

View File

@ -150,18 +150,15 @@
(get-map-function-table/ht (make-hasheq)))
(define/public (get-map-function-table/ht table)
(hash-for-each
function-table
(λ (keyname fname)
(unless (hash-ref table keyname (λ () #f))
(let ([cs (canonicalize-keybinding-string (format "~a" keyname))])
(when (on-this-platform? cs)
(hash-set! table keyname fname))))))
(for-each
(λ (chained-keymap)
(when (is-a? chained-keymap aug-keymap<%>)
(send chained-keymap get-map-function-table/ht table)))
chained-keymaps)
(for ([(keyname fname) (in-hash function-table)])
(define cs (canonicalize-keybinding-string (format "~a" keyname)))
(define key (string->symbol cs))
(unless (hash-ref table key #f)
(when (on-this-platform? cs)
(hash-set! table key fname))))
(for ([chained-keymap (in-list chained-keymaps)])
(when (is-a? chained-keymap aug-keymap<%>)
(send chained-keymap get-map-function-table/ht table)))
table)
(define/private (on-this-platform? cs)

View File

@ -58,6 +58,21 @@
(send k chain-to-keymap k1 #t)
(hash-map (send k get-map-function-table) list)))))
(test
'keymap:aug-keymap%/get-table/normalize-case
(lambda (x)
(equal? x '((|esc;p| "abc-k2"))))
(lambda ()
(queue-sexp-to-mred
'(let ([k (make-object keymap:aug-keymap%)]
[k1 (make-object keymap:aug-keymap%)])
(send k1 add-function "abc-k1" void)
(send k1 map-function "esc;p" "abc-k1")
(send k add-function "abc-k2" void)
(send k map-function "ESC;p" "abc-k2")
(send k chain-to-keymap k1 #t)
(hash-map (send k get-map-function-table) list)))))
(define (test-canonicalize name str1 str2)
(test
(string->symbol (format "keymap:canonicalize-keybinding-string/~a" name))
@ -79,6 +94,7 @@
(test-canonicalize 10 ":d:a" "~a:~c:d:~m:~s:a")
(test-canonicalize 11 "esc;s:a" "esc;s:a")
(test-canonicalize 12 "s:a;esc" "s:a;esc")
(test-canonicalize 13 "ESC;p" "esc;p")
;; a key-spec is (make-key-spec buff-spec buff-spec (listof ?) (listof ?) (listof ?))