>From 35906ccf32c502eb34190960542679ca96c6104a Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Thu, 25 Nov 2010 20:11:29 +0000 Subject: [PATCH 1/4] Allow big-dishing-loop to set modlisp-ish reply style --- source/server-utils/big-dishing-loop.scm | 5 +++-- source/server-utils/modlisp.scm | 9 +++++---- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/source/server-utils/big-dishing-loop.scm b/source/server-utils/big-dishing-loop.scm index ee5d4ab..ade4078 100644 --- a/source/server-utils/big-dishing-loop.scm +++ b/source/server-utils/big-dishing-loop.scm @@ -111,7 +111,8 @@ (define http-hgrok (vector read-first-line read-headers - skip-headers)) + skip-headers + #f)) ;; Return a proc @var{dish} that loops serving http requests from a socket. ;; @var{dish} takes one arg @var{ear}, which may be a pre-configured socket, @@ -284,7 +285,7 @@ ;; status box (b (and (number? status-box-size) (make-list status-box-size #f))) - (M (mouthpiece p b)) + (M (mouthpiece p b (vector-ref style 3))) (res (cond ((assq-ref method-handlers method) => (lambda (mh) (call-with-current-continuation diff --git a/source/server-utils/modlisp.scm b/source/server-utils/modlisp.scm index 5bd60fe..9f0ffb0 100644 --- a/source/server-utils/modlisp.scm +++ b/source/server-utils/modlisp.scm @@ -52,14 +52,15 @@ (set-car! rv (string->symbol (car rv))) rv)) -(define modlisp-hgrok (vector read-first-line - read-headers - read-headers)) - (define LF "\n") (define modlisp-ish (vector "Status\n~A ~A\n" LF LF "end\n")) +(define modlisp-hgrok (vector read-first-line + read-headers + read-headers + modlisp-ish)) + ;;; modlisp.scm ends here -- 1.7.2.3