extra/webapps/help/help.factor

   1 ! Copyright (C) 2005, 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel furnace furnace.validator http.server.responders
   4        help help.topics html splitting sequences words strings
   5        quotations macros vocabs tools.browser combinators
   6        arrays io.files ;
   7 IN: webapps.help
   8
   9 : show-help ( topic -- )
  10     serving-html
  11     dup article-title [
  12         [ help ] with-html-stream
  13     ] simple-html-document ;
  14
  15 : string>topic ( string -- topic )
  16     " " split dup length 1 = [ first ] when ;
  17
  18 \ show-help {
  19     { "topic" "handbook" v-default string>topic }
  20 } define-action
  21
  22 M: link browser-link-href
  23     link-name
  24     dup word? [
  25         browser-link-href
  26     ] [
  27         dup array? [ " " join ] when
  28         [ show-help ] curry quot-link
  29     ] if ;
  30
  31 : show-word ( word vocab -- )
  32     lookup show-help ;
  33
  34 \ show-word {
  35     { "vocab" "kernel" v-default }
  36     { "word" "call" v-default }
  37 } define-action
  38
  39 M: word browser-link-href
  40     dup word-name swap word-vocabulary
  41     [ show-word ] 2curry quot-link ;
  42
  43 : show-vocab ( vocab -- )
  44     f >vocab-link show-help ;
  45
  46 \ show-vocab {
  47     { "vocab" "kernel" v-default }
  48 } define-action
  49
  50 M: vocab-spec browser-link-href
  51     vocab-name [ show-vocab ] curry quot-link ;
  52
  53 : show-vocabs-tagged ( tag -- )
  54     <vocab-tag> show-help ;
  55
  56 \ show-vocabs-tagged {
  57     { "tag" }
  58 } define-action
  59
  60 M: vocab-tag browser-link-href
  61     vocab-tag-name [ show-vocabs-tagged ] curry quot-link ;
  62
  63 : show-vocabs-by ( author -- )
  64     <vocab-author> show-help ;
  65
  66 \ show-vocabs-by {
  67     { "author" }
  68 } define-action
  69
  70 M: vocab-author browser-link-href
  71     vocab-author-name [ show-vocabs-by ] curry quot-link ;
  72
  73 "help" "show-help" "extra/webapps/help" web-app
  74
  75 ! Hard-coding for factorcode.org
  76 PREDICATE: pathname resource-pathname
  77     pathname-string "resource:" head? ;
  78
  79 M: resource-pathname browser-link-href
  80     pathname-string
  81     "resource:" ?head drop
  82     "/responder/resources/" swap append ;