fix the "Show Active Keybindings" menu item

for the case where one keybinding's keys is a prefix of anothers (and the keymaps are chained)

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<%>)]{

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)])

gui-test/framework/tests/keys.rkt

@@ -89,6 +89,26 @@
        (sort (hash-map (send k get-map-function-table) list)
              string<?
              #:key (lambda (x) (format "~s" x)))))))
+
+(test
+ 'keymap:aug-keymap%/longer-name
+ (lambda (x)
+   (equal? x '((|c:x;r| "swap if branches"))))
+ (lambda ()
+   (queue-sexp-to-mred
+    '(let ()
+       (define k0 (new keymap:aug-keymap%))
+       (define k1 (new keymap:aug-keymap%))
+       (define k2 (new keymap:aug-keymap%))
+       (send k1 add-function "rectangle" void)
+       (send k1 map-function "c:x;r;a" "rectangle")
+       (send k2 add-function "swap if branches" void)
+       (send k2 map-function "c:x;r" "swap if branches")
+       (send k0 chain-to-keymap k1 #t)
+       (send k0 chain-to-keymap k2 #t)
+       (sort (hash-map (send k0 get-map-function-table) list)
+             string<?
+             #:key (lambda (x) (format "~s" x)))))))
   
   (define (test-canonicalize name str1 str2)
     (test