From: slava Date: Thu, 19 Oct 2006 20:35:58 +0000 (+0000) Subject: HTTPD tools moved to contrib/furnace and updated to use the new framework X-Git-Tag: 0.85~11 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=76f1b3bcfed5449dff816d19f1c222522dedcbe3 HTTPD tools moved to contrib/furnace and updated to use the new framework --- diff --git a/contrib/furnace-pastebin/pastebin.factor b/contrib/furnace-pastebin/pastebin.factor index 1b88911348..c1501d5e4d 100644 --- a/contrib/furnace-pastebin/pastebin.factor +++ b/contrib/furnace-pastebin/pastebin.factor @@ -64,8 +64,6 @@ C: pastebin ( -- pastebin ) \ submit-paste [ paste-list ] define-redirect -"pastebin" "paste-list" "contrib/furnace-pastebin" web-app - : annotate-paste ( paste# summary author contents -- ) swap get-paste paste-annotations push ; @@ -77,3 +75,5 @@ C: pastebin ( -- pastebin ) } define-action \ annotate-paste [ "n" show-paste ] define-redirect + +"pastebin" "paste-list" "contrib/furnace-pastebin" web-app diff --git a/contrib/furnace/load.factor b/contrib/furnace/load.factor index 8fe59c6ed0..d50b6e90e6 100644 --- a/contrib/furnace/load.factor +++ b/contrib/furnace/load.factor @@ -3,6 +3,8 @@ REQUIRES: contrib/httpd ; PROVIDE: contrib/furnace { "validator.factor" "responder.factor" + "tools/help.factor" + "tools/browser.factor" } { "test/validator.factor" "test/responder.factor" diff --git a/contrib/furnace/responder.factor b/contrib/furnace/responder.factor index 7599c8873b..b33d30429d 100644 --- a/contrib/furnace/responder.factor +++ b/contrib/furnace/responder.factor @@ -36,7 +36,9 @@ PREDICATE: word action "action" word-prop ; : action-link ( query action -- url ) [ - "/responder/" % "responder" get % "/" % + "/responder/" % + dup word-vocabulary "furnace:" ?head drop % + "/" % word-name % ] "" make swap build-url ; diff --git a/contrib/furnace/tools/browser.factor b/contrib/furnace/tools/browser.factor new file mode 100644 index 0000000000..c9f4fa2a64 --- /dev/null +++ b/contrib/furnace/tools/browser.factor @@ -0,0 +1,82 @@ +! Copyright (C) 2004 Chris Double +! Copyright (C) 2004, 2006 Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +IN: furnace:browser +USING: definitions hashtables help html httpd io kernel memory +namespaces prettyprint sequences words xml furnace arrays ; + +: option ( current text -- ) + #! Output the HTML option tag for the given text. If + #! it is equal to the current string, make the option selected. + ; + +: options ( current seq -- ) [ option ] each-with ; + +: list ( current seq name -- ) + ; + +: current-vocab ( -- string ) + "vocab" query-param [ "kernel" ] unless* ; + +: current-word ( -- word ) + "word" query-param "vocab" query-param lookup ; + +: vocab-list ( vocab -- ) vocabs "vocab" list ; + +: word-list ( word vocab -- ) + [ lookup [ word-name ] [ f ] if* ] keep + vocab hash-keys natural-sort "word" list ; + +: word-source ( -- ) + #! Write the source for the given word from the vocab as HTML. + current-word [ see-help ] when* ; + +: browser-body ( word vocab -- ) + #! Write out the HTML for the body of the main browser page. + + + + + + + + + + + +
"Vocabularies" write "Words" write "Documentation" write
+ dup vocab-list + + word-list + word-source
; + +: browser-title ( word vocab -- str ) + 2dup lookup dup + [ 2nip summary ] [ drop nip "IN: " swap append ] if ; + +: browse ( word vocab -- ) + #! Display a Smalltalk like browser for exploring words. + 2dup browser-title [ + [ +
+ browser-body +
+ ] with-html-stream + ] html-document ; + +\ browse { + { "word" } + { "vocab" "kernel" v-default } +} define-action + +"browser" "browse" "contrib/furnace" web-app + +M: word browser-link-href + dup word-name swap word-vocabulary \ browse + 3array >quotation quot-link ; diff --git a/contrib/furnace/tools/help.factor b/contrib/furnace/tools/help.factor new file mode 100644 index 0000000000..59ba62dbc2 --- /dev/null +++ b/contrib/furnace/tools/help.factor @@ -0,0 +1,26 @@ +! Copyright (C) 2005, 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +IN: furnace:help +USING: furnace help html kernel sequences words strings ; + +: string>topic ( string -- topic ) + " " split dup length 1 = [ first ] when ; + +: show-help ( topic -- ) + dup article-title [ + [ help ] with-html-stream + ] html-document ; + +\ show-help { + { "topic" "handbook" v-default string>topic } +} define-action + +"help" "show-help" "contrib/furnace" web-app + +M: link browser-link-href + link-name [ \ f ] unless* dup word? [ + browser-link-href + ] [ + dup [ string? ] all? [ " " join ] when + [ show-help ] curry quot-link + ] if ; diff --git a/contrib/httpd/browser-responder.factor b/contrib/httpd/browser-responder.factor deleted file mode 100644 index cc44d111f2..0000000000 --- a/contrib/httpd/browser-responder.factor +++ /dev/null @@ -1,67 +0,0 @@ -! Copyright (C) 2004 Chris Double. -! See http://factorcode.org/license.txt for BSD license. -IN: browser-responder -USING: definitions hashtables help html httpd io kernel memory -namespaces prettyprint sequences words xml ; - -: option ( current text -- ) - #! Output the HTML option tag for the given text. If - #! it is equal to the current string, make the option selected. - ; - -: options ( current seq -- ) [ option ] each-with ; - -: list ( current seq name -- ) - ; - -: current-vocab ( -- string ) - "vocab" query-param [ "kernel" ] unless* ; - -: current-word ( -- word ) - "word" query-param "vocab" query-param lookup ; - -: vocab-list ( -- ) - current-vocab vocabs "vocab" list ; - -: word-list ( -- ) - current-word [ word-name ] [ f ] if* - current-vocab vocab hash-keys natural-sort "word" list ; - -: word-source ( -- ) - #! Write the source for the given word from the vocab as HTML. - current-word [ [ see-help ] with-html-stream ] when* ; - -: browser-body ( -- ) - #! Write out the HTML for the body of the main browser page. - - - - - - - - - - - -
"Vocabularies" write "Words" write "Documentation" write
- vocab-list - - word-list - word-source
; - -: browser-title ( -- str ) - current-word - [ summary ] [ "IN: " current-vocab append ] if* ; - -: browser-responder ( -- ) - #! Display a Smalltalk like browser for exploring words. - serving-html browser-title [ -
- browser-body -
- ] html-document ; diff --git a/contrib/httpd/darcs-responder.factor b/contrib/httpd/darcs-responder.factor deleted file mode 100644 index 537d301855..0000000000 --- a/contrib/httpd/darcs-responder.factor +++ /dev/null @@ -1,56 +0,0 @@ -USING: httpd io kernel namespaces sequences xml ; - -SYMBOL: darcs-directory - -"/var/www/factorcode.org/repos/" darcs-directory set - -: darcs-changelog - darcs-directory get cd - "darcs changes --xml" "r" contents xml ; - -: rss-item ( { title date author } -- ) - "item" [ ] [ - { "title" "pubDate" "author" } [ [ ] text-tag ] 2each - ] tag ; - -: ?tag-name ( tag -- name/f ) - dup tag? [ tag-name ] [ drop f ] if ; - -: children-named ( tag name -- seq ) - swap tag-children [ ?tag-name = ] subset-with ; - -: tag-child ( tag name -- tag ) - children-named first ; - -: patch>rss-item ( tag -- { title link author date } ) - [ - dup "name" tag-child tag-children % - tag-props [ "local_date" get , "author" get , ] bind - ] { } make ; - -SYMBOL: rss-feed-title -SYMBOL: rss-feed-link -SYMBOL: rss-feed-description - -"Factor DARCS repository" rss-feed-title set -"http://factorcode.org/repos/" rss-feed-link set -"Recent patches applied to the Factor DARCS repository" rss-feed-description set - -: rss-metadata ( -- ) - { rss-feed-title rss-feed-link rss-feed-description } - { "title" "link" "description" } - [ >r get r> [ ] text-tag ] 2each ; - -: rss-feed ( items -- string ) - [ - "rss" [ "2.0" "version" set ] [ - "channel" [ ] [ rss-metadata [ rss-item ] each ] tag - ] tag - ] make-xml xml>string ; - -: changelog>rss-feed ( xml -- string ) - "patch" children-named [ patch>rss-item ] map rss-feed ; - -: darcs-rss-feed darcs-changelog changelog>rss-feed print ; - -"darcs" [ darcs-rss-feed ] add-simple-responder diff --git a/contrib/httpd/default-responders.factor b/contrib/httpd/default-responders.factor index 5c9e0642ef..4fe148e143 100644 --- a/contrib/httpd/default-responders.factor +++ b/contrib/httpd/default-responders.factor @@ -1,9 +1,7 @@ ! Copyright (C) 2004, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: httpd -USING: browser-responder callback-responder file-responder -help-responder inspect-responder io kernel namespaces -prettyprint ; +USING: callback-responder file-responder io kernel namespaces ; #! Remove all existing responders, and create a blank #! responder table. @@ -12,9 +10,6 @@ global [ ! 404 error message pages are served by this guy "404" [ no-such-responder ] add-simple-responder - - ! Online help browsing - "help" [ help-responder ] add-simple-responder ! Used by other responders "callback" [ callback-responder ] add-simple-responder @@ -27,12 +22,6 @@ global [ ] with-scope ] add-simple-responder - ! Global variables - "inspector" [ inspect-responder ] add-simple-responder - - ! Servers Factor word definitions from the image. - "browser" [ browser-responder ] add-simple-responder - ! Serves files from a directory stored in the "doc-root" ! variable. You can set the variable in the global namespace, ! or inside the responder. diff --git a/contrib/httpd/help-responder.factor b/contrib/httpd/help-responder.factor deleted file mode 100644 index e5994163aa..0000000000 --- a/contrib/httpd/help-responder.factor +++ /dev/null @@ -1,13 +0,0 @@ -! Copyright (C) 2006 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -IN: help-responder -USING: hashtables help html httpd io kernel namespaces sequences ; - -: help-topic - "topic" query-param dup empty? [ drop "handbook" ] when ; - -: help-responder ( -- ) - serving-html - help-topic dup article-title [ - [ help ] with-html-stream - ] html-document ; diff --git a/contrib/httpd/html-tags.factor b/contrib/httpd/html-tags.factor index 40ff195d09..fc769c5707 100644 --- a/contrib/httpd/html-tags.factor +++ b/contrib/httpd/html-tags.factor @@ -128,7 +128,7 @@ SYMBOL: html : define-attribute-word ( name -- ) dup "=" swap append swap - [ , [ write-attr ] % ] [ ] make html-word drop ; + [ write-attr ] curry html-word drop ; ! Define some closed HTML tags [ diff --git a/contrib/httpd/html.factor b/contrib/httpd/html.factor index 0a2981e824..a3543edc7b 100644 --- a/contrib/httpd/html.factor +++ b/contrib/httpd/html.factor @@ -88,18 +88,6 @@ GENERIC: browser-link-href ( presented -- href ) M: object browser-link-href drop f ; -M: word browser-link-href - "/responder/browser/" swap [ - dup word-vocabulary "vocab" set word-name "word" set - ] make-hash build-url ; - -M: link browser-link-href - link-name [ \ f ] unless* dup word? [ - browser-link-href - ] [ - "/responder/help/" swap "topic" associate build-url - ] if ; - : resolve-file-link ( path -- link ) #! The file responder needs relative links not absolute #! links. @@ -201,10 +189,10 @@ M: html-stream stream-terpri [
] with-stream* ; : default-css ( -- ) ; : xhtml-preamble diff --git a/contrib/httpd/inspect-responder.factor b/contrib/httpd/inspect-responder.factor deleted file mode 100644 index d7182b5c94..0000000000 --- a/contrib/httpd/inspect-responder.factor +++ /dev/null @@ -1,15 +0,0 @@ -! Copyright (C) 2006 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -IN: inspect-responder -USING: callback-responder generic hashtables help html httpd -tools kernel namespaces prettyprint sequences ; - -! Mini object inspector -: http-inspect ( obj -- ) - dup summary [ describe ] simple-html-document ; - -M: general-t browser-link-href - [ http-inspect ] curry t register-html-callback ; - -: inspect-responder ( url -- ) - serving-html global http-inspect ; diff --git a/contrib/httpd/load.factor b/contrib/httpd/load.factor index f6b2581815..65d4437fb6 100644 --- a/contrib/httpd/load.factor +++ b/contrib/httpd/load.factor @@ -13,9 +13,6 @@ PROVIDE: contrib/httpd { "prototype-js.factor" "html.factor" "file-responder.factor" - "help-responder.factor" - "inspect-responder.factor" - "browser-responder.factor" "default-responders.factor" } { "test/html.factor"