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 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 INSTANCE: link definition-mixin
  11
  12 MIXIN: topic
  13
  14 INSTANCE: link topic
  15
  16 INSTANCE: word topic
  17
  18 GENERIC: >link ( obj -- obj )
  19 M: link >link ;
  20 M: wrapper >link wrapped>> >link ;
  21 M: vocab-spec >link ;
  22 M: object >link link boa ;
  23 M: f >link drop \ f >link ;
  24
  25 PREDICATE: word-link < link name>> word? ;
  26
  27 M: link summary
  28     [
  29         "Link: " %
  30         name>> dup word? [ summary ] [ unparse-short ] if %
  31     ] "" make ;
  32
  33 ! Help articles
  34 SYMBOL: articles
  35
  36 articles [ H{ } clone ] initialize
  37
  38 SYMBOL: article-xref
  39
  40 article-xref [ H{ } clone ] initialize
  41
  42 GENERIC: valid-article? ( topic -- ? )
  43 GENERIC: article-title ( topic -- string )
  44 GENERIC: article-name ( topic -- string )
  45 GENERIC: article-content ( topic -- content )
  46 GENERIC: article-parent ( topic -- parent )
  47 GENERIC: set-article-parent ( parent topic -- )
  48
  49 M: object article-name article-title ;
  50
  51 TUPLE: article title content loc ;
  52
  53 : <article> ( title content -- article )
  54     f \ article boa ;
  55
  56 M: article valid-article? drop t ;
  57 M: article article-title title>> ;
  58 M: article article-content content>> ;
  59
  60 ERROR: no-article name ;
  61
  62 M: no-article summary
  63     drop "Help article does not exist" ;
  64
  65 : lookup-article ( name -- article )
  66     articles get ?at [ no-article ] unless ;
  67
  68 M: object valid-article? articles get key? ;
  69 M: object article-title lookup-article article-title ;
  70 M: object article-content lookup-article article-content ;
  71 M: object article-parent article-xref get at ;
  72 M: object set-article-parent article-xref get set-at ;
  73
  74 M: link valid-article? name>> valid-article? ;
  75 M: link article-title name>> article-title ;
  76 M: link article-content name>> article-content ;
  77 M: link article-parent name>> article-parent ;
  78 M: link set-article-parent name>> set-article-parent ;
  79
  80 ! Special case: f help
  81 M: f valid-article? drop t ;
  82 M: f article-title drop \ f article-title ;
  83 M: f article-content drop \ f article-content ;
  84 M: f article-parent drop \ f article-parent ;
  85 M: f set-article-parent drop \ f set-article-parent ;