88 lines
2.1 KiB
Factor
88 lines
2.1 KiB
Factor
! Copyright (C) 2005, 2007 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
IN: help
|
|
USING: arrays definitions errors generic assocs
|
|
io kernel namespaces prettyprint prettyprint-internals
|
|
sequences words inspector ;
|
|
|
|
! Help articles
|
|
SYMBOL: articles
|
|
|
|
GENERIC: article-name ( article -- string )
|
|
|
|
TUPLE: article title content loc ;
|
|
|
|
M: article article-name article-title ;
|
|
|
|
TUPLE: no-article name ;
|
|
: no-article ( name -- * ) <no-article> throw ;
|
|
|
|
: article ( name -- article )
|
|
dup articles get at [ ] [ no-article ] ?if ;
|
|
|
|
M: object article-name article article-name ;
|
|
M: object article-title article article-title ;
|
|
M: object article-content article article-content ;
|
|
|
|
TUPLE: link name ;
|
|
|
|
M: link article-name link-name article-name ;
|
|
M: link article-title link-name article-title ;
|
|
M: link article-content link-name article-content ;
|
|
|
|
M: link summary
|
|
[
|
|
"Link: " %
|
|
link-name dup word? [ summary ] [ unparse ] if %
|
|
] "" make ;
|
|
|
|
! Special case: f help
|
|
M: f article-name drop \ f article-name ;
|
|
M: f article-title drop \ f article-title ;
|
|
M: f article-content drop \ f article-content ;
|
|
|
|
: related-words ( seq -- )
|
|
dup [ swap "related" set-word-prop ] each-with ;
|
|
|
|
GENERIC: elements* ( elt-type element -- )
|
|
|
|
: elements ( elt-type element -- seq ) [ elements* ] { } make ;
|
|
|
|
: collect-elements ( element seq -- elements )
|
|
[
|
|
[
|
|
swap elements [
|
|
1 tail [ dup set ] each
|
|
] each
|
|
] each-with
|
|
] H{ } make-assoc keys ;
|
|
|
|
SYMBOL: help-tree
|
|
|
|
DEFER: $subsection
|
|
|
|
: children ( topic -- seq )
|
|
article-content { $subsection } collect-elements ;
|
|
|
|
: parent ( topic -- topic )
|
|
dup link? [ link-name ] when help-tree get at ;
|
|
|
|
: (help-path) ( topic -- )
|
|
parent [ dup , (help-path) ] when* ;
|
|
|
|
: help-path ( topic -- seq )
|
|
[ (help-path) ] { } make ;
|
|
|
|
: if-help-tree ( topic quot -- )
|
|
help-tree get swap [ drop ] if ; inline
|
|
|
|
: xref-article ( topic -- )
|
|
[
|
|
dup children [ help-tree get set-at ] each-with
|
|
] if-help-tree ;
|
|
|
|
: unxref-article ( topic -- )
|
|
[
|
|
children [ help-tree get delete-at ] each
|
|
] if-help-tree ;
|