[bknr-cvs] r2146 - in trunk/bknr/src: . web - bknr-cvs@common-lisp.net - mailman3.common-lisp.net

14 Apr 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 @@
       ,@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 ,@body)) ,@args))

    