extra/fuel/help/help.factor

   1 ! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs combinators
   4 combinators.short-circuit help help.crossref help.markup
   5 help.markup.private help.topics help.vocabs io io.streams.string
   6 kernel make namespaces parser prettyprint see sequences
   7 splitting summary vocabs vocabs.hierarchy vocabs.metadata
   8 vocabs.parser words ;
   9 IN: fuel.help
  10
  11 SYMBOLS: $doc-path $next-link $prev-link $fuel-nav-crumbs ;
  12
  13 : articles-crumbs ( seq -- crumbs )
  14     [ dup article-title \ article 3array ] map ;
  15
  16 : base-crumbs ( -- crumbs )
  17     { "handbook" "vocab-index" } [ dup article-title \ article 3array ] map ;
  18
  19 : vocab-own-crumbs ( vocab-name -- crumbs )
  20     "." split unclip [
  21         [ CHAR: . suffix ] dip append
  22     ] accumulate swap suffix
  23     [ dup "." split last \ vocab 3array ] map ;
  24
  25 : vocab-crumbs ( vocab-name -- crumbs )
  26     vocab-own-crumbs base-crumbs prepend ;
  27
  28 : article-parents ( article-name -- parents )
  29     [ article-parent ] follow
  30     dup last "handbook" = [ "handbook" suffix ] unless
  31     reverse but-last ;
  32
  33 : article-crumbs ( article-name -- crumbs )
  34     article-parents [ dup article-title \ article 3array ] map ;
  35
  36 <PRIVATE
  37
  38 : find-word ( name -- word/f )
  39     { [ search ] [ words-named ?first ] } 1|| ;
  40
  41 : definition-str ( word -- str )
  42     [ see ] with-string-writer ; inline
  43
  44 : methods-str ( word -- str )
  45     methods [ f ] [
  46         [ [ see nl ] each ] with-string-writer
  47     ] if-empty ; inline
  48
  49 : related-words ( word -- seq )
  50     dup "related" word-prop remove ; inline
  51
  52 : parent-topics ( word -- seq )
  53     help-path [ dup article-title swap 2array ] map ; inline
  54
  55 : next/prev-link ( link link-symbol -- 3arr )
  56     swap [ name>> ] [ [ link-long-text ] with-string-writer ] bi 3array ;
  57
  58 : word-element ( word -- element )
  59     \ article swap dup article-title swap
  60     [
  61         {
  62             [ vocabulary>> vocab-crumbs \ $fuel-nav-crumbs prefix , ]
  63             [
  64                 >link
  65                 [ prev-article [ \ $prev-link next/prev-link , ] when* ]
  66                 [ next-article [ \ $next-link next/prev-link , ] when* ] bi
  67             ]
  68             [ parent-topics [ \ $doc-path prefix , ] unless-empty ]
  69             [ help:word-help % ]
  70             [ related-words [ \ $related swap 2array , ] unless-empty ]
  71             [ get-global [ \ $value swap unparse-short 2array , ] when* ]
  72             [ \ $definition swap definition-str 2array , ]
  73             [ methods-str [ \ $methods swap 2array , ] when* ]
  74         } cleave
  75     ] { } make 3array ;
  76
  77 : vocab-help-row ( vocab -- element )
  78     [ vocab-name ] [ summary ] bi 2array ;
  79
  80 : vocab-help-root-heading ( root -- element )
  81     [ "Children from " prepend ] [ "Other children" ] if* \ $heading swap 2array ;
  82
  83 SYMBOL: vocab-list
  84 SYMBOL: describe-words
  85
  86 : vocab-help-table ( vocabs -- element )
  87     [ vocab-help-row ] map vocab-list prefix ;
  88
  89 : do-vocab-list ( assoc -- seq )
  90     [
  91         [ drop f ] [
  92             [ vocab-help-root-heading ]
  93             [ vocab-help-table ] bi*
  94             [ 2array ] [ drop f ] if*
  95         ] if-empty
  96     ] { } assoc>map sift ;
  97
  98 : vocab-children-help ( name -- element )
  99     disk-vocabs-for-prefix do-vocab-list ; inline
 100
 101 : vocab-describe-words ( name -- element )
 102     [ words. ] with-string-writer dup "\n" = [ drop f ] when
 103     \ describe-words swap 2array ; inline
 104
 105 : vocab-element ( name -- element )
 106     dup require \ article swap dup >vocab-link
 107     [
 108         {
 109             [ name>> vocab-crumbs but-last \ $fuel-nav-crumbs prefix , ]
 110             [ vocab-authors [ \ $authors prefix , ] when* ]
 111             [ vocab-tags [ \ $tags prefix , ] when* ]
 112             [ summary [ { $heading "Summary" } swap 2array , ] when* ]
 113             [ drop \ $nl , ]
 114             [ vocabs:vocab-help [ lookup-article content>> % ] when* ]
 115             [ name>> vocab-describe-words , ]
 116             [ name>> vocab-children-help % ]
 117         } cleave
 118     ] { } make 3array ;
 119
 120 PRIVATE>
 121
 122 : word-help ( name -- elem/f )
 123     find-word [
 124         [ auto-use? on word-element ] with-scope
 125     ] [ f ] if* ;
 126
 127 : word-synopsis ( name -- str/f )
 128     find-word [ synopsis ] [ f ] if* ;
 129
 130 : word-def ( name -- str )
 131     find-word [ [ def>> pprint ] with-string-writer ] [ f ] if* ; inline
 132
 133 : vocab-summary ( name -- str ) >vocab-link summary ; inline
 134
 135 : vocab-help ( name -- str )
 136     dup empty? [ vocab-children-help ] [ vocab-element ] if ;
 137
 138 : add-crumb ( crumbs article -- crumbs' )
 139     dup article-name 2array suffix ;
 140
 141 : simple-element ( title content crumbs -- element )
 142     \ $fuel-nav-crumbs prefix prefix \ article -rot 3array ;
 143
 144 : get-vocabs/author ( author -- element )
 145     [ "Vocabularies by " prepend ] [ authored do-vocab-list ] bi
 146     base-crumbs "vocab-authors" add-crumb simple-element ;
 147
 148 : get-vocabs/tag ( tag -- element )
 149     [ "Vocabularies tagged " prepend ] [ tagged do-vocab-list ] bi
 150     base-crumbs "vocab-tags" add-crumb simple-element ;
 151
 152 : format-index ( seq -- seq )
 153     [ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ;
 154
 155 : article-element ( name -- element )
 156     \ article swap dup lookup-article
 157     [ nip title>> ]
 158     [
 159         [ article-crumbs \ $fuel-nav-crumbs prefix ] [ content>> ] bi*
 160         \ $nl prefix swap prefix
 161     ] 2bi 3array ;
 162
 163 : vocab-help-article?  ( name -- ? )
 164     dup lookup-vocab [ help>> = ] [ drop f ] if* ;
 165
 166 : get-article ( name -- element )
 167     dup vocab-help-article? [ vocab-help ] [ article-element ] if ;