[bknr-cvs] r2496 - branches/trunk-reorg/bknr/web/src/web
Author: ksprotte Date: Thu Feb 14 10:42:55 2008 New Revision: 2496 Modified: branches/trunk-reorg/bknr/web/src/web/handlers.lisp branches/trunk-reorg/bknr/web/src/web/web-macros.lisp Log: tweaked with-http-body and website-show-error-page Modified: branches/trunk-reorg/bknr/web/src/web/handlers.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/web/handlers.lisp (original) +++ branches/trunk-reorg/bknr/web/src/web/handlers.lisp Thu Feb 14 10:42:55 2008 @@ -499,10 +499,9 @@ (ensure-directories-exist spool-dir) spool-dir)) -(defmethod website-show-page ((website website) fn title) - (html - (princ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">" *html-stream*) - (princ #\Newline *html-stream*) +(defmethod website-show-page ((website website) fn title) + (html + (:html (:head (header :title title)) @@ -515,34 +514,11 @@ (funcall fn) (session-info))))) -(defmethod website-show-error-page ((website website) error) - (if (website-template-handler website) - (send-error-response (website-template-handler website) (princ-to-string error)) - (html - (princ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">" *html-stream*) - (princ #\Newline *html-stream*) - (:html - (:head - (header :title "Error processing your request")) - ((:body :class "cms") - (:h1 "Error processing your request") - (:p "While processing your request, an error occured:") - ((:div :class "error") - (:princ-safe error))))))) - (defun show-page-with-error-handlers (fn &key (response +http-ok+) title) (setf (return-code) response) - (handler-case - (let ((body (with-output-to-string (*html-stream*) - (let ((*html-sink* (cxml:make-character-stream-sink *html-stream* :canonical nil :indentation 3))) - (website-show-page *website* fn title))))) - (with-http-response (:content-type "text/html; charset=UTF-8" :response response) - (with-http-body () - (princ body *html-stream*)))) - (serious-condition (c) - (with-http-response (:content-type "text/html; charset=UTF-8" :response +http-internal-server-error+) - (with-http-body () - (website-show-error-page *website* c)))))) + (with-http-response (:content-type "text/html; charset=UTF-8" :response response) + (with-http-body () + (website-show-page *website* fn title)))) (defmacro with-bknr-page ((&rest args) &body body) `(show-page-with-error-handlers (lambda () (html ,@body)) ,@args)) Modified: branches/trunk-reorg/bknr/web/src/web/web-macros.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/web/web-macros.lisp (original) +++ branches/trunk-reorg/bknr/web/src/web/web-macros.lisp Thu Feb 14 10:42:55 2008 @@ -54,7 +54,14 @@ (defmacro with-http-body ((&key external-format) &body body) `(with-output-to-string (*html-stream*) - ,@body)) + (let ((*html-sink* (cxml:make-character-stream-sink *html-stream* :canonical nil :indentation 3))) + (sax:start-document *html-sink*) + (sax:start-dtd *html-sink* + "html" + "-//W3C//DTD XHTML 1.0 Transitional//EN" + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd") + ,@body + (sax:end-document *html-sink*)))) (defmacro with-image-from-uri ((image-variable prefix) &rest body) `(multiple-value-bind
participants (1)
-
ksprotte＠common-lisp.net