X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=blobdiff_plain;f=extra%2Fwebapps%2Fhelp%2Fhelp.factor;h=faa1b11a5a511488b4e58ddcea7e9f836fc8c3fe;hp=888766bb47c6fb29229f2023728730afb3bc40fa;hb=3db5f47bade7e2b8eb36c0c77398e6c1e10a6e55;hpb=4c888b35486185e492f72e45346a817360853c15 diff --git a/extra/webapps/help/help.factor b/extra/webapps/help/help.factor index 888766bb47..faa1b11a5a 100644 --- a/extra/webapps/help/help.factor +++ b/extra/webapps/help/help.factor @@ -1,34 +1,49 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors db.sqlite furnace.actions furnace.alloy +USING: accessors assocs furnace.actions furnace.boilerplate furnace.redirection help.html help.topics html.components -html.forms html.templates.chloe http.server -http.server.dispatchers http.server.static io.directories -io.files io.files.temp kernel locals namespaces sequences -unicode.categories urls ; +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 ; -M: result link-title title>> ; +: fixup-words ( title href -- title' href' ) + dup "word-" head? [ + dup ".html" ?tail drop "," split1-last nip dup ":" append + '[ " (" _ 3append ")" append _ ?head drop ] dip + ] when ; -M: result link-href href>> ; +: links ( apropos -- seq ) + [ swap fixup-words ] { } assoc>map ; + +: ?links ( has-links? apropos -- has-links? seq/f ) + links [ f ] [ nip t swap ] if-empty ; + +: ?tokenize ( str -- str' ) + [ tokenize ] [ drop 1array ] recover ; :: ( help-dir -- action ) { help-webapp "search" } >>template [ - "search" param [ blank? ] trim [ + f "search" param [ unicode:blank? ] trim + dup "search" set-value [ help-dir [ - [ article-apropos "articles" set-value ] - [ word-apropos "words" set-value ] - [ vocab-apropos "vocabs" set-value ] tri + ?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 - help-navbar "navbar" set-value + ] unless-empty not "empty" set-value + help-nav "nav" set-value { help-webapp "search" } - ] >>display ; + ] >>display + + { help-webapp "help" } >>template ; : help-url ( topic -- url ) topic>filename "$help-webapp/content/" prepend >url ; @@ -39,14 +54,13 @@ M: result link-href href>> ; :: ( help-dir -- webapp ) help-webapp new-dispatcher - "" add-responder - help-dir "search" add-responder - help-dir "content" add-responder - "resource:basis/definitions/icons/" "icons" add-responder ; + "" add-responder + help-dir "search" add-responder + help-dir "content" add-responder ; : run-help-webapp ( -- ) "docs" cache-file main-responder set-global - 8080 httpd drop ; + 8080 httpd wait-for-server ; MAIN: run-help-webapp