core/help/topics.factor

   1 ! Copyright (C) 2005, 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: help
   4 USING: arrays definitions errors generic graphs hashtables
   5 io kernel namespaces prettyprint prettyprint-internals
   6 sequences words ;
   7
   8 ! Help articles
   9 SYMBOL: articles
  10
  11 TUPLE: article title content loc ;
  12
  13 TUPLE: no-article name ;
  14 : no-article ( name -- * ) <no-article> throw ;
  15
  16 : article ( name -- article )
  17     dup articles get hash [ ] [ no-article ] ?if ;
  18
  19 M: object article-title article article-title ;
  20 M: object article-content article article-content ;
  21
  22 TUPLE: link name ;
  23
  24 M: link article-title link-name article-title ;
  25 M: link article-content link-name article-content ;
  26 M: link summary "Link: " swap link-name unparse append ;
  27
  28 ! Special case: f help
  29 M: f article-title drop \ f article-title ;
  30 M: f article-content drop \ f article-content ;
  31
  32 : word-help ( word -- content ) "help" word-prop ;
  33
  34 : all-articles ( -- seq )
  35     articles get hash-keys
  36     all-words [ word-help ] subset append ;
  37
  38 GENERIC: elements* ( elt-type element -- )
  39
  40 : elements ( elt-type element -- seq ) [ elements* ] { } make ;
  41
  42 : collect-elements ( element seq -- elements )
  43     [
  44         [
  45             swap elements [
  46                 1 tail [ dup set ] each
  47             ] each
  48         ] each-with
  49     ] make-hash hash-keys ;
  50
  51 SYMBOL: parent-graph
  52
  53 DEFER: $subsection
  54
  55 : children ( topic -- seq )
  56     article-content { $subsection } collect-elements ;
  57
  58 : parents ( topic -- seq )
  59     dup link? [ link-name ] when parent-graph get in-edges ;
  60
  61 : (doc-path) ( topic -- )
  62     dup , parents [ word? not ] subset dup empty?
  63     [ drop ] [ [ (doc-path) ] each ] if ;
  64
  65 : doc-path ( topic -- seq )
  66     [ (doc-path) ] { } make 1 tail prune ;
  67
  68 : xref-article ( topic -- )
  69     [ children ] parent-graph get add-vertex ;
  70
  71 : unxref-article ( topic -- )
  72     [ children ] parent-graph get remove-vertex ;
  73
  74 : xref-help ( -- )
  75     all-articles [ children ] parent-graph get build-graph ;