webapps.help: tokenize and collapse search terms

[factor.git] / extra / webapps / help / help.factor

diff --git a/extra/webapps/help/help.factor b/extra/webapps/help/help.factor
index 145df4119a131329dd69b05d6a5ab87499618acb..faa1b11a5a511488b4e58ddcea7e9f836fc8c3fe 100644 (file)
--- a/extra/webapps/help/help.factor
+++ b/extra/webapps/help/help.factor
@@ -1,85 +1,66 @@
-! 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/source/" 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