[bknr-cvs] r2146 - in trunk/bknr/src: . web
bknr at bknr.net
bknr at bknr.net
Sat Apr 14 16:14:58 UTC 2007
Author: hhubner
Date: 2007-04-14 12:14:58 -0400 (Sat, 14 Apr 2007)
New Revision: 2146
Modified:
trunk/bknr/src/packages.lisp
trunk/bknr/src/web/handlers.lisp
trunk/bknr/src/web/web-macros.lisp
Log:
Make show-page and show-error-page generic functions specialized on the
website class.
Modified: trunk/bknr/src/packages.lisp
===================================================================
--- trunk/bknr/src/packages.lisp 2007-04-14 16:11:17 UTC (rev 2145)
+++ trunk/bknr/src/packages.lisp 2007-04-14 16:14:58 UTC (rev 2146)
@@ -282,6 +282,8 @@
#:website-name
#:website-hosts
#:website-authorizer
+ #:website-show-page
+ #:website-show-error
#:website-handler-definitions
#:website-admin-navigation
#:website-navigation
Modified: trunk/bknr/src/web/handlers.lisp
===================================================================
--- trunk/bknr/src/web/handlers.lisp 2007-04-14 16:11:17 UTC (rev 2145)
+++ trunk/bknr/src/web/handlers.lisp 2007-04-14 16:14:58 UTC (rev 2146)
@@ -54,11 +54,7 @@
(template-command-packages :initarg :template-command-packages
:reader website-template-command-packages)
(template-handler :initform nil
- :reader website-template-handler)
- (show-page-function :initarg :show-page-function
- :accessor website-show-page-function)
- (show-error-page-function :initarg :show-error-page-function
- :accessor website-show-error-page-function))
+ :reader website-template-handler))
(:default-initargs :url nil
:vhosts :wild
:authorizer (make-instance 'bknr-authorizer)
@@ -73,8 +69,6 @@
:import-spool-directory #p"/home/bknr/spool/"
:template-base-directory nil
:template-command-packages nil
- :show-page-function #'show-page
- :show-error-page-function #'show-error-page
:rss-feed-url nil))
(defmethod initialize-instance :after ((website website) &key &allow-other-keys)
@@ -238,7 +232,7 @@
(if (member :notrap net.aserve::*debug-current* :test #'eq)
(handle handler req)
(handler-bind ((error #'(lambda (e)
- (funcall (website-show-error-page-function *website*) e)
+ (website-show-error-page *website* e)
(do-error-log-request req e)
(error e))))
(handle handler req))))
Modified: trunk/bknr/src/web/web-macros.lisp
===================================================================
--- trunk/bknr/src/web/web-macros.lisp 2007-04-14 16:11:17 UTC (rev 2145)
+++ trunk/bknr/src/web/web-macros.lisp 2007-04-14 16:14:58 UTC (rev 2146)
@@ -77,7 +77,7 @@
, at body)
(register-tag-function ,(package-name *package*) ,(symbol-name name) (fdefinition ',name))))
-(defun show-page (fn title)
+(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*)
@@ -87,15 +87,15 @@
((:body :class "cms")
((:div :class "navigation")
(logo)
- (:h1 (:princ-safe (website-name *website*)))
+ (:h1 (:princ-safe (website-name website)))
(navigation))
(:h1 (:princ-safe title))
(funcall fn)
(session-info)))))
-(defun show-error-page (error)
- (if (website-template-handler *website*)
- (send-error-response (website-template-handler *website*) *req* (princ-to-string error))
+(defmethod website-show-error-page ((website website) error)
+ (if (website-template-handler website)
+ (send-error-response (website-template-handler website) *req* (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*)
@@ -107,25 +107,23 @@
(:p "While processing your request, an error occured:")
(:pre (:princ-safe error)))))))
-(defun show-page-with-error-handlers (fn req &key response title
- (show-page (website-show-page-function *website*))
- (show-error-page (website-show-error-page-function *website*)))
+(defun show-page-with-error-handlers (fn req &key response title)
(unless response
(setf response *response-ok*)) ; can't default because used from macros and *response-ok* is not a constant
(if (member :notrap net.aserve::*debug-current*)
(with-bknr-http-response (req :content-type "text/html; charset=UTF-8" :response response)
(with-http-body (req *ent*)
- (funcall show-page fn title)))
+ (website-show-page *website* fn title)))
(handler-case
(let ((body (with-output-to-string (*html-stream*)
- (funcall show-page fn title))))
+ (website-show-page *website* fn title))))
(with-bknr-http-response (req :content-type "text/html; charset=UTF-8" :response response)
(with-http-body (req *ent*)
(princ body *html-stream*))))
(serious-condition (c)
(with-bknr-http-response (req :content-type "text/html; charset=UTF-8" :response *response-internal-server-error*)
(with-http-body (req *ent*)
- (funcall show-error-page c)))))))
+ (website-show-error-page *website* c)))))))
(defmacro with-bknr-page ((&rest args) &body body)
`(show-page-with-error-handlers (lambda () (html , at body)) , at args))
More information about the Bknr-cvs
mailing list