factor/library/help/topics.factor

75 lines
1.8 KiB
Factor
Raw Normal View History

2006-06-17 01:03:56 -04:00
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: help
2006-06-22 22:36:56 -04:00
USING: arrays errors generic graphs hashtables io kernel
namespaces prettyprint sequences words ;
2006-06-17 01:03:56 -04:00
! Markup
GENERIC: print-element
! Help articles
SYMBOL: articles
TUPLE: article title content ;
: article ( name -- article )
dup articles get hash
2006-06-22 22:36:56 -04:00
[ ] [ "No such article: " swap unparse append throw ] ?if ;
2006-06-17 01:03:56 -04:00
2006-06-22 01:57:43 -04:00
: (add-article) ( name title element -- )
2006-06-17 01:03:56 -04:00
<article> swap articles get set-hash ;
2006-06-22 22:36:56 -04:00
M: object article-title article article-title ;
M: object article-content article article-content ;
2006-06-17 01:03:56 -04:00
! Special case: f help
M: f article-title drop \ f article-title ;
M: f article-content drop \ f article-content ;
2006-06-22 01:57:43 -04:00
TUPLE: link name ;
2006-06-22 22:36:56 -04:00
: word-help ( word -- content ) "help" word-prop ;
2006-06-22 01:57:43 -04:00
: all-articles ( -- seq )
2006-06-22 22:36:56 -04:00
articles get hash-keys
all-words [ word-help ] subset append ;
2006-06-22 01:57:43 -04:00
GENERIC: elements* ( elt-type element -- )
: elements ( elt-type element -- seq ) [ elements* ] { } make ;
: collect-elements ( element seq -- elements )
[
[
swap elements [
1 tail [ dup set ] each
2006-06-22 01:57:43 -04:00
] each
] each-with
] make-hash hash-keys ;
SYMBOL: parent-graph
DEFER: $subsection
: children ( article -- seq )
article-content { $subsection } collect-elements ;
: parents ( article -- seq )
dup link? [ link-name ] when parent-graph get in-edges ;
: (where) ( article -- )
dup , parents [ word? not ] subset dup empty?
[ drop ] [ [ (where) ] each ] if ;
: where ( article -- seq )
[ (where) ] { } make 1 tail prune ;
2006-06-22 01:57:43 -04:00
: xref-article ( article -- )
[ children ] parent-graph get add-vertex ;
: unxref-article ( article -- )
[ children ] parent-graph get remove-vertex ;
2006-06-22 22:36:56 -04:00
: xref-help ( -- )
2006-06-22 01:57:43 -04:00
all-articles [ children ] parent-graph get build-graph ;