steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

http.server.responses: adding <html-content>, use it.

db4
John Benediktsson 2014-04-22 13:47:25 -07:00
parent 902e877c12
commit 78d0aad87d
21 changed files with 43 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/furnace/actions/actions.factor
View File

@ -113,7 +113,7 @@ M: action modify-form
TUPLE: page-action < action template ;
: <chloe-content> ( path -- response )
resolve-template-path <chloe> "text/html" <content> ;
resolve-template-path <chloe> <html-content> ;
: <page-action> ( -- page )
page-action new-action

2
basis/furnace/furnace-tests.factor
View File

@ -14,7 +14,7 @@ C: <base-path-check-responder> base-path-check-responder
M: base-path-check-responder call-responder*
2drop
"$funny-dispatcher" resolve-base-path
"text/plain" <content> ;
<text-content> ;
[ ] [
<dispatcher>

4
basis/furnace/sessions/sessions-tests.factor
View File

@ -20,7 +20,7 @@ M: foo init-session* drop 0 "x" sset ;
M: foo call-responder*
2drop
"x" [ 1 + ] schange
"x" sget number>string "text/html" <content> ;
"x" sget number>string <html-content> ;
: url-responder-mock-test ( -- string )
[
@ -47,7 +47,7 @@ M: foo call-responder*
: <exiting-action> ( -- action )
<action>
[ [ ] "text/plain" <content> exit-with ] >>display ;
[ [ ] <text-content> exit-with ] >>display ;
[ "auth-test.db" temp-file delete-file ] ignore-errors

11
basis/http/server/responses/responses-docs.factor
View File

@ -8,7 +8,13 @@ HELP: <content>
HELP: <text-content>
{ $values { "body" "a response body" } { "response" response } }
{ $description "Creates a plain text response." } ;
{ $description "Creates a response with content type " { $snippet "text/plain" } "." } ;
HELP: <html-content>
{ $values { "body" "a response body" } { "response" response } }
{ $description "Creates a response with content type " { $snippet "text/html" } "." } ;
{ <content> <text-content> <html-content> } related-words
HELP: <trivial-response>
{ $values { "code" integer } { "message" string } { "response" response } }
@ -26,9 +32,8 @@ ARTICLE: "http.server.responses" "Canned HTTP responses"
{ $subsections
<content>
<text-content>
<html-content>
}
{ $vocab-link "furnace.json" } " implements " { $link <json-content> } "." $nl
"For errors:"
{ $subsections
<304>

7
basis/http/server/responses/responses.factor
View File

@ -14,7 +14,10 @@ IN: http.server.responses
: <text-content> ( body -- response )
"text/plain" <content> ;
: <html-content> ( body -- response )
"text/html" <content> ;
: trivial-response-body ( code message -- )
<XML
<html>
@ -26,7 +29,7 @@ IN: http.server.responses
: <trivial-response> ( code message -- response )
2dup [ trivial-response-body ] with-string-writer
"text/html" <content>
<html-content>
swap >>message
swap >>code ;

4
basis/http/server/static/static.factor
View File

@ -71,7 +71,7 @@ TUPLE: file-responder root hook special index-names allow-listings ;
: list-directory ( directory -- response )
file-responder get allow-listings>> [
directory>html "text/html" <content>
directory>html <html-content>
] [
drop <403>
] if ;
@ -105,7 +105,7 @@ M: file-responder call-responder* ( path responder -- response )
index-names>> adjoin ;
: serve-fhtml ( path -- response )
<fhtml> "text/html" <content> ;
<fhtml> <html-content> ;
: enable-fhtml ( responder -- responder )
[ serve-fhtml ] "application/x-factor-server-page" pick special>> set-at

2
basis/tools/deploy/deploy-tests.factor
View File

@ -71,7 +71,7 @@ http.server.responses http.server.static io.servers ;
SINGLETON: quit-responder
M: quit-responder call-responder*
2drop stop-this-server "Goodbye" "text/html" <content> ;
2drop stop-this-server "Goodbye" <html-content> ;
: add-quot-responder ( responder -- responder )
quit-responder "quit" add-responder ;

2
basis/xmode/code2html/responder/responder.factor
View File

@ -12,5 +12,5 @@ IN: xmode.code2html.responder
_ utf8 [
_ file-name input-stream get htmlize-stream
] with-file-reader
] "text/html" <content>
] <html-content>
] <file-responder> ;

2
extra/fastcgi/fastcgi.factor
View File

@ -209,7 +209,7 @@ ENUM: fcgi-protocol-status
TUPLE: test-responder ;
C: <test-responder> test-responder
M: test-responder call-responder* 2drop test-output "text/html" <content> ;
M: test-responder call-responder* 2drop test-output <html-content> ;
: do-it ( -- )
<test-responder> main-responder set

2
extra/webapps/benchmark/benchmark.factor
View File

@ -9,7 +9,7 @@ IN: webapps.benchmark
: <hello-action> ( -- action )
<page-action>
[ "Hello, world!" "text/plain" <content> ] >>display ;
[ "Hello, world!" <text-content> ] >>display ;
TUPLE: benchmark < dispatcher ;

9
extra/webapps/fjsc/fjsc.factor
View File

@ -33,12 +33,15 @@ TUPLE: fjsc < dispatcher ;
over "/" head? [ "/" append ] unless
swap append ;
: <javascript-content> ( body -- content )
"application/javascript" <content> ;
: do-compile-url ( url -- response )
[
absolute-url http-get nip 'expression' parse
fjsc-compile write "();" write
] with-string-writer
"application/javascript" <content> ;
<javascript-content> ;
: v-local ( string -- string )
dup "http:" head? [ "Unable to compile code from remote sites" throw ] when ;
@ -55,10 +58,10 @@ TUPLE: fjsc < dispatcher ;
[ validate-compile-url "url" value do-compile-url ] >>display ;
: do-compile ( code -- response )
[
[
'expression' parse fjsc-compile write
] with-string-writer
"application/javascript" <content> ;
<javascript-content> ;
: validate-compile ( -- )
{

2
extra/webapps/mason/counter/counter.factor
View File

@ -9,6 +9,6 @@ IN: webapps.mason.counter
[
[
counter-value number>string
"text/plain" <content>
<text-content>
] with-mason-db
] >>display ;

2
extra/webapps/mason/docs-update/docs-update.factor
View File

@ -30,5 +30,5 @@ IN: webapps.mason.docs-update
[ validate-secret ] >>validate
[
[ update-docs ] "Documentation update" spawn drop
"OK" "text/plain" <content>
"OK" <text-content>
] >>submit ;

4
extra/webapps/mason/grids/grids.factor
View File

@ -60,7 +60,7 @@ CONSTANT: cpus
[
[
package-grid xml>string
"text/html" <content>
<html-content>
] with-mason-db
] >>display ;
@ -82,6 +82,6 @@ CONSTANT: cpus
[
[
release-grid xml>string
"text/html" <content>
<html-content>
] with-mason-db
] >>display ;

2
extra/webapps/mason/increment-counter/increment-counter.factor
View File

@ -9,6 +9,6 @@ IN: webapps.mason.increment-counter
[
[
increment-counter-value
number>string "text/plain" <content>
number>string <text-content>
] with-mason-db
] >>submit ;

2
extra/webapps/mason/make-release/make-release.factor
View File

@ -16,6 +16,6 @@ IN: webapps.mason.make-release
[
[
"version" value "announcement-url" value do-release
"OK" "text/html" <content>
"OK" <text-content>
] with-mason-db
] >>submit ;

2
extra/webapps/mason/report/report.factor
View File

@ -10,7 +10,7 @@ IN: webapps.mason.report
[
[
current-builder last-report>>
"text/html" <content>
<html-content>
] with-mason-db
] >>display ;

2
extra/webapps/mason/status-update/status-update.factor
View File

@ -90,5 +90,5 @@ IN: webapps.mason.status-update
find-builder
[ update-builder ] [ update-tuple ] bi
] with-mason-db
"OK" "text/plain" <content>
"OK" <text-content>
] >>submit ;

4
extra/webapps/pastebin/pastebin.factor
View File

@ -143,7 +143,7 @@ M: annotation entity-url
: <raw-paste-action> ( -- action )
<action>
[ validate-integer-id "id" value paste from-object ] >>init
[ "contents" value "text/plain" <content> ] >>display ;
[ "contents" value <text-content> ] >>display ;
: <paste-feed-action> ( -- action )
<feed-action>
@ -227,7 +227,7 @@ M: annotation entity-url
: <raw-annotation-action> ( -- action )
<action>
[ validate-integer-id "id" value lookup-annotation from-object ] >>init
[ "contents" value "text/plain" <content> ] >>display ;
[ "contents" value <text-content> ] >>display ;
: <delete-annotation-action> ( -- action )
<action>

2
unmaintained/cont-responder/callbacks-tests.factor
View File

@ -21,7 +21,7 @@ IN: furnace.callbacks.tests
<action> [
[
"hello" print
"text/html" <content>
<html-content>
] show-page
"byebye" print
[ 123 ] show-final

6
unmaintained/tangle/tangle.factor
View File

@ -24,7 +24,7 @@ C: <tangle> tangle
[ [ db>> ] [ seq>> ] bi ] dip with-db ;
: node-response ( id -- response )
load-node [ node-content "text/plain" <content> ] [ <404> ] if* ;
load-node [ node-content <text-content> ] [ <404> ] if* ;
: display-node ( params -- response )
[
@ -40,7 +40,7 @@ C: <tangle> tangle
: submit-node ( params -- response )
[
"node_content" swap at* [
create-node id>> number>string "text/plain" <content>
create-node id>> number>string <text-content>
] [
drop <400>
] if
@ -56,7 +56,7 @@ TUPLE: path-responder ;
C: <path-responder> path-responder
M: path-responder call-responder* ( path responder -- response )
drop path>file [ node-content "text/plain" <content> ] [ <404> ] if* ;
drop path>file [ node-content <text-content> ] [ <404> ] if* ;
TUPLE: tangle-dispatcher < dispatcher tangle ;