Presentation cleanups and mouse help

contrib/httpd/browser-responder.factor

@@ -56,7 +56,7 @@ namespaces prettyprint sequences words xml ;
 
 : browser-title ( -- str )
     current-word
-    [ synopsis ] [ "IN: " current-vocab append ] if* ;
+    [ summary ] [ "IN: " current-vocab append ] if* ;
 
 : browser-responder ( -- )
     #! Display a Smalltalk like browser for exploring words.

library/bootstrap/boot-stage1.factor

@@ -95,11 +95,11 @@ sequences vectors words ;
         "/library/compiler/alien/aliens.factor"
         
         "/library/syntax/prettyprint.factor"
+        "/library/tools/summary.factor"
         "/library/syntax/parser.factor"
         "/library/syntax/parse-stream.factor"
 
         "/library/tools/definitions.factor"
-        "/library/tools/summary.factor"
         "/library/tools/describe.factor"
 
         "/library/help/stylesheet.factor"

library/definitions.factor

@@ -12,5 +12,3 @@ GENERIC: subdefs ( defspec -- seq )
 : see-subdefs ( word -- ) subdefs [ see ] each ;
 
 GENERIC: forget ( defspec -- )
-
-GENERIC: synopsis ( defspec -- str )

library/definitions.facts

@@ -12,8 +12,3 @@ HELP: where
 HELP: forget
 { $values { "defspec" "a definition specifier" } }
 { $description "Forgets about a definition. For example, if it is a word, it will be removed from its vocabulary." } ;
-
-HELP: synopsis
-{ $values { "defspec" "a definition specifier" } { "str" "a string" } }
-{ $contract "Outputs a short string describing the definition in Factor pseudo-code." }
-{ $examples { $example "\\ append synopsis print" "IN: sequences : append ( seq1 seq2 -- seq )" } } ;

library/help/topics.factor

@@ -76,7 +76,7 @@ DEFER: $subsection
 ! Definition protocol
 M: link where* link-name article article-loc ;
 
-M: link (synopsis)
+M: link synopsis
     \ ARTICLE: pprint-word
     dup link-name pprint*
     article-title pprint* ;
@@ -89,7 +89,7 @@ PREDICATE: link word-link link-name word? ;
 
 M: word-link where* link-name "help-loc" word-prop ;
 
-M: word-link (synopsis)
+M: word-link synopsis
     \ HELP: pprint-word
     link-name dup pprint-word
     stack-effect effect>string comment. ;

library/syntax/parser.factor

@@ -28,7 +28,7 @@ SYMBOL: string-mode
 
 : do-what-i-mean ( string -- restarts )
     words-named natural-sort [
-        [ "Use the word " swap synopsis append ] keep 2array
+        [ "Use the word " swap summary append ] keep 2array
     ] map ;
 
 TUPLE: no-word name ;

library/tools/debugger.factor

@@ -37,7 +37,9 @@ SYMBOL: restarts
     restarts get nth first3 continue-with ;
 
 : :edit ( -- )
-    error get dup parse-error-file swap parse-error-line
+    error get
+    dup parse-error-file ?resource-path
+    swap parse-error-line
     edit-location ;
 
 : (:help-multi)

library/tools/definitions.factor

@@ -22,7 +22,7 @@ SYMBOL: edit-hook
 
 : edit ( defspec -- ) where first2 edit-location ;
 
-GENERIC: (synopsis) ( defspec -- )
+GENERIC: synopsis ( defspec -- )
 
 : write-vocab ( vocab -- )
     dup <vocab-link> presented associate styled-text ;
@@ -35,17 +35,17 @@ GENERIC: (synopsis) ( defspec -- )
 : comment. ( string -- )
     [ H{ { font-style italic } } styled-text ] when* ;
 
-M: word (synopsis)
+M: word synopsis
     dup in.
     dup definer pprint-word
     dup pprint-word
     stack-effect [ effect>string comment. ] when* ;
 
-M: method-spec (synopsis)
+M: method-spec synopsis
     \ M: pprint-word [ pprint-word ] each ;
 
-: synopsis ( defspec -- str )
-    [ 0 margin set [ (synopsis) ] with-pprint ] string-out ;
+M: word summary ( defspec -- str )
+    [ 0 margin set [ synopsis ] with-pprint ] string-out ;
 
 GENERIC: definition ( spec -- quot ? )
 
@@ -75,7 +75,7 @@ M: word declarations.
 
 : (see) ( spec -- )
     [
-        dup (synopsis)
+        dup synopsis
         dup definition [
             H{ } <block
             pprint-elements pprint-; declarations.

library/tools/definitions.facts

@@ -1,5 +1,5 @@
 IN: definitions
-USING: help io ;
+USING: help io prettyprint ;
 
 HELP: ?resource-path
 { $values { "path" "a string" } { "newpath" "a string" } }
@@ -23,10 +23,11 @@ HELP: in.
 { $description "Prettyprints a " { $snippet "IN:" } " declaration for the word." }
 $prettyprinting-note ;
 
-HELP: (synopsis)
+HELP: synopsis
 { $values { "defspec" "a definition specifier" } }
 { $contract "Prettyprints the prologue of a definition." }
-$prettyprinting-note ;
+$prettyprinting-note
+{ $see-also summary } ;
 
 HELP: comment.
 { $values { "string" "a string" } }

library/tools/summary.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: inspector
+IN: prettyprint
 USING: generic kernel namespaces prettyprint sequences strings
 styles words ;
 
@@ -9,15 +9,6 @@ GENERIC: summary ( object -- string )
 M: object summary
     "an instance of the " swap class word-name " class" append3 ;
 
-M: word summary
-    dup word-vocabulary [
-        dup interned?
-        "a word in the " "a word orphaned from the " ?
-        swap word-vocabulary " vocabulary" append3
-    ] [
-        drop "a uniquely generated symbol"
-    ] if ;
-
 M: input summary
     "Input: " swap input-string
     dup string? [ unparse-short ] unless append ;

library/tools/summary.facts

@@ -1,4 +1,4 @@
-IN: inspector
+IN: prettyprint
 USING: help ;
 
 HELP: summary

library/tools/word-tools.factor

@@ -6,7 +6,7 @@ math namespaces prettyprint sequences strings styles ;
 
 : word-outliner ( word quot -- )
     swap natural-sort [
-        dup rot curry >r [ synopsis ] keep r>
+        dup rot curry >r [ summary ] keep r>
         write-outliner terpri
     ] each-with ;
 

library/ui/gadgets/presentations.factor

@@ -4,7 +4,8 @@ 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 ;
+kernel prettyprint sequences strings styles words help math
+models ;
 
 ! Clickable objects
 TUPLE: presentation object commands ;
@@ -14,9 +15,6 @@ C: presentation ( button object commands -- button )
     [ set-presentation-object ] keep
     [ set-gadget-delegate ] keep ;
 
-M: presentation gadget-help
-    presentation-object dup word? [ synopsis ] [ summary ] if ;
-
 : <object-presentation> ( gadget object -- button )
     >r f <roll-button> r>
     dup object-operations <presentation> ;
@@ -32,12 +30,45 @@ M: presentation gadget-help
         drop
     ] if* ;
 
+: show-mouse-help ( presentation -- )
+    dup find-world [ world-status set-model ] [ drop ] if* ;
+
+: hide-mouse-help ( presentation -- )
+    find-world [ world-status f swap set-model ] when* ;
+
 presentation H{
-    { T{ button-up f 1 } [ 1 invoke-presentation ] }
-    { T{ button-up f 2 } [ 2 invoke-presentation ] }
-    { T{ button-up f 3 } [ 3 invoke-presentation ] }
+    { T{ button-up f 1 } [ [ 1 invoke-presentation ] if-clicked ] }
+    { T{ button-up f 2 } [ [ 2 invoke-presentation ] if-clicked ] }
+    { T{ button-up f 3 } [ [ 3 invoke-presentation ] if-clicked ] }
+    { T{ mouse-leave } [ dup hide-mouse-help button-update ] }
+    { T{ mouse-enter } [ dup show-mouse-help button-update ] }
 } set-gestures
 
+! Presentation help bar
+: <presentation-summary> ( model -- )
+    [ [ presentation-object summary ] [ "" ] if* ]
+    <filter> <label-control> ;
+
+: <presentation-mouse-help> ( model -- help )
+    [
+        [
+            presentation-commands
+            dup length [ 2array ] 2map
+            [ first ] subset
+            [
+                first2 swap command-name
+                >r number>string " " r>
+                append3
+            ] map " " join
+        ] [
+            ""
+        ] if*
+    ] <filter> <label-control> ;
+
+: <presentation-help> ( model -- gadget )
+    dup <presentation-summary> swap <presentation-mouse-help>
+    2array make-pile ;
+
 ! Character styles
 
 : apply-style ( style gadget key quot -- style gadget )

library/ui/gestures.factor

@@ -146,15 +146,6 @@ V{ } clone hand-buttons set-global
 : relevant-help ( seq -- help )
     [ gadget-help ] map [ ] find nip ;
 
-: show-message ( string/f world -- )
-    #! Show a message in the status bar.
-    world-status set-model* ;
-
-: update-help ( -- )
-    #! Update mouse-over help message.
-    hand-gadget get-global parents [ relevant-help ] keep
-    dup empty? [ 2drop ] [ peek show-message ] if ;
-
 : under-hand ( -- seq )
     #! A sequence whose first element is the world and last is
     #! the current gadget, with all parents in between.
@@ -163,7 +154,7 @@ V{ } clone hand-buttons set-global
 : move-hand ( loc world -- )
     under-hand >r over hand-loc set-global
     pick-up hand-gadget set-global
-    under-hand r> hand-gestures update-help ;
+    under-hand r> hand-gestures ;
 
 : update-clicked ( loc world -- )
     move-hand

library/ui/ui.factor

@@ -70,8 +70,7 @@ C: titled-gadget ( gadget title -- )
     { { f f f @center } } make-frame* ;
 
 : init-status ( world -- )
-    dup world-status <label-control> dup highlight-theme
-    swap @bottom grid-add ;
+    dup world-status <presentation-help> swap @bottom grid-add ;
 
 : open-window ( gadget -- )
     <world> dup init-status