X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=blobdiff_plain;f=extra%2Fwebapps%2Fhelp%2Fhelp.factor;h=faa1b11a5a511488b4e58ddcea7e9f836fc8c3fe;hp=64b438a63606ea3d6a69ca1e604a42814baeaa79;hb=3db5f47bade7e2b8eb36c0c77398e6c1e10a6e55;hpb=2e2f1d673a7ee98b4e6e5829d3ba077339c36c7e diff --git a/extra/webapps/help/help.factor b/extra/webapps/help/help.factor index 64b438a636..faa1b11a5a 100644 --- a/extra/webapps/help/help.factor +++ b/extra/webapps/help/help.factor @@ -1,32 +1,49 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs furnace.actions furnace.redirection -help.html help.topics html.components html.forms http.server -http.server.dispatchers http.server.static io.directories -io.files.temp kernel locals namespaces sequences -unicode urls ; +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 ; -: links ( seq -- seq' ) - [ swap ] { } assoc>map ; +: 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 ] { } 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 links "articles" set-value ] - [ word-apropos links "words" set-value ] - [ vocab-apropos links "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,13 +56,11 @@ TUPLE: help-webapp < dispatcher ; help-webapp new-dispatcher "" add-responder help-dir "search" add-responder - help-dir "content" add-responder - "resource:basis/definitions/icons/" "icons" add-responder ; - "resource:basis/ui/tools/error-list/icons/" "icons2" 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