-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel furnace furnace.validator http.server.responders
- help help.topics html splitting sequences words strings
- quotations macros vocabs tools.browser combinators
- arrays io.files ;
-IN: webapps.help
-
-: show-help ( topic -- )
- serving-html
- dup article-title [
- [ help ] with-html-stream
- ] simple-html-document ;
-
-: string>topic ( string -- topic )
- " " split dup length 1 = [ first ] when ;
-
-\ show-help {
- { "topic" "handbook" v-default string>topic }
-} define-action
-
-M: link browser-link-href
- link-name
- dup word? over f eq? or [
- browser-link-href
- ] [
- dup array? [ " " join ] when
- [ show-help ] curry quot-link
- ] if ;
-
-: show-word ( word vocab -- )
- lookup show-help ;
-
-\ show-word {
- { "word" "call" v-default }
- { "vocab" "kernel" v-default }
-} define-action
-
-M: f browser-link-href
- drop \ f browser-link-href ;
-
-M: word browser-link-href
- dup word-name swap word-vocabulary
- [ show-word ] 2curry quot-link ;
-
-: show-vocab ( vocab -- )
- f >vocab-link show-help ;
-
-\ show-vocab {
- { "vocab" "kernel" v-default }
-} define-action
-
-M: vocab-spec browser-link-href
- vocab-name [ show-vocab ] curry quot-link ;
-
-: show-vocabs-tagged ( tag -- )
- <vocab-tag> show-help ;
-
-\ show-vocabs-tagged {
- { "tag" }
-} define-action
-
-M: vocab-tag browser-link-href
- vocab-tag-name [ show-vocabs-tagged ] curry quot-link ;
-
-: show-vocabs-by ( author -- )
- <vocab-author> show-help ;
-
-\ show-vocabs-by {
- { "author" }
-} define-action
-
-M: vocab-author browser-link-href
- vocab-author-name [ show-vocabs-by ] curry quot-link ;
-
-"help" "show-help" "extra/webapps/help" web-app
-
-! Hard-coding for factorcode.org
-PREDICATE: pathname resource-pathname
- pathname-string "resource:" head? ;
-
-M: resource-pathname browser-link-href
- pathname-string
- "resource:" ?head drop
- "/responder/resources/" swap append ;
+USING: accessors assocs furnace.actions furnace.boilerplate
+furnace.redirection help.html help.topics html.components
+html.forms http.server http.server.dispatchers
+http.server.static io.directories io.files.temp io.servers
+kernel namespaces sequences simple-tokenizer splitting unicode
+urls ;
+IN: webapps.help
+
+TUPLE: help-webapp < dispatcher ;
+
+: fixup-words ( title href -- title' href' )
+ dup "word-" head? [
+ dup ".html" ?tail drop "," split1-last nip dup ":" append
+ '[ " (" _ 3append ")" append _ ?head drop ] dip
+ ] when ;
+
+: links ( apropos -- seq )
+ [ swap fixup-words <simple-link> ] { } assoc>map ;
+
+: ?links ( has-links? apropos -- has-links? seq/f )
+ links [ f ] [ nip t swap ] if-empty ;
+
+: ?tokenize ( str -- str' )
+ [ tokenize ] [ drop 1array ] recover ;
+
+:: <search-action> ( help-dir -- action )
+ <page-action>
+ { help-webapp "search" } >>template
+ [
+ f "search" param [ unicode:blank? ] trim
+ dup "search" set-value [
+ help-dir [
+ ?tokenize concat
+ [ article-apropos ?links "articles" set-value ]
+ [ word-apropos ?links "words" set-value ]
+ [ vocab-apropos ?links "vocabs" set-value ] tri
+ ] with-directory
+ ] unless-empty not "empty" set-value
+ help-nav "nav" set-value
+
+ { help-webapp "search" } <chloe-content>
+ ] >>display
+ <boilerplate>
+ { help-webapp "help" } >>template ;
+
+: help-url ( topic -- url )
+ topic>filename "$help-webapp/content/" prepend >url ;
+
+: <main-action> ( -- action )
+ <action>
+ [ "handbook" >link help-url <redirect> ] >>display ;
+
+:: <help-webapp> ( help-dir -- webapp )
+ help-webapp new-dispatcher
+ <main-action> <secure-only> "" add-responder
+ help-dir <search-action> <secure-only> "search" add-responder
+ help-dir <static> <secure-only> "content" add-responder ;
+
+: run-help-webapp ( -- )
+ "docs" cache-file <help-webapp>
+ main-responder set-global
+ 8080 httpd wait-for-server ;
+
+MAIN: run-help-webapp