basis/help/topics/topics.factor

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