extra/webapps/help/help.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs furnace.actions furnace.redirection
   4 help.html help.topics html.components html.forms http.server
   5 http.server.dispatchers http.server.static io.directories
   6 io.files.temp kernel locals namespaces sequences
   7 unicode urls ;
   8 IN: webapps.help
   9
  10 TUPLE: help-webapp < dispatcher ;
  11
  12 : links ( seq -- seq' )
  13     [ swap <simple-link> ] { } assoc>map ;
  14
  15 :: <search-action> ( help-dir -- action )
  16     <page-action>
  17         { help-webapp "search" } >>template
  18         [
  19             "search" param [ blank? ] trim [
  20                 help-dir [
  21                     [ article-apropos links "articles" set-value ]
  22                     [ word-apropos links "words" set-value ]
  23                     [ vocab-apropos links "vocabs" set-value ] tri
  24                 ] with-directory
  25             ] unless-empty
  26             help-navbar "navbar" set-value
  27
  28             { help-webapp "search" } <chloe-content>
  29         ] >>display ;
  30
  31 : help-url ( topic -- url )
  32     topic>filename "$help-webapp/content/" prepend >url ;
  33
  34 : <main-action> ( -- action )
  35     <action>
  36         [ "handbook" >link help-url <redirect> ] >>display ;
  37
  38 :: <help-webapp> ( help-dir -- webapp )
  39     help-webapp new-dispatcher
  40         <main-action> <secure-only> "" add-responder
  41         help-dir <search-action> <secure-only> "search" add-responder
  42         help-dir <static> <secure-only> "content" add-responder ;
  43
  44 : run-help-webapp ( -- )
  45     "docs" cache-file <help-webapp>
  46         main-responder set-global
  47     8080 httpd drop ;
  48
  49 MAIN: run-help-webapp