Fold text-generation.scm (which was down to a few lines) into core.scm.
This commit is contained in:
sperber
parent
e8b7ef763f
commit
541113a4f0
|
|
@ -296,6 +296,9 @@
|
||||||
(write-crlf port))
|
(write-crlf port))
|
||||||
headers))
|
headers))
|
||||||
|
|
||||||
|
(define (time->http-date-string time)
|
||||||
|
(format-date "~A, ~d-~b-~y ~H:~M:~S GMT" (date time 0)))
|
||||||
|
|
||||||
;;; (make-http-error-response status-code req [message . extras])
|
;;; (make-http-error-response status-code req [message . extras])
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;;; Take an http-error condition, and format it into a response to the client.
|
;;; Take an http-error condition, and format it into a response to the client.
|
||||||
|
|
@ -430,6 +433,9 @@ the requested method (~A).~%"
|
||||||
(generic-title port)
|
(generic-title port)
|
||||||
(close-html port)))))))
|
(close-html port)))))))
|
||||||
|
|
||||||
|
(define (title-html out message)
|
||||||
|
(format out "<HEAD>~%<TITLE>~%~A~%</TITLE>~%</HEAD>~%~%" message)
|
||||||
|
(format out "<BODY>~%<H1>~A</H1>~%" message))
|
||||||
|
|
||||||
;;; Return my Internet host name (my fully-qualified domain name).
|
;;; Return my Internet host name (my fully-qualified domain name).
|
||||||
;;; This works only if an actual resolver is behind host-info.
|
;;; This works only if an actual resolver is behind host-info.
|
||||||
|
|
|
||||||
|
|
@ -1,11 +0,0 @@
|
||||||
;;; Text generation utilities.
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
(define (time->http-date-string time)
|
|
||||||
(format-date "~A, ~d-~b-~y ~H:~M:~S GMT" (date time 0)))
|
|
||||||
|
|
||||||
(define (title-html out message)
|
|
||||||
(format out "<HEAD>~%<TITLE>~%~A~%</TITLE>~%</HEAD>~%~%" message)
|
|
||||||
(format out "<BODY>~%<H1>~A</H1>~%" message))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -249,7 +249,8 @@
|
||||||
|
|
||||||
(define-interface httpd-core-interface
|
(define-interface httpd-core-interface
|
||||||
(export httpd
|
(export httpd
|
||||||
make-http-error-response))
|
make-http-error-response
|
||||||
|
time->http-date-string))
|
||||||
|
|
||||||
(define-interface httpd-make-options-interface
|
(define-interface httpd-make-options-interface
|
||||||
(export with-port
|
(export with-port
|
||||||
|
|
@ -319,10 +320,6 @@
|
||||||
(export server/version
|
(export server/version
|
||||||
server/protocol))
|
server/protocol))
|
||||||
|
|
||||||
(define-interface httpd-text-generation-interface
|
|
||||||
(export time->http-date-string
|
|
||||||
title-html))
|
|
||||||
|
|
||||||
(define-interface httpd-responses-interface
|
(define-interface httpd-responses-interface
|
||||||
(export make-response response?
|
(export make-response response?
|
||||||
response-code
|
response-code
|
||||||
|
|
@ -665,7 +662,6 @@
|
||||||
httpd-request
|
httpd-request
|
||||||
httpd-constants
|
httpd-constants
|
||||||
httpd-responses
|
httpd-responses
|
||||||
httpd-text-generation
|
|
||||||
scheme)
|
scheme)
|
||||||
(files (httpd core)))
|
(files (httpd core)))
|
||||||
|
|
||||||
|
|
@ -718,15 +714,6 @@
|
||||||
(open scheme)
|
(open scheme)
|
||||||
(files (httpd constants)))
|
(files (httpd constants)))
|
||||||
|
|
||||||
(define-structure httpd-text-generation httpd-text-generation-interface
|
|
||||||
(open formats
|
|
||||||
httpd-responses ; status-code->text
|
|
||||||
crlf-io
|
|
||||||
httpd-constants
|
|
||||||
scheme
|
|
||||||
scsh) ; format-date
|
|
||||||
(files (httpd text-generation)))
|
|
||||||
|
|
||||||
(define-structure httpd-responses httpd-responses-interface
|
(define-structure httpd-responses httpd-responses-interface
|
||||||
(open scheme
|
(open scheme
|
||||||
srfi-9
|
srfi-9
|
||||||
|
|
@ -746,7 +733,6 @@
|
||||||
httpd-core
|
httpd-core
|
||||||
httpd-request
|
httpd-request
|
||||||
httpd-responses
|
httpd-responses
|
||||||
httpd-text-generation
|
|
||||||
httpd-error
|
httpd-error
|
||||||
httpd-read-options
|
httpd-read-options
|
||||||
url
|
url
|
||||||
|
|
@ -759,22 +745,21 @@
|
||||||
(files (httpd file-dir-handler)))
|
(files (httpd file-dir-handler)))
|
||||||
|
|
||||||
(define-structure seval-handler seval-handler-interface
|
(define-structure seval-handler seval-handler-interface
|
||||||
(open scsh ; syscalls & INDEX
|
(open scsh ; syscalls & INDEX
|
||||||
httpd-error
|
httpd-error
|
||||||
httpd-request ; v0.9-request
|
httpd-request ; v0.9-request
|
||||||
httpd-text-generation ; begin-http-header
|
|
||||||
httpd-responses
|
httpd-responses
|
||||||
httpd-logging ; http-log
|
httpd-logging ; http-log
|
||||||
uri ; UNESCAPE-URI
|
uri ; UNESCAPE-URI
|
||||||
htmlout ; Formatted HTML output
|
htmlout ; Formatted HTML output
|
||||||
error-package ; ERROR
|
error-package ; ERROR
|
||||||
pp ; Pretty-printer
|
pp ; Pretty-printer
|
||||||
string-lib ; STRING-SKIP
|
string-lib ; STRING-SKIP
|
||||||
rfc822
|
rfc822
|
||||||
toothless-eval ; EVAL-SAFELY
|
toothless-eval ; EVAL-SAFELY
|
||||||
handle ; IGNORE-ERROR
|
handle ; IGNORE-ERROR
|
||||||
parse-html-forms ; PARSE-HTML-FORM-QUERY
|
parse-html-forms ; PARSE-HTML-FORM-QUERY
|
||||||
threads ; SLEEP
|
threads ; SLEEP
|
||||||
scheme)
|
scheme)
|
||||||
(files (httpd seval)))
|
(files (httpd seval)))
|
||||||
|
|
||||||
|
|
@ -784,7 +769,6 @@
|
||||||
conditions signals handle
|
conditions signals handle
|
||||||
htmlout
|
htmlout
|
||||||
httpd-request
|
httpd-request
|
||||||
httpd-text-generation
|
|
||||||
httpd-responses
|
httpd-responses
|
||||||
httpd-error
|
httpd-error
|
||||||
url
|
url
|
||||||
|
|
@ -797,7 +781,6 @@
|
||||||
(define-structure rman-gateway rman-gateway-interface
|
(define-structure rman-gateway rman-gateway-interface
|
||||||
(open httpd-responses
|
(open httpd-responses
|
||||||
httpd-request
|
httpd-request
|
||||||
httpd-text-generation
|
|
||||||
httpd-error
|
httpd-error
|
||||||
conditions
|
conditions
|
||||||
url
|
url
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue