From 6143b004341b2dc018ac8f30339310ea17ee7cfd Mon Sep 17 00:00:00 2001 From: slava Date: Sat, 26 Aug 2006 01:29:23 +0000 Subject: [PATCH] Presentation cleanups and mouse help --- contrib/httpd/browser-responder.factor | 2 +- library/bootstrap/boot-stage1.factor | 2 +- library/definitions.factor | 2 -- library/definitions.facts | 5 --- library/help/topics.factor | 4 +-- library/syntax/parser.factor | 2 +- library/tools/debugger.factor | 4 ++- library/tools/definitions.factor | 12 +++---- library/tools/definitions.facts | 7 ++-- library/tools/summary.factor | 11 +----- library/tools/summary.facts | 2 +- library/tools/word-tools.factor | 2 +- library/ui/gadgets/presentations.factor | 45 +++++++++++++++++++++---- library/ui/gestures.factor | 11 +----- library/ui/ui.factor | 3 +- 15 files changed, 61 insertions(+), 53 deletions(-) diff --git a/contrib/httpd/browser-responder.factor b/contrib/httpd/browser-responder.factor index 3b1296de0f..cc44d111f2 100644 --- a/contrib/httpd/browser-responder.factor +++ b/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. diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 2f52a67a47..123d55afed 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/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" diff --git a/library/definitions.factor b/library/definitions.factor index e4b762e09b..9b7ec46c6c 100644 --- a/library/definitions.factor +++ b/library/definitions.factor @@ -12,5 +12,3 @@ GENERIC: subdefs ( defspec -- seq ) : see-subdefs ( word -- ) subdefs [ see ] each ; GENERIC: forget ( defspec -- ) - -GENERIC: synopsis ( defspec -- str ) diff --git a/library/definitions.facts b/library/definitions.facts index f0a3f9bd04..3e1c4f9de3 100644 --- a/library/definitions.facts +++ b/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 )" } } ; diff --git a/library/help/topics.factor b/library/help/topics.factor index 2c9ef8f1b2..bd92a5c49b 100644 --- a/library/help/topics.factor +++ b/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. ; diff --git a/library/syntax/parser.factor b/library/syntax/parser.factor index 7b24fe5f1b..834993c1b7 100644 --- a/library/syntax/parser.factor +++ b/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 ; diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor index 6d6366a56c..f0977a3828 100644 --- a/library/tools/debugger.factor +++ b/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) diff --git a/library/tools/definitions.factor b/library/tools/definitions.factor index a530704684..948cf16adc 100644 --- a/library/tools/definitions.factor +++ b/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 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{ } r [ synopsis ] keep r> + dup rot curry >r [ summary ] keep r> write-outliner terpri ] each-with ; diff --git a/library/ui/gadgets/presentations.factor b/library/ui/gadgets/presentations.factor index becda810ed..a75873c98f 100644 --- a/library/ui/gadgets/presentations.factor +++ b/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 ; - : ( gadget object -- button ) >r f r> dup object-operations ; @@ -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 +: ( model -- ) + [ [ presentation-object summary ] [ "" ] if* ] + ; + +: ( model -- help ) + [ + [ + presentation-commands + dup length [ 2array ] 2map + [ first ] subset + [ + first2 swap command-name + >r number>string " " r> + append3 + ] map " " join + ] [ + "" + ] if* + ] ; + +: ( model -- gadget ) + dup swap + 2array make-pile ; + ! Character styles : apply-style ( style gadget key quot -- style gadget ) diff --git a/library/ui/gestures.factor b/library/ui/gestures.factor index aec17bbf1b..f448b31507 100644 --- a/library/ui/gestures.factor +++ b/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 diff --git a/library/ui/ui.factor b/library/ui/ui.factor index 8900590ef6..7a57b4b39a 100644 --- a/library/ui/ui.factor +++ b/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 dup highlight-theme - swap @bottom grid-add ; + dup world-status swap @bottom grid-add ; : open-window ( gadget -- ) dup init-status