diff --git a/gui-doc/scribblings/framework/keymap.scrbl b/gui-doc/scribblings/framework/keymap.scrbl index d372a785..9476c1f2 100644 --- a/gui-doc/scribblings/framework/keymap.scrbl +++ b/gui-doc/scribblings/framework/keymap.scrbl @@ -19,9 +19,12 @@ @defmethod*[(((get-map-function-table/ht (ht hash?)) hash?))]{ This is a helper function for @method[keymap:aug-keymap<%> - get-map-function-table] that returns the same result, except it accepts a + get-map-function-table] that returns a similar result, except it accepts a hash-table that it inserts the bindings into. It does not replace any - bindings already in @racket[ht]. + bindings already in @racket[ht]. The result is different from + @method[keymap:aug-keymap<%> get-map-function-table] only in that + @racket[keymap:aug-keymap<%> get-map-function-table] will remove keybindings + that are also have a prefix (since those keybindings are not active). } } @defmixin[keymap:aug-keymap-mixin (keymap%) (keymap:aug-keymap<%>)]{ diff --git a/gui-lib/framework/private/keymap.rkt b/gui-lib/framework/private/keymap.rkt index 584eaf19..aecb0f57 100644 --- a/gui-lib/framework/private/keymap.rkt +++ b/gui-lib/framework/private/keymap.rkt @@ -148,7 +148,38 @@ (hash-set! function-table (string->symbol keyname) fname)) (define/public (get-map-function-table) - (get-map-function-table/ht (make-hasheq))) + (define table-possibly-with-prefixes (get-map-function-table/ht (make-hasheq))) + + (define trie (make-hash)) + (define (add-to-trie loks name) + (let loop ([trie trie] + [loks loks]) + (cond + [(null? (cdr loks)) + (hash-set! trie (car loks) name)] + [else + (define sub (hash-ref trie (car loks) + (λ () + (define h (make-hash)) + (hash-set! trie (car loks) h) + h))) + (loop sub (cdr loks))]))) + + (for ([(canonicalized-symbol keyname) (in-hash table-possibly-with-prefixes)]) + (define keys (regexp-split #rx";" (symbol->string canonicalized-symbol))) + (add-to-trie keys keyname)) + + (define table-without-prefixes (make-hash)) + (let loop ([trie trie] + [prefix '()]) + (cond + [(string? trie) + (define keystring (string->symbol (join-strings ";" (reverse prefix)))) + (hash-set! table-without-prefixes keystring trie)] + [else (for ([(key sub-trie) (in-hash trie)]) + (loop sub-trie (cons key prefix)))])) + + table-without-prefixes) (define/public (get-map-function-table/ht table) (for ([(keyname fname) (in-hash function-table)]) diff --git a/gui-test/framework/tests/keys.rkt b/gui-test/framework/tests/keys.rkt index b672495a..2b4beac4 100644 --- a/gui-test/framework/tests/keys.rkt +++ b/gui-test/framework/tests/keys.rkt @@ -89,6 +89,26 @@ (sort (hash-map (send k get-map-function-table) list) string