[bknr-cvs] r2168 - trunk/bknr/src/web
bknr at bknr.net
bknr at bknr.net
Sat Jul 7 12:41:44 UTC 2007
Author: hhubner
Date: 2007-07-07 08:41:43 -0400 (Sat, 07 Jul 2007)
New Revision: 2168
Modified:
trunk/bknr/src/web/handlers.lisp
trunk/bknr/src/web/user-handlers.lisp
trunk/bknr/src/web/web-macros.lisp
Log:
Push around some definitions to reduce the number of warnings.
Modified: trunk/bknr/src/web/handlers.lisp
===================================================================
--- trunk/bknr/src/web/handlers.lisp 2007-07-07 12:40:47 UTC (rev 2167)
+++ trunk/bknr/src/web/handlers.lisp 2007-07-07 12:41:43 UTC (rev 2168)
@@ -499,3 +499,64 @@
(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*)
+ (:html
+ (:head
+ (header :title title))
+ ((:body :class "cms")
+ ((:div :class "navigation")
+ (logo)
+ (:h1 (:princ-safe (website-name website)))
+ (navigation))
+ (:h1 (:princ-safe title))
+ (funcall fn)
+ (session-info)))))
+
+(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*)
+ (: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 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*)
+ (website-show-page *website* fn title)))
+ (handler-case
+ (let ((body (with-output-to-string (*html-stream*)
+ (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*)
+ (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))
+
+#+(or)
+(defmacro with-bknr-site-template ((req &key title) &rest body)
+ `(with-bknr-http-response (,req :content-type "text/html")
+ (with-http-body (,req ,ent)
+ (include
+ :template "toplevel-template"
+ :tag-body (with-output-to-string (*html-stream*)
+ , at body)))))
+
Modified: trunk/bknr/src/web/user-handlers.lisp
===================================================================
--- trunk/bknr/src/web/user-handlers.lisp 2007-07-07 12:40:47 UTC (rev 2167)
+++ trunk/bknr/src/web/user-handlers.lisp 2007-07-07 12:41:43 UTC (rev 2168)
@@ -71,7 +71,7 @@
(defmethod handle-object-form ((handler user-handler) action (user user) req)
(with-bknr-page (req :title #?"$((class-name (class-of user))) $((user-login user))")
- (bknr.images:user-image :user (user-login user))
+ #+(or) (bknr.images:user-image :user (user-login user))
(user-form :user-id (store-object-id user))))
(defmethod handle-object-form ((handler user-handler) (action (eql :search)) user req)
Modified: trunk/bknr/src/web/web-macros.lisp
===================================================================
--- trunk/bknr/src/web/web-macros.lisp 2007-07-07 12:40:47 UTC (rev 2167)
+++ trunk/bknr/src/web/web-macros.lisp 2007-07-07 12:41:43 UTC (rev 2168)
@@ -2,12 +2,20 @@
(enable-interpol-syntax)
+(defvar *bknr-debug* nil)
+(defvar *website* nil)
+
+(defvar *website-modules* (make-hash-table :test #'equal))
+
(defvar *req* nil "Current request")
(defvar *ent* nil "Current entity")
(defvar *session* nil "Current session")
(defvar *user* nil "Current user")
(defvar *req-var-hash* nil "Request variables")
+(defmacro with-bknr-page ((&rest args) &body body)
+ `(show-page-with-error-handlers (lambda () (html , at body)) , at args))
+
(defmacro with-cookies ((request &rest names) &rest body)
(let ((cookies (gensym)))
`(let ((,cookies (get-cookie-values ,request)))
@@ -77,67 +85,6 @@
, at body)
(register-tag-function ,(package-name *package*) ,(symbol-name name) (fdefinition ',name))))
-(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*)
- (:html
- (:head
- (header :title title))
- ((:body :class "cms")
- ((:div :class "navigation")
- (logo)
- (:h1 (:princ-safe (website-name website)))
- (navigation))
- (:h1 (:princ-safe title))
- (funcall fn)
- (session-info)))))
-
-(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*)
- (: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 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*)
- (website-show-page *website* fn title)))
- (handler-case
- (let ((body (with-output-to-string (*html-stream*)
- (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*)
- (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))
-
-#+(or)
-(defmacro with-bknr-site-template ((req &key title) &rest body)
- `(with-bknr-http-response (,req :content-type "text/html")
- (with-http-body (,req ,ent)
- (include
- :template "toplevel-template"
- :tag-body (with-output-to-string (*html-stream*)
- , at body)))))
-
(defmacro html-text-input (variable size &optional maxsize)
`((:input :type "text"
:size ,(format nil "~a" size)
More information about the Bknr-cvs
mailing list