basis/help/topics/topics.factor

   1 ! Copyright (C) 2005, 2008 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 M: f >link drop \ f >link ;
  19
  20 PREDICATE: word-link < link name>> word? ;
  21
  22 M: link summary
  23     [
  24         "Link: " %
  25         name>> dup word? [ summary ] [ unparse-short ] if %
  26     ] "" make ;
  27
  28 ! Help articles
  29 SYMBOL: articles
  30
  31 articles [ H{ } clone ] initialize
  32
  33 SYMBOL: article-xref
  34
  35 article-xref [ H{ } clone ] initialize
  36
  37 GENERIC: article-name ( topic -- string )
  38 GENERIC: article-title ( topic -- string )
  39 GENERIC: article-content ( topic -- content )
  40 GENERIC: article-parent ( topic -- parent )
  41 GENERIC: set-article-parent ( parent topic -- )
  42
  43 TUPLE: article title content loc ;
  44
  45 : <article> ( title content -- article )
  46     f \ article boa ;
  47
  48 M: article article-name title>> ;
  49 M: article article-title title>> ;
  50 M: article article-content content>> ;
  51
  52 ERROR: no-article name ;
  53
  54 M: no-article summary
  55     drop "Help article does not exist" ;
  56
  57 : article ( name -- article )
  58     articles get ?at [ no-article ] unless ;
  59
  60 M: object article-name article article-name ;
  61 M: object article-title article article-title ;
  62 M: object article-content article article-content ;
  63 M: object article-parent article-xref get at ;
  64 M: object set-article-parent article-xref get set-at ;
  65
  66 M: link article-name name>> article-name ;
  67 M: link article-title name>> article-title ;
  68 M: link article-content name>> article-content ;
  69 M: link article-parent name>> article-parent ;
  70 M: link set-article-parent name>> set-article-parent ;
  71
  72 ! Special case: f help
  73 M: f article-name drop \ f article-name ;
  74 M: f article-title drop \ f article-title ;
  75 M: f article-content drop \ f article-content ;
  76 M: f article-parent drop \ f article-parent ;
  77 M: f set-article-parent drop \ f set-article-parent ;