scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fold text-generation.scm (which was down to a few lines) into core.scm.

This commit is contained in:
sperber 2002-08-26 11:21:53 +00:00
parent e8b7ef763f
commit 541113a4f0
3 changed files with 18 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
scheme/httpd/core.scm
View File

@ -296,6 +296,9 @@
(write-crlf port))
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])
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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)
(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).
;;; This works only if an actual resolver is behind host-info.

11
scheme/httpd/text-generation.scm
View File

@ -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))

41
scheme/packages.scm
View File

@ -249,7 +249,8 @@
(define-interface httpd-core-interface
(export httpd
make-http-error-response))
make-http-error-response
time->http-date-string))
(define-interface httpd-make-options-interface
(export with-port
@ -319,10 +320,6 @@
(export server/version
server/protocol))
(define-interface httpd-text-generation-interface
(export time->http-date-string
title-html))
(define-interface httpd-responses-interface
(export make-response response?
response-code
@ -665,7 +662,6 @@
httpd-request
httpd-constants
httpd-responses
httpd-text-generation
scheme)
(files (httpd core)))
@ -718,15 +714,6 @@
(open scheme)
(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
(open scheme
srfi-9
@ -746,7 +733,6 @@
httpd-core
httpd-request
httpd-responses
httpd-text-generation
httpd-error
httpd-read-options
url
@ -759,22 +745,21 @@
(files (httpd file-dir-handler)))
(define-structure seval-handler seval-handler-interface
(open scsh ; syscalls & INDEX
(open scsh ; syscalls & INDEX
httpd-error
httpd-request ; v0.9-request
httpd-text-generation ; begin-http-header
httpd-responses
httpd-logging ; http-log
uri ; UNESCAPE-URI
htmlout ; Formatted HTML output
error-package ; ERROR
pp ; Pretty-printer
string-lib ; STRING-SKIP
uri ; UNESCAPE-URI
htmlout ; Formatted HTML output
error-package ; ERROR
pp ; Pretty-printer
string-lib ; STRING-SKIP
rfc822
toothless-eval ; EVAL-SAFELY
handle ; IGNORE-ERROR
parse-html-forms ; PARSE-HTML-FORM-QUERY
threads ; SLEEP
toothless-eval ; EVAL-SAFELY
handle ; IGNORE-ERROR
parse-html-forms ; PARSE-HTML-FORM-QUERY
threads ; SLEEP
scheme)
(files (httpd seval)))
@ -784,7 +769,6 @@
conditions signals handle
htmlout
httpd-request
httpd-text-generation
httpd-responses
httpd-error
url
@ -797,7 +781,6 @@
(define-structure rman-gateway rman-gateway-interface
(open httpd-responses
httpd-request
httpd-text-generation
httpd-error
conditions
url