]> gitweb.factorcode.org Git - factor.git/blob - library/ui/tools/help.factor
936650b42237da62abcc1fa13073934ac059f350
[factor.git] / library / ui / tools / help.factor
1 ! Copyright (C) 2006 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 IN: gadgets-help
4 USING: gadgets gadgets-borders gadgets-buttons gadgets-frames
5 gadgets-panes gadgets-search gadgets-scrolling help kernel
6 models namespaces sequences gadgets-tracks gadgets-workspace ;
7
8 TUPLE: help-gadget pane history search ;
9
10 : show-help ( link help -- )
11     dup help-gadget-history add-history
12     help-gadget-history set-model ;
13
14 : go-home ( help -- ) "handbook" swap show-help ;
15
16 : <help-pane> ( history -- gadget )
17     gadget get help-gadget-history [ help ] <pane-control> ;
18
19 : init-history ( help-gadget -- )
20     T{ link f "handbook" } <history>
21     swap set-help-gadget-history ;
22
23 C: help-gadget ( -- gadget )
24     dup init-history {
25         {
26             [ <help-pane> ]
27             set-help-gadget-pane
28             [ <scroller> ]
29             4/5
30         }
31         {
32             [ "" [ help-gadget call-tool ] <help-search> ]
33             set-help-gadget-search
34             f
35             1/5
36         }
37     } { 0 1 } make-track* ;
38
39 M: help-gadget focusable-child* help-gadget-search ;
40
41 M: help-gadget call-tool* show-help ;
42
43 M: help-gadget tool-scroller help-gadget-pane find-scroller ;
44
45 M: help-gadget tool-help drop "ui-help" ;
46
47 : help-action ( help-gadget -- link )
48     help-gadget-history model-value >link ;
49
50 help-gadget "Toolbar" {
51     { "Back" T{ key-down f { C+ } "b" } [ help-gadget-history go-back ] }
52     { "Forward" T{ key-down f { C+ } "f" } [ help-gadget-history go-forward ] }
53     { "Home" T{ key-down f { C+ } "h" } [ go-home ] }
54 }
55 link class-operations [ help-action ] modify-operations
56 [ command-name "Follow" = not ] subset
57 append
58 define-commands