1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs furnace.actions furnace.boilerplate
4 furnace.redirection help.html help.topics html.components
5 html.forms http.server http.server.dispatchers
6 http.server.static io.directories io.files.temp io.servers
7 kernel namespaces sequences simple-tokenizer splitting unicode
11 TUPLE: help-webapp < dispatcher ;
13 : fixup-words ( title href -- title' href' )
15 dup ".html" ?tail drop "," split1-last nip dup ":" append
16 '[ " (" _ 3append ")" append _ ?head drop ] dip
19 : links ( apropos -- seq )
20 [ swap fixup-words <simple-link> ] { } assoc>map ;
22 : ?links ( has-links? apropos -- has-links? seq/f )
23 links [ f ] [ nip t swap ] if-empty ;
25 : ?tokenize ( str -- str' )
26 [ tokenize ] [ drop 1array ] recover ;
28 :: <search-action> ( help-dir -- action )
30 { help-webapp "search" } >>template
32 f "search" param [ unicode:blank? ] trim
33 dup "search" set-value [
36 [ article-apropos ?links "articles" set-value ]
37 [ word-apropos ?links "words" set-value ]
38 [ vocab-apropos ?links "vocabs" set-value ] tri
40 ] unless-empty not "empty" set-value
41 help-nav "nav" set-value
43 { help-webapp "search" } <chloe-content>
46 { help-webapp "help" } >>template ;
48 : help-url ( topic -- url )
49 topic>filename "$help-webapp/content/" prepend >url ;
51 : <main-action> ( -- action )
53 [ "handbook" >link help-url <redirect> ] >>display ;
55 :: <help-webapp> ( help-dir -- webapp )
56 help-webapp new-dispatcher
57 <main-action> <secure-only> "" add-responder
58 help-dir <search-action> <secure-only> "search" add-responder
59 help-dir <static> <secure-only> "content" add-responder ;
61 : run-help-webapp ( -- )
62 "docs" cache-file <help-webapp>
63 main-responder set-global
64 8080 httpd wait-for-server ;