factor/library/help/crossref.factor

85 lines
2.0 KiB
Factor
Raw Normal View History

! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: help
2006-05-15 01:01:47 -04:00
USING: arrays generic graphs hashtables io kernel
namespaces sequences strings words ;
: all-articles ( -- seq )
2006-06-17 01:03:56 -04:00
articles get hash-keys all-words append ;
GENERIC: elements* ( elt-type element -- )
M: simple-element elements* [ elements* ] each-with ;
M: object elements* 2drop ;
M: array elements*
[ [ elements* ] each-with ] 2keep
[ first eq? ] keep swap [ , ] [ drop ] if ;
: elements ( elt-type element -- seq ) [ elements* ] { } make ;
2006-06-17 01:18:46 -04:00
: collect-elements ( element seq -- elements )
2006-06-17 01:03:56 -04:00
[
[
swap elements [
1 swap tail [ dup set ] each
] each
] each-with
] make-hash hash-keys ;
SYMBOL: link-graph
: links-out ( article -- seq )
2006-06-17 01:03:56 -04:00
article-content { $link $see-also } collect-elements ;
2006-06-17 01:03:56 -04:00
: ?link dup link? [ link-name ] when ;
2006-06-16 23:12:40 -04:00
: links-in ( article -- seq )
2006-06-17 01:03:56 -04:00
?link link-graph get in-edges ;
SYMBOL: parent-graph
2006-06-17 01:18:46 -04:00
DEFER: $subsection
2006-06-17 01:03:56 -04:00
: children ( article -- seq )
article-content { $subsection } collect-elements ;
: ?link dup link? [ link-name ] when ;
: parents ( article -- seq )
?link parent-graph get in-edges ;
: (where) ( article -- )
dup , parents [ word? not ] subset dup empty?
[ drop ] [ [ (where) ] each ] if ;
: where ( article -- seq )
[ (where) ] { } make 1 swap tail ;
2006-06-17 01:18:46 -04:00
: $where ( article -- )
where dup empty? [
drop
] [
where-style [
[ "Parent topics: " write $links ] ($block)
] with-style
] if ;
: xref-article ( article -- )
2006-06-17 01:03:56 -04:00
dup
[ links-out ] link-graph get add-vertex
[ children ] parent-graph get add-vertex ;
: unxref-article ( article -- )
2006-06-17 01:03:56 -04:00
dup [ links-out ] link-graph get remove-vertex
[ children ] parent-graph get remove-vertex ;
: xref-articles ( -- )
2006-06-17 01:03:56 -04:00
all-articles dup
[ links-out ] link-graph get build-graph
[ children ] parent-graph get build-graph ;
: links-in. ( article -- )
links-in [ links-in. ] help-outliner ;