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: accessors arrays definitions generic assocs
   4 io kernel namespaces make 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 name>> word? ;
  20
  21 M: link summary
  22     [
  23         "Link: " %
  24         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-title ( topic -- string )
  38 GENERIC: article-content ( topic -- content )
  39 GENERIC: article-parent ( topic -- parent )
  40 GENERIC: set-article-parent ( parent topic -- )
  41
  42 TUPLE: article title content loc ;
  43
  44 : <article> ( title content -- article )
  45     f \ article boa ;
  46
  47 M: article article-name title>> ;
  48 M: article article-title title>> ;
  49 M: article article-content content>> ;
  50
  51 ERROR: no-article name ;
  52
  53 M: no-article summary
  54     drop "Help article does not exist" ;
  55
  56 : article ( name -- article )
  57     dup articles get at* [ nip ] [ drop no-article ] if ;
  58
  59 M: object article-name article article-name ;
  60 M: object article-title article article-title ;
  61 M: object article-content article article-content ;
  62 M: object article-parent article-xref get at ;
  63 M: object set-article-parent article-xref get set-at ;
  64
  65 M: link article-name name>> article-name ;
  66 M: link article-title name>> article-title ;
  67 M: link article-content name>> article-content ;
  68 M: link article-parent name>> article-parent ;
  69 M: link set-article-parent name>> set-article-parent ;
  70
  71 ! Special case: f help
  72 M: f article-name drop \ f article-name ;
  73 M: f article-title drop \ f article-title ;
  74 M: f article-content drop \ f article-content ;
  75 M: f article-parent drop \ f article-parent ;
  76 M: f set-article-parent drop \ f set-article-parent ;