[bknr-cvs] r2510 - in branches/trunk-reorg: bknr/web/src/web projects/quickhoney/website/static xhtmlgen
hhubner at common-lisp.net
hhubner at common-lisp.net
Fri Feb 15 21:22:22 UTC 2008
Author: hhubner
Date: Fri Feb 15 16:22:21 2008
New Revision: 2510
Modified:
branches/trunk-reorg/bknr/web/src/web/handlers.lisp
branches/trunk-reorg/bknr/web/src/web/rss-handlers.lisp
branches/trunk-reorg/bknr/web/src/web/template-handler.lisp
branches/trunk-reorg/bknr/web/src/web/web-utils.lisp
branches/trunk-reorg/projects/quickhoney/website/static/styles.css
branches/trunk-reorg/xhtmlgen/xhtmlgen.lisp
Log:
More xhtmlgen fixes.
Make error handling work again. Errors are displayed to the user unless
*catch-errors-p* is true.
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 Fri Feb 15 16:22:21 2008
@@ -233,15 +233,16 @@
(redirect-uri (parse-uri (script-name))))
(redirect (website-make-path *website* "login")))
(if *catch-errors-p*
- (handle handler)
- (handler-bind ((error #'(lambda (e)
- (with-http-response (:content-type "text/html; charset=UTF-8"
- :response +http-internal-server-error+)
- (with-http-body ()
- (website-show-error-page *website* e)))
- (do-error-log-request e)
- (error e))))
- (handle handler))))
+ (handler-bind
+ ((error #'(lambda (e)
+ (with-http-response (:content-type "text/html; charset=UTF-8"
+ :response +http-internal-server-error+)
+ (return-from invoke-handler (prog1
+ (with-http-body ()
+ (website-show-error-page *website* e))
+ (do-error-log-request e)))))))
+ (handle handler))
+ (handle handler)))
(handler-case
(mapcar #'delete-file (mapcar #'cdr (request-uploaded-files)))
(error (e)
@@ -468,8 +469,7 @@
(defgeneric xml-object-handler-show-object (handler object))
(defmethod xml-object-handler-show-object ((handler xml-object-handler) object)
- (write-to-xml object
- :string-rod-fn #'cxml::utf8-string-to-rod))
+ (write-to-xml object))
(defmethod handle-object ((handler xml-object-handler) object)
(xml-object-handler-show-object handler object))
@@ -499,8 +499,8 @@
(defmethod handle-object ((handler blob-handler) (blob blob))
(with-http-response (:content-type (blob-mime-type blob))
(setf (content-length) (blob-size blob))
- (with-http-body (:external-format '(unsigned-byte 8))
- (blob-to-stream blob *html-stream*))))
+ (let ((stream (send-headers)))
+ (blob-to-stream blob stream))))
(defclass import-handler (form-handler)
((require-user-flag :initform :admin)
@@ -522,7 +522,6 @@
(defmethod website-show-page ((website website) fn title)
(html
-
(:html
(:head
(header :title title))
@@ -535,6 +534,20 @@
(funcall fn)
(session-info)))))
+(defmethod website-show-error-page ((website website) error)
+ (if (and (website-template-handler website)
+ (error-template-pathname (website-template-handler website)))
+ (send-error-response (website-template-handler website) (princ-to-string error))
+ (html
+ (: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)
(with-http-response (:content-type "text/html; charset=UTF-8" :response response)
Modified: branches/trunk-reorg/bknr/web/src/web/rss-handlers.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/rss-handlers.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/web/rss-handlers.lisp Fri Feb 15 16:22:21 2008
@@ -10,5 +10,5 @@
(defmethod handle-object ((handler rss-handler) (channel bknr.rss:rss-channel))
(with-http-response (:content-type "text/xml; charset=UTF-8")
- (with-http-body ()
- (bknr.rss:rss-channel-xml channel *html-stream*))))
+ (with-output-to-string (stream)
+ (bknr.rss:rss-channel-xml channel stream))))
Modified: branches/trunk-reorg/bknr/web/src/web/template-handler.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/template-handler.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/web/template-handler.lisp Fri Feb 15 16:22:21 2008
@@ -262,13 +262,16 @@
env)))
(template-not-found template-pathname))))
+(defmethod error-template-pathname (handler &optional (error-type "user-error"))
+ (find-template-pathname handler error-type))
+
(defun send-error-response (handler message &key (response-code +http-internal-server-error+))
(with-http-response (:content-type "text/html; charset=UTF-8"
:response response-code)
(with-output-to-string (stream)
(emit-template handler
stream
- (get-cached-template (find-template-pathname handler "user-error") handler)
+ (get-cached-template (error-template-pathname handler) handler)
(acons :error-message message
(initial-template-environment
handler))))))
Modified: branches/trunk-reorg/bknr/web/src/web/web-utils.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/web-utils.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/web/web-utils.lisp Fri Feb 15 16:22:21 2008
@@ -120,8 +120,7 @@
value))
(defun query-param-list (param-name)
- (format *debug-io* "questionable: query-param-list~%")
- (assoc-values param-name (request-query) :test #'string-equal))
+ (assoc-values param-name (get-parameters) :test #'string-equal))
(defun request-variable (var)
(gethash var *req-var-hash*))
Modified: branches/trunk-reorg/projects/quickhoney/website/static/styles.css
==============================================================================
--- branches/trunk-reorg/projects/quickhoney/website/static/styles.css (original)
+++ branches/trunk-reorg/projects/quickhoney/website/static/styles.css Fri Feb 15 16:22:21 2008
@@ -425,3 +425,11 @@
width: 0px;
border: 0px none #FFFFFF;
}
+
+.error {
+ margin: 2em;
+ padding: 1em;
+ border: 1pt solid #aa0000;
+ color:#f00;
+ font-size: 110%;
+}
\ No newline at end of file
Modified: branches/trunk-reorg/xhtmlgen/xhtmlgen.lisp
==============================================================================
--- branches/trunk-reorg/xhtmlgen/xhtmlgen.lisp (original)
+++ branches/trunk-reorg/xhtmlgen/xhtmlgen.lisp Fri Feb 15 16:22:21 2008
@@ -142,11 +142,8 @@
(defun emit-without-quoting (str)
;; das ist fuer WPDISPLAY
- (format t "emit-without-quoting does not work~%")
- #+(or)
- (let ((s (cxml::chained-handler *html-sink*)))
- (cxml::maybe-close-tag s)
- (map nil (lambda (c) (cxml::write-rune c s)) str)))
+ (cxml::maybe-close-tag *html-sink*)
+ (map nil (lambda (c) (cxml::%write-rune c *html-sink*)) str))
(defun princ-http (val)
#+(or)
More information about the Bknr-cvs
mailing list