From dd8000240ea732546cbf22fba2255d3a8d75f522 Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Sat, 26 Aug 2006 07:04:02 +0000
Subject: [PATCH] Fix bug with commands from parents not working correctly in
 keyboard help window

---
 TODO.FACTOR.txt                         |  3 ++-
 library/tools/definitions.factor        |  7 ++++-
 library/ui/commands.factor              | 10 +++++---
 library/ui/gadgets/presentations.factor | 34 +++++++++++--------------
 library/ui/gadgets/theme.factor         |  3 ++-
 library/ui/gadgets/tracks.factor        |  2 +-
 library/ui/ui.factor                    |  6 ++---
 7 files changed, 36 insertions(+), 29 deletions(-)

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 4d7b6002a8..a13adbf5d4 100644
--- a/TODO.FACTOR.txt
+++ b/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
diff --git a/library/tools/definitions.factor b/library/tools/definitions.factor
index 948cf16adc..2113aedfb8 100644
--- a/library/tools/definitions.factor
+++ b/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 -- )
 
diff --git a/library/ui/commands.factor b/library/ui/commands.factor
index bf3787f973..38bdca99ed 100644
--- a/library/ui/commands.factor
+++ b/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 )
-    parents [ commands ] map concat prune
-    [ [ command-name ] 2apply <=> ] sort ;
+: all-commands ( gadget -- assoc )
+    [
+        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 ] }
diff --git a/library/ui/gadgets/presentations.factor b/library/ui/gadgets/presentations.factor
index a75873c98f..1e58c7b2ac 100644
--- a/library/ui/gadgets/presentations.factor
+++ b/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
-kernel prettyprint sequences strings styles words help math
-models ;
+gadgets-panes gadgets-paragraphs gadgets-theme generic
+hashtables inspector io kernel prettyprint sequences strings
+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
-            dup length [ 2array ] 2map
-            [ first ] subset
-            [
-                first2 swap command-name
-                >r number>string " " r>
-                append3
-            ] map " " join
-        ] [
-            ""
-        ] if*
-    ] <filter> <label-control> ;
+        presentation-commands
+        dup length [ 2array ] 2map [ first ] subset
+        [ first2 "Button " % 1+ # ": " % command-name % ]
+        [ "  " % ] interleave
+    ] "" make ;
+
+: <presentation-mouse-help> ( model -- help )
+    [ [ presentation-mouse-help ] [ "" ] if* ]
+    <filter> <label-control> dup reverse-video-theme ;
 
 : <presentation-help> ( model -- gadget )
-    dup <presentation-summary> swap <presentation-mouse-help>
-    2array make-pile ;
+    dup <presentation-mouse-help> swap <presentation-summary>
+    2array make-pile 1 over set-pack-fill ;
 
 ! Character styles
 
diff --git a/library/ui/gadgets/theme.factor b/library/ui/gadgets/theme.factor
index 40ddea697c..673893ff52 100644
--- a/library/ui/gadgets/theme.factor
+++ b/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 -- )
diff --git a/library/ui/gadgets/tracks.factor b/library/ui/gadgets/tracks.factor
index f53d57ecbf..f43d6db6df 100644
--- a/library/ui/gadgets/tracks.factor
+++ b/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 ;
diff --git a/library/ui/ui.factor b/library/ui/ui.factor
index 7a57b4b39a..ac6d219aff 100644
--- a/library/ui/ui.factor
+++ b/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
-    [ command-description ] map-with
+    [ first command-gesture key-down? ] subset
+    [ first2 swap command-description ] map
     { "Command" "Gesture" } add* $table ;
 
 : pane-window ( quot title -- )