[bknr-cvs] r2496 - branches/trunk-reorg/bknr/web/src/web
ksprotte at common-lisp.net
ksprotte at common-lisp.net
Thu Feb 14 15:42:55 UTC 2008
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 , at body)) , at 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*)
- , at 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")
+ , at body
+ (sax:end-document *html-sink*))))
(defmacro with-image-from-uri ((image-variable prefix) &rest body)
`(multiple-value-bind
More information about the Bknr-cvs
mailing list