extra/help/help.factor

   1 ! Copyright (C) 2005, 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays io kernel namespaces parser prettyprint sequences
   4 words assocs definitions generic quotations effects
   5 slots continuations tuples debugger combinators
   6 vocabs help.stylesheet help.topics help.crossref help.markup
   7 sorting ;
   8 IN: help
   9
  10 GENERIC: word-help* ( word -- content )
  11
  12 : word-help ( word -- content )
  13     dup "help" word-prop [ ] [
  14         dup word-help* dup
  15         [ swap 2array 1array ] [ 2drop f ] if
  16     ] ?if ;
  17
  18 M: word word-help* drop f ;
  19
  20 M: slot-reader word-help* drop \ $slot-reader ;
  21
  22 M: slot-writer word-help* drop \ $slot-writer ;
  23
  24 : all-articles ( -- seq )
  25     articles get keys
  26     all-words [ word-help ] subset append ;
  27
  28 : xref-help ( -- )
  29     all-articles [ xref-article ] each ;
  30
  31 : error? ( word -- ? )
  32     \ $error-description swap word-help elements empty? not ;
  33
  34 : sort-articles ( seq -- newseq )
  35     [ dup article-title ] { } map>assoc sort-values 0 <column> ;
  36
  37 : all-errors ( -- seq )
  38     all-words [ error? ] subset sort-articles ;
  39
  40 M: word article-name word-name ;
  41
  42 M: word article-title
  43     dup parsing? over symbol? or [
  44         word-name
  45     ] [
  46         dup word-name
  47         swap stack-effect
  48         [ effect>string " " swap 3append ] when*
  49     ] if ;
  50
  51 M: word article-content
  52     [
  53         \ $vocabulary over 2array ,
  54         dup word-help %
  55         \ $related over 2array ,
  56         dup get-global [ \ $value swap 2array , ] when*
  57         \ $definition swap 2array ,
  58     ] { } make ;
  59
  60 M: word article-parent "help-parent" word-prop ;
  61
  62 M: word set-article-parent swap "help-parent" set-word-prop ;
  63
  64 : $doc-path ( article -- )
  65     help-path dup empty? [
  66         drop
  67     ] [
  68         [
  69             help-path-style get [
  70                 "Parent topics: " write $links
  71             ] with-style
  72         ] ($block)
  73     ] if ;
  74
  75 : $title ( topic -- )
  76     title-style get [
  77         title-style get [
  78             dup [
  79                 dup article-title swap >link write-object
  80             ] ($block) $doc-path
  81         ] with-nesting
  82     ] with-style nl ;
  83
  84 : help ( topic -- )
  85     last-element off dup $title
  86     article-content print-content nl ;
  87
  88 : about ( vocab -- )
  89     dup vocab-help [
  90         help
  91     ] [
  92         "The " write vocab-name write
  93         " vocabulary does not define a main help article." print
  94         "To define one, refer to \\ ABOUT: help" print
  95     ] ?if ;
  96
  97 : ($index) ( articles -- )
  98     subsection-style get [
  99         sort-articles [ nl ] [ ($subsection) ] interleave
 100     ] with-style ;
 101
 102 : $index ( element -- )
 103     first call dup empty?
 104     [ drop ] [ [ ($index) ] ($block) ] if ;
 105
 106 : $about ( element -- )
 107     first vocab-help [ 1array $subsection ] when* ;
 108
 109 : (:help-multi)
 110     "This error has multiple delegates:" print
 111     ($index) nl ;
 112
 113 : (:help-none)
 114     drop "No help for this error. " print ;
 115
 116 : :help ( -- )
 117     error get delegates [ error-help ] map [ ] subset
 118     {
 119         { [ dup empty? ] [ (:help-none) ] }
 120         { [ dup length 1 = ] [ first help ] }
 121         { [ t ] [ (:help-multi) ] }
 122     } cond ;
 123
 124 : remove-article ( name -- )
 125     dup articles get key? [
 126         dup unxref-article
 127         dup articles get delete-at
 128     ] when drop ;
 129
 130 : add-article ( article name -- )
 131     [ remove-article ] keep
 132     [ articles get set-at ] keep
 133     xref-article ;
 134
 135 : remove-word-help ( word -- )
 136     dup word-help [ dup unxref-article ] when
 137     f "help" set-word-prop ;
 138
 139 : set-word-help ( content word -- )
 140     [ remove-word-help ] keep
 141     [ swap "help" set-word-prop ] keep
 142     xref-article ;