Fix bug with commands from parents not working correctly in keyboard help window

TODO.FACTOR.txt

@@ -1,6 +1,7 @@
 + 0.84:
 
-- click button in commands list doesn't unhighlight it
+- default font should not be monospaced
+- better looking status bar
 - new browser:
   - show currently selected vocab & words
   - scroll to existing won't work

library/tools/definitions.factor

@@ -20,7 +20,12 @@ SYMBOL: edit-hook
 : edit-location ( file line -- )
     edit-hook get [ call ] [ <no-edit-hook> throw ] if* ;
 
-: edit ( defspec -- ) where first2 edit-location ;
+: edit ( defspec -- )
+    where [
+        first2 edit-location
+    ] [
+        "Not from a source file" throw
+    ] if ;
 
 GENERIC: synopsis ( defspec -- )
 

library/ui/commands.factor

@@ -35,9 +35,13 @@ M: object gesture>string drop f ;
 : commands ( gadget -- seq )
     delegates [ class "commands" word-prop ] map concat ;
 
-: all-commands ( gadget -- seq )
+: all-commands ( gadget -- assoc )
-    parents [ commands ] map concat prune
+    [
-    [ [ command-name ] 2apply <=> ] sort ;
+        parents [
+            dup commands [ set ] each-with
+        ] each
+    ] make-hash
+    hash>alist [ [ first command-name ] 2apply <=> ] sort ;
 
 world {
     { f "Cut" T{ key-down f { C+ } "x" } [ T{ cut-action } send-action ] }

library/ui/gadgets/presentations.factor

@@ -3,9 +3,9 @@
 IN: gadgets-presentations
 USING: arrays definitions gadgets gadgets-borders
 gadgets-buttons gadgets-grids gadgets-labels gadgets-outliner
-gadgets-panes gadgets-paragraphs generic hashtables inspector io
+gadgets-panes gadgets-paragraphs gadgets-theme generic
-kernel prettyprint sequences strings styles words help math
+hashtables inspector io kernel prettyprint sequences strings
-models ;
+styles words help math models namespaces ;
 
 ! Clickable objects
 TUPLE: presentation object commands ;
@@ -49,25 +49,21 @@ presentation H{
     [ [ presentation-object summary ] [ "" ] if* ]
     <filter> <label-control> ;
 
-: <presentation-mouse-help> ( model -- help )
+: presentation-mouse-help ( presentation -- string )
     [
-        [
+        presentation-commands
-            presentation-commands
+        dup length [ 2array ] 2map [ first ] subset
-            dup length [ 2array ] 2map
+        [ first2 "Button " % 1+ # ": " % command-name % ]
-            [ first ] subset
+        [ "  " % ] interleave
-            [
+    ] "" make ;
-                first2 swap command-name
+
-                >r number>string " " r>
+: <presentation-mouse-help> ( model -- help )
-                append3
+    [ [ presentation-mouse-help ] [ "" ] if* ]
-            ] map " " join
+    <filter> <label-control> dup reverse-video-theme ;
-        ] [
-            ""
-        ] if*
-    ] <filter> <label-control> ;
 
 : <presentation-help> ( model -- gadget )
-    dup <presentation-summary> swap <presentation-mouse-help>
+    dup <presentation-mouse-help> swap <presentation-summary>
-    2array make-pile ;
+    2array make-pile 1 over set-pack-fill ;
 
 ! Character styles
 

library/ui/gadgets/theme.factor

@@ -86,7 +86,8 @@ USING: arrays gadgets kernel sequences styles ;
         { 0.5 0.5 0.5 1.0 }
     } } swap set-gadget-interior ;
 
-: reverse-video-theme ( gadget -- )
+: reverse-video-theme ( label -- )
+    { 1.0 1.0 1.0 1.0 } over set-label-color
     solid-black swap set-gadget-interior ;
 
 : label-theme ( gadget -- )

library/ui/gadgets/tracks.factor

@@ -100,7 +100,7 @@ divider H{
 } set-gestures
 
 C: divider ( -- divider )
-    dup delegate>gadget dup reverse-video-theme ;
+    dup delegate>gadget dup highlight-theme ;
 
 : normalize-sizes ( sizes -- sizes )
     dup sum swap [ swap / ] map-with ;

library/ui/ui.factor

@@ -144,7 +144,7 @@ C: titled-gadget ( gadget title -- )
 
 : $gadget ( element -- ) first gadget. ;
 
-: command-description ( command -- element )
+: command-description ( target command -- element )
     [ <command-presentation> \ $gadget swap 2array ] keep
     command-gesture gesture>string 2array ;
 
@@ -155,8 +155,8 @@ C: titled-gadget ( gadget title -- )
 : commands. ( gadget -- )
     dup gadget-info
     dup all-commands
-    [ command-gesture key-down? ] subset
+    [ first command-gesture key-down? ] subset
-    [ command-description ] map-with
+    [ first2 swap command-description ] map
     { "Command" "Gesture" } add* $table ;
 
 : pane-window ( quot title -- )