basis/help/topics/topics.factor

   1 ! Copyright (C) 2005, 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.x
   3 USING: arrays definitions generic assocs
   4 io kernel namespaces prettyprint prettyprint.sections
   5 sequences words summary classes strings vocabs ;
   6 IN: help.topics
   7
   8 TUPLE: link name ;
   9
  10 MIXIN: topic
  11 INSTANCE: link topic
  12 INSTANCE: word topic
  13
  14 GENERIC: >link ( obj -- obj )
  15 M: link >link ;
  16 M: vocab-spec >link ;
  17 M: object >link link boa ;
  18
  19 PREDICATE: word-link < link link-name word? ;
  20
  21 M: link summary
  22     [
  23         "Link: " %
  24         link-name dup word? [ summary ] [ unparse ] if %
  25     ] "" make ;
  26
  27 ! Help articles
  28 SYMBOL: articles
  29
  30 articles global [ H{ } assoc-like ] change-at
  31
  32 SYMBOL: article-xref
  33
  34 article-xref global [ H{ } assoc-like ] change-at
  35
  36 GENERIC: article-name ( topic -- string )
  37 GENERIC: article-parent ( topic -- parent )
  38 GENERIC: set-article-parent ( parent topic -- )
  39
  40 TUPLE: article title content loc ;
  41
  42 : <article> ( title content -- article )
  43     f \ article boa ;
  44
  45 M: article article-name article-title ;
  46
  47 TUPLE: no-article name ;
  48
  49 : no-article ( name -- * ) \ no-article boa throw ;
  50
  51 M: no-article summary
  52     drop "Help article does not exist" ;
  53
  54 : article ( name -- article )
  55     dup articles get at* [ nip ] [ drop no-article ] if ;
  56
  57 M: object article-name article article-name ;
  58 M: object article-title article article-title ;
  59 M: object article-content article article-content ;
  60 M: object article-parent article-xref get at ;
  61 M: object set-article-parent article-xref get set-at ;
  62
  63 M: link article-name link-name article-name ;
  64 M: link article-title link-name article-title ;
  65 M: link article-content link-name article-content ;
  66 M: link article-parent link-name article-parent ;
  67 M: link set-article-parent link-name set-article-parent ;
  68
  69 ! Special case: f help
  70 M: f article-name drop \ f article-name ;
  71 M: f article-title drop \ f article-title ;
  72 M: f article-content drop \ f article-content ;
  73 M: f article-parent drop \ f article-parent ;
  74 M: f set-article-parent drop \ f set-article-parent ;