2006-05-25 23:25:00 -04:00
|
|
|
! Copyright (C) 2006 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
IN: gadgets-help
|
|
|
|
USING: gadgets gadgets-panes gadgets-presentations
|
2006-06-27 03:26:52 -04:00
|
|
|
gadgets-scrolling gadgets-search gadgets-tiles
|
2006-06-12 02:41:19 -04:00
|
|
|
gadgets-tracks help io kernel sequences words ;
|
2006-05-25 23:25:00 -04:00
|
|
|
|
|
|
|
TUPLE: history pane seq ;
|
|
|
|
|
|
|
|
C: history ( -- gadget )
|
|
|
|
V{ } clone over set-history-seq
|
|
|
|
<pane> dup pick set-history-pane
|
|
|
|
<scroller> "History" f <tile> over set-gadget-delegate ;
|
|
|
|
|
|
|
|
: update-history ( history -- )
|
|
|
|
dup history-seq swap history-pane [
|
2006-05-26 02:44:31 -04:00
|
|
|
<reversed> [
|
2006-06-14 01:47:28 -04:00
|
|
|
[ article-title ] keep write-object terpri
|
2006-05-25 23:25:00 -04:00
|
|
|
] each
|
|
|
|
] with-pane ;
|
|
|
|
|
2006-06-29 01:54:11 -04:00
|
|
|
TUPLE: help-gadget showing history pane ;
|
2006-05-25 23:25:00 -04:00
|
|
|
|
|
|
|
C: help-gadget ( -- gadget )
|
|
|
|
{
|
2006-06-29 01:54:11 -04:00
|
|
|
{ [ <history> ] set-help-gadget-history f 1/4 }
|
|
|
|
{ [ <pane> ] set-help-gadget-pane [ <scroller> ] 3/4 }
|
2006-06-23 00:06:53 -04:00
|
|
|
} { 1 0 } make-track* ;
|
2006-05-25 23:25:00 -04:00
|
|
|
|
2006-05-26 02:44:31 -04:00
|
|
|
M: help-gadget gadget-title
|
|
|
|
"Help - " swap help-gadget-showing article-title append ;
|
2006-05-26 02:29:44 -04:00
|
|
|
|
2006-06-12 02:41:19 -04:00
|
|
|
: add-history ( help -- )
|
2006-06-26 01:54:25 -04:00
|
|
|
dup help-gadget-history
|
2006-06-12 02:41:19 -04:00
|
|
|
swap help-gadget-showing dup
|
|
|
|
[ over history-seq push-new update-history ] [ 2drop ] if ;
|
|
|
|
|
2006-05-25 23:25:00 -04:00
|
|
|
: show-help ( link help -- )
|
2006-06-20 23:05:26 -04:00
|
|
|
dup add-history
|
|
|
|
[ set-help-gadget-showing ] 2keep
|
|
|
|
dup update-title
|
|
|
|
help-gadget-pane [ help ] with-pane ;
|
2006-05-25 23:25:00 -04:00
|
|
|
|
|
|
|
: help-tool
|
|
|
|
[ help-gadget? ]
|
|
|
|
[ <help-gadget> ]
|
|
|
|
[ show-help ] ;
|
|
|
|
|
2006-06-12 02:41:19 -04:00
|
|
|
M: link show ( link -- ) help-tool call-tool ;
|