[bknr-cvs] ksprotte changed trunk/bknr/web/src/web/web-
BKNR Commits
bknr at bknr.net
Fri Aug 1 12:08:44 UTC 2008
Revision: 3719
Author: ksprotte
URL: http://bknr.net/trac/changeset/3719
whitespace cleanup and a tiny bit of refactoring in bknr web
U trunk/bknr/web/src/web/web-macros.lisp
U trunk/bknr/web/src/web/web-utils.lisp
Modified: trunk/bknr/web/src/web/web-macros.lisp
===================================================================
--- trunk/bknr/web/src/web/web-macros.lisp 2008-08-01 10:14:42 UTC (rev 3718)
+++ trunk/bknr/web/src/web/web-macros.lisp 2008-08-01 12:08:44 UTC (rev 3719)
@@ -13,81 +13,83 @@
(defmacro with-bknr-page ((&rest args) &body body)
`(show-page-with-error-handlers (lambda () (html , at body)) , at args))
-(defmacro with-cookies ((&rest names) &rest body)
+(defmacro with-cookies ((&rest names) &body body)
`(let ,(mapcar #'(lambda (name)
- `(,name (cookie-in ,(symbol-name name))))
- names)
- , at body))
+ `(,name (cookie-in ,(symbol-name name))))
+ names)
+ , at body))
-(defmacro with-query-params ((&rest params) &rest body)
+(defmacro with-query-params ((&rest params) &body body)
(let ((vars (loop for param in params
- when (and (symbolp param)
- (not (null param)))
- collect (list param `(query-param ,(string-downcase (symbol-name param))))
- when (consp param)
- collect (list (car param)
- `(or (parameter ,(string-downcase (symbol-name (car param))))
- ,(second param))))))
+ when (and (symbolp param)
+ (not (null param)))
+ collect (list param `(query-param ,(string-downcase (symbol-name param))))
+ when (consp param)
+ collect (list (car param)
+ `(or (parameter ,(string-downcase (symbol-name (car param))))
+ ,(second param))))))
(if vars
- `(let ,vars
- , at body)
- (first body))))
+ `(let ,vars
+ , at body)
+ (first body))))
(defmacro form-case (&rest cases)
`(cond
- ,@(mapcar #'(lambda (c)
- (if (eql (car c) t)
- `(t ,@(cdr c))
- `((parameter ,(symbol-name (car c)))
- (with-query-params (,@(cadr c))
- ,@(cddr c)))))
- cases)))
+ ,@(mapcar #'(lambda (c)
+ (if (eql (car c) t)
+ `(t ,@(cdr c))
+ `((parameter ,(symbol-name (car c)))
+ (with-query-params (,@(cadr c))
+ ,@(cddr c)))))
+ cases)))
-(defmacro with-http-response ((&key (content-type "text/html") (response +http-ok+)) &rest body)
+(defmacro with-http-response ((&key (content-type "text/html") (response +http-ok+)) &body body)
`(progn
- (setf (content-type) ,content-type)
- (setf (return-code) ,response)
- , at body))
+ (setf (content-type) ,content-type)
+ (setf (return-code) ,response)
+ , at body))
(defmacro with-http-body ((&key external-format) &body body)
+ (when external-format
+ (warn "EXTERNAL-FORMAT is ignored in WITH-HTTP-BODY"))
`(with-output-to-string (stream)
- (with-xhtml (stream)
- , at body)))
+ (with-xhtml (stream)
+ , at body)))
-(defmacro with-image-from-uri ((image-variable prefix) &rest body)
+(defmacro with-image-from-uri ((image-variable prefix) &body body)
`(multiple-value-bind
- (match strings)
- (scan-to-strings (format nil "/~a/([0-9]+)(|/.*)$" ,prefix) (script-name*))
- (unless match
- (http-error +http-bad-request+ "bad request - missing image path or loid"))
- (let ((,image-variable (store-object-with-id (parse-integer (elt strings 0)))))
- (unless ,image-variable
- (http-error +http-not-found+ "image not found"))
- , at body)))
+ (match strings)
+ (scan-to-strings (format nil "/~a/([0-9]+)(|/.*)$" ,prefix) (script-name*))
+ (unless match
+ (http-error +http-bad-request+ "bad request - missing image path or loid"))
+ (let ((,image-variable (store-object-with-id (parse-integer (elt strings 0)))))
+ (unless ,image-variable
+ (http-error +http-not-found+ "image not found"))
+ , at body)))
-(defmacro define-bknr-tag (name (&rest args) &rest body)
+(defmacro define-bknr-tag (name (&rest args) &body body)
`(prog1
- (defun ,name (, at args)
- , at body)
- (register-tag-function ,(package-name *package*) ,(symbol-name name) (fdefinition ',name))))
+ (defun ,name (, at args)
+ , at body)
+ (register-tag-function ,(package-name *package*) ,(symbol-name name) (fdefinition ',name))))
(defmacro html-text-input (variable size &optional maxsize)
- `((:input :type "text"
- :size ,(format nil "~a" size)
- :maxsize ,(format nil "~a" (or maxsize size))
- :name ,(symbol-name variable)
- :value ,(or variable ""))))
+ `((:input :type "text"
+ :size ,(format nil "~a" size)
+ :maxsize ,(format nil "~a" (or maxsize size))
+ :name ,(symbol-name variable)
+ :value ,(or variable ""))))
(defmacro html-warn (&rest warning)
"Generate a warning on the console and write the warning into the
currently generated XHTML output as a comment."
`(progn
- (html (:princ-safe (format nil "<!-- ~a -->~%" (format nil , at warning))))
- (warn , at warning)))
+ (html (:princ-safe (format nil "<!-- ~a -->~%" (format nil , at warning))))
+ (warn , at warning)))
(defmacro cmslink (url &body body)
`(html ((:a :class "cmslink" :href (website-make-path *website* ,url))
- , at body)))
+ , at body)))
(defvar *xml-sink*)
@@ -96,7 +98,7 @@
`(with-http-response (:content-type ,content-type)
(with-query-params (download)
(when download
- (setf (hunchentoot:header-out :content-disposition)
+ (setf (hunchentoot:header-out :content-disposition)
(format nil "attachment; filename=~A" download))))
(with-output-to-string (s)
(let ((*xml-sink* (cxml:make-character-stream-sink s :canonical nil)))
Modified: trunk/bknr/web/src/web/web-utils.lisp
===================================================================
--- trunk/bknr/web/src/web/web-utils.lisp 2008-08-01 10:14:42 UTC (rev 3718)
+++ trunk/bknr/web/src/web/web-utils.lisp 2008-08-01 12:08:44 UTC (rev 3719)
@@ -18,7 +18,7 @@
(defun redirect-uri (uri)
(make-instance 'uri :path (uri-path uri)
- :query (uri-query uri)))
+ :query (uri-query uri)))
(defun request-uploaded-files ()
"Return a list of UPLOAD structures describing the file uploads in the request."
@@ -27,7 +27,8 @@
(let ((uploads (remove-if-not #'listp (post-parameters*) :key #'cdr)) retval)
(dolist (upload-info uploads)
(destructuring-bind (name pathname original-filename content-type) upload-info
- (push (make-upload :name name :pathname pathname :original-filename original-filename :content-type content-type) retval)))
+ (push (make-upload :name name :pathname pathname :original-filename original-filename
+ :content-type content-type) retval)))
(nreverse retval))))
(aux-request-value 'uploaded-files))
@@ -36,12 +37,13 @@
(defmacro with-image-from-upload ((image upload &rest args) &body body)
`(with-image-from-file (,image (upload-pathname ,upload)
- (make-keyword-from-string (pathname-type (upload-original-filename ,upload))) , at args)
- , at body))
+ (make-keyword-from-string (pathname-type (upload-original-filename ,upload)))
+ , at args)
+ , at body))
(defmacro with-image-from-upload* ((upload &rest args) &body body)
`(with-image-from-upload (cl-gd:*default-image* ,upload , at args)
- , at body))
+ , at body))
(defmethod bknr.images:import-image ((upload upload) &rest args &key &allow-other-keys)
(apply #'bknr.images:import-image (upload-pathname upload)
@@ -56,12 +58,12 @@
macro after the request body has been executed."
(unless (aux-request-value 'bknr-parsed-parameters)
(setf (aux-request-value 'bknr-parsed-parameters)
- (remove-if (lambda (value)
- "Remove empty strings (reported as NIL) and uploaded files"
- (or (equal value "")
- (listp value)))
- (query-params)
- :key #'cdr)))
+ (remove-if (lambda (value)
+ "Remove empty strings (reported as NIL) and uploaded files"
+ (or (equal value "")
+ (listp value)))
+ (query-params)
+ :key #'cdr)))
(aux-request-value 'bknr-parsed-parameters))
(defun query-params (&key (get t) (post t))
@@ -85,8 +87,8 @@
(defun request-variables ()
(loop for key being the hash-keys of *req-var-hash*
- collect key
- collect (request-variable key)))
+ collect key
+ collect (request-variable key)))
(defun http-error (response message)
(with-bknr-page (:title #?"error: $(message)" :response response)
@@ -95,19 +97,19 @@
(defun keywords-from-query-param-list (param &key (remove-empty t))
(let ((keywords (mapcar #'(lambda (s)
- (make-keyword-from-string (string-trim '(#\Space #\Tab #\Newline) s)))
- param)))
+ (make-keyword-from-string (string-trim '(#\Space #\Tab #\Newline) s)))
+ param)))
(if remove-empty
- (remove-if #'(lambda (x) (eq x :||)) keywords)
- keywords)))
+ (remove-if #'(lambda (x) (eq x :||)) keywords)
+ keywords)))
(defun html-quote (string)
(regex-replace-all "([&<>])" string #'(lambda (target-string start end match-start &rest args)
- (declare (ignore start end args))
- (ecase (elt target-string match-start)
- (#\& "&")
- (#\< "<")
- (#\> ">")))))
+ (declare (ignore start end args))
+ (ecase (elt target-string match-start)
+ (#\& "&")
+ (#\< "<")
+ (#\> ">")))))
(defun parse-url ()
(values-list (cddr (mapcar #'url-decode (split "/" (script-name*))))))
@@ -119,16 +121,16 @@
(defun parse-date-field (name)
(let ((timespec (mapcar #'(lambda (var) (parse-integer
- (query-param (concatenate 'string name "-" var))
- :junk-allowed t))
- '("minute" "hour" "day" "month" "year"))))
+ (query-param (concatenate 'string name "-" var))
+ :junk-allowed t))
+ '("minute" "hour" "day" "month" "year"))))
(unless (car timespec)
(rplaca timespec 0))
(unless (cadr timespec)
(rplaca (cdr timespec) 0))
(if (every #'identity timespec)
- (apply #'encode-universal-time 0 timespec)
- nil)))
+ (apply #'encode-universal-time 0 timespec)
+ nil)))
(defun bknr-url-path (handler)
"Returns the Path of the request under the handler prefix"
@@ -137,7 +139,7 @@
(defun self-url (&key command prefix)
(destructuring-bind
- (empty old-prefix object-id &rest old-command)
+ (empty old-prefix object-id &rest old-command)
(split "/" (script-name*))
(declare (ignore empty))
#?"/$((or prefix old-prefix))/$(object-id)/$((or command old-command))"))
@@ -149,53 +151,53 @@
"Perform simple text to HTML conversion. http urls are replaced by links, internal links to
images become image tags."
(setf string (regex-replace-all
- #?r"bknr:([0-9A-Za-z$-_.+!*'()]+)" string
- #'(lambda (target-string start end match-start match-end reg-starts reg-ends)
- (declare (ignore start end match-start match-end))
- (let ((url (subseq target-string (aref reg-starts 0) (aref reg-ends 0))))
- (regex-replace-all "URL" (if (all-matches "^/image" url)
- "<img src=\"URL\" />"
- "<a href=\"URL\">URL</a>")
- url)))))
+ #?r"bknr:([0-9A-Za-z$-_.+!*'()]+)" string
+ #'(lambda (target-string start end match-start match-end reg-starts reg-ends)
+ (declare (ignore start end match-start match-end))
+ (let ((url (subseq target-string (aref reg-starts 0) (aref reg-ends 0))))
+ (regex-replace-all "URL" (if (all-matches "^/image" url)
+ "<img src=\"URL\" />"
+ "<a href=\"URL\">URL</a>")
+ url)))))
(setf string (regex-replace-all
- #?r"(http://[0-9A-Za-z$-_.+!*'()]+)" string
- #'(lambda (target-string start end match-start match-end &rest args)
- (declare (ignore start end args))
- (let ((url (subseq target-string match-start match-end)))
- (regex-replace-all "URL" (if (all-matches "(?i)\\.(gif|jpe?g|png)$" url)
- "<img src=\"URL\" />"
- "<a href=\"URL\" target=\"_blank\">URL</a>")
- url)))))
+ #?r"(http://[0-9A-Za-z$-_.+!*'()]+)" string
+ #'(lambda (target-string start end match-start match-end &rest args)
+ (declare (ignore start end args))
+ (let ((url (subseq target-string match-start match-end)))
+ (regex-replace-all "URL" (if (all-matches "(?i)\\.(gif|jpe?g|png)$" url)
+ "<img src=\"URL\" />"
+ "<a href=\"URL\" target=\"_blank\">URL</a>")
+ url)))))
(setf string (regex-replace-all "[\\r\\n]" string "<br>"))
string)
(defun make-wiki-hrefs (string)
(regex-replace-all #?r"\[(.+?)\]" string
- #'(lambda (target-string start end match-start match-end
- reg-starts reg-ends)
- (declare (ignore start end match-start match-end))
- (let ((keyword (subseq target-string
- (svref reg-starts 0)
- (svref reg-ends 0))))
- (format nil "<a class=\"wikilink\" href=\"/wiki/~a\">~a</a>"
- keyword
- keyword)))))
+ #'(lambda (target-string start end match-start match-end
+ reg-starts reg-ends)
+ (declare (ignore start end match-start match-end))
+ (let ((keyword (subseq target-string
+ (svref reg-starts 0)
+ (svref reg-ends 0))))
+ (format nil "<a class=\"wikilink\" href=\"/wiki/~a\">~a</a>"
+ keyword
+ keyword)))))
(defmacro bknr-handler-case (body &rest handler-forms)
`(if *bknr-debug*
- ,body
- (handler-case
- ,body
- , at handler-forms)))
+ ,body
+ (handler-case
+ ,body
+ , at handler-forms)))
(defun emit-element-attributes (attributes)
(loop for (key value) on attributes by #'cddr
- do (progn
- (princ " ")
- (princ (string-downcase (symbol-name key)))
- (princ "=\"")
- (princ value)
- (princ "\""))))
+ do (progn
+ (princ " ")
+ (princ (string-downcase (symbol-name key)))
+ (princ "=\"")
+ (princ value)
+ (princ "\""))))
(defun emit-html (&rest forms)
(let ((element (car forms)))
@@ -205,7 +207,7 @@
;; (:foo ...) or ((:foo ...) ...)
(cons (if (consp (car element))
(handle-tag (caar element) (cdar element) (cdr element)) ; ((:foo ...) ...)
- (handle-tag (car element) nil (cdr element)))) ; (:foo ...)
+ (handle-tag (car element) nil (cdr element)))) ; (:foo ...)
;; "foo"
(string (princ element))))
(when (cdr forms)
@@ -221,15 +223,15 @@
(when attributes
(emit-element-attributes attributes))
(if body
- ;; emit tag body
- (progn
- (princ ">")
- (apply #'emit-html body)
- (princ "</")
- (princ tag-name)
- (princ ">"))
- ;; empty body, close tag immediately
- (princ " />"))))
+ ;; emit tag body
+ (progn
+ (princ ">")
+ (apply #'emit-html body)
+ (princ "</")
+ (princ tag-name)
+ (princ ">"))
+ ;; empty body, close tag immediately
+ (princ " />"))))
(defun encode-urlencoded (string)
-(regex-replace-all #?r"\+" (url-encode string) "%20"))
+ (regex-replace-all #?r"\+" (url-encode string) "%20"))
More information about the Bknr-cvs
mailing list