Add a MAKE-HTTPD-OPTIONS combinator for a more visually pleasant

layout for HTTPD-OPTIONS constructors.

scheme/httpd/http-top.scm

@@ -48,9 +48,7 @@
   (set-gid (->uid "nobody"))
   (set-uid (->gid "nobody"))
   (initialise-request-invariant-cgi-env)
-  (httpd (with-path-handler
+  (httpd (make-httpd-options with-path-handler ph
-	  ph
+			     with-port 8001
-	  (with-port
+			     with-root-directory "/usr/local/etc/httpd/htdocs")))
-	   8001
-	   (with-root-directory "/usr/local/etc/httpd/htdocs")))))
 

scheme/httpd/options.scm

@@ -44,7 +44,7 @@
   (resolve-ips? httpd-options-resolve-ips? set-httpd-options-resolve-ips?!))
 
 ; default httpd-options generation
-(define (make-httpd-options)
+(define (make-default-httpd-options)
   (really-make-httpd-options 80		; port
 			     "/"	; root-directory
 			     #f		; icon-name
@@ -63,7 +63,7 @@
 ; creates a copy of a given httpd-option
 
 (define (copy-httpd-options options)
-  (let ((new-options (make-httpd-options)))
+  (let ((new-options (make-default-httpd-options)))
     (set-httpd-options-port! new-options
 			     (httpd-options-port options))
     (set-httpd-options-root-directory! new-options
@@ -94,7 +94,7 @@
   (lambda (new-value . stuff)
     (let ((new-options (if (not (null? stuff))
 			   (copy-httpd-options (car stuff))
-			   (make-httpd-options))))
+			   (make-default-httpd-options))))
       (set-option! new-options new-value)
       new-options)))
 
@@ -122,35 +122,12 @@
 (define with-resolve-ips?
   (make-httpd-options-transformer set-httpd-options-resolve-ips?!))
 
-;(define (with-httpd-options options-alist)
+(define (make-httpd-options . stuff)
-;  (let ((new-options (make-httpd-options)))
+  (let loop ((options (make-default-httpd-options))
-;    (let loop ((options-alist options-alist))
+	     (stuff stuff))
-;      (if (null? options-alist)
+    (if (null? stuff)
-;	  new-options
+	options
-;	  (begin
+	(let* ((transformer (car stuff))
-;	    (case (caar options-alist)
+	       (value (cadr stuff)))
-;	      (('port)
+	  (loop (transformer value options)
-;	       (set-httpd-options-port! new-options (cdar options-alist)))
+		(cddr stuff))))))
-;	      (('root-directory)
-;	       (set-httpd-options-root-directory! new-options (cdar options-alist)))
-;	      (('fqdn)
-;	       (set-httpd-options-fqdn! new-options (cdar options-alist)))
-;	      (('reported-port)
-;	       (set-httpd-options-reported-port! new-options (cdar options-alist)))
-;	      (('path-handler)
-;	       (set-httpd-options-path-handler! new-options (cdar options-alist)))
-;	      (('server-admin)
-;	       (set-httpd-options-server-admin! new-options (cdar options-alist)))
-;	      (('simultaneous-requests)
-;	       (set-httpd-options-simultaneous-requests! new-options (cdar options-alist)))
-;	      (('logfile)
-;	       (set-httpd-options-logfile! new-options (cdar options-alist)))
-;	      (('syslog?)
-;	       (set-httpd-options-syslog?! new-options (cdar options-alist)))
-;	      (else
-;	       (begin
-;		 (format (current-error-port) 
-;			 "[httpd] Warning: Ignoring unknown option ~A."
-;			 (cdar options-alist)))))
-;	    (loop (cdr options-alist)))))))
-  

scheme/packages.scm

@@ -253,7 +253,8 @@
 	  time->http-date-string))
 
 (define-interface httpd-make-options-interface
-  (export with-port
+  (export make-httpd-options
+	  with-port
 	  with-root-directory
 	  with-icon-name
 	  with-fqdn