[bknr-cvs] r2496 - branches/trunk-reorg/bknr/web/src/web - bknr-cvs@common-lisp.net - mailman3.common-lisp.net

14 Feb 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 ,@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

    