Changeset 3719

Show
Ignore:
Timestamp:
08/01/08 14:08:44 (4 months ago)
Author:
ksprotte
Message:

whitespace cleanup and a tiny bit of refactoring in bknr web

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/bknr/web/src/web/web-macros.lisp

    r3270 r3719  
    1414  `(show-page-with-error-handlers (lambda () (html ,@body)) ,@args)) 
    1515 
    16 (defmacro with-cookies ((&rest names) &rest body) 
     16(defmacro with-cookies ((&rest names) &body body) 
    1717  `(let ,(mapcar #'(lambda (name) 
    18                     `(,name (cookie-in ,(symbol-name name)))) 
    19                 names) 
    20     ,@body)) 
     18                     `(,name (cookie-in ,(symbol-name name)))) 
     19                names) 
     20    ,@body)) 
    2121 
    22 (defmacro with-query-params ((&rest params) &rest body) 
     22(defmacro with-query-params ((&rest params) &body body) 
    2323  (let ((vars (loop for param in params 
    24                    when (and (symbolp param) 
    25                              (not (null param))) 
    26                    collect (list param `(query-param ,(string-downcase (symbol-name param)))) 
    27                    when (consp param) 
    28                    collect (list (car param) 
    29                                  `(or (parameter ,(string-downcase (symbol-name (car param)))) 
    30                                    ,(second param)))))) 
     24                 when (and (symbolp param) 
     25                           (not (null param))) 
     26                 collect (list param `(query-param ,(string-downcase (symbol-name param)))) 
     27                 when (consp param) 
     28                 collect (list (car param) 
     29                               `(or (parameter ,(string-downcase (symbol-name (car param)))) 
     30                                    ,(second param)))))) 
    3131    (if vars 
    32        `(let ,vars 
    33          ,@body) 
    34        (first body)))) 
     32        `(let ,vars 
     33           ,@body) 
     34        (first body)))) 
    3535 
    3636(defmacro form-case (&rest cases) 
    3737  `(cond 
    38     ,@(mapcar #'(lambda (c) 
    39                  (if (eql (car c) t) 
    40                      `(t ,@(cdr c)) 
    41                      `((parameter ,(symbol-name (car c))) 
    42                        (with-query-params (,@(cadr c)) 
    43                          ,@(cddr c))))) 
    44              cases))) 
     38    ,@(mapcar #'(lambda (c) 
     39                   (if (eql (car c) t) 
     40                       `(t ,@(cdr c)) 
     41                       `((parameter ,(symbol-name (car c))) 
     42                         (with-query-params (,@(cadr c)) 
     43                           ,@(cddr c))))) 
     44               cases))) 
    4545 
    46 (defmacro with-http-response ((&key (content-type "text/html") (response +http-ok+)) &rest body) 
     46(defmacro with-http-response ((&key (content-type "text/html") (response +http-ok+)) &body body) 
    4747  `(progn 
    48     (setf (content-type) ,content-type) 
    49     (setf (return-code) ,response) 
    50     ,@body)) 
     48    (setf (content-type) ,content-type) 
     49    (setf (return-code) ,response) 
     50    ,@body)) 
    5151 
    5252(defmacro with-http-body ((&key external-format) &body body) 
     53  (when external-format 
     54    (warn "EXTERNAL-FORMAT is ignored in WITH-HTTP-BODY")) 
    5355  `(with-output-to-string (stream) 
    54     (with-xhtml (stream) 
    55       ,@body))) 
     56    (with-xhtml (stream) 
     57      ,@body))) 
    5658 
    57 (defmacro with-image-from-uri ((image-variable prefix) &rest body) 
     59(defmacro with-image-from-uri ((image-variable prefix) &body body) 
    5860  `(multiple-value-bind 
    59     (match strings) 
    60     (scan-to-strings (format nil "/~a/([0-9]+)(|/.*)$" ,prefix) (script-name*)) 
    61     (unless match 
    62       (http-error +http-bad-request+ "bad request - missing image path or loid")) 
    63     (let ((,image-variable (store-object-with-id (parse-integer (elt strings 0))))) 
    64       (unless ,image-variable 
    65        (http-error +http-not-found+ "image not found")) 
    66       ,@body))) 
     61         (match strings) 
     62       (scan-to-strings (format nil "/~a/([0-9]+)(|/.*)$" ,prefix) (script-name*)) 
     63    (unless match 
     64      (http-error +http-bad-request+ "bad request - missing image path or loid")) 
     65    (let ((,image-variable (store-object-with-id (parse-integer (elt strings 0))))) 
     66      (unless ,image-variable 
     67         (http-error +http-not-found+ "image not found")) 
     68      ,@body))) 
    6769 
    68 (defmacro define-bknr-tag (name (&rest args) &rest body) 
     70(defmacro define-bknr-tag (name (&rest args) &body body) 
    6971  `(prog1 
    70     (defun ,name (,@args) 
    71       ,@body) 
    72     (register-tag-function ,(package-name *package*) ,(symbol-name name) (fdefinition ',name)))) 
     72       (defun ,name (,@args) 
     73         ,@body) 
     74    (register-tag-function ,(package-name *package*) ,(symbol-name name) (fdefinition ',name)))) 
    7375 
    7476(defmacro html-text-input (variable size &optional maxsize) 
    75   `((:input :type "text"  
    76            :size ,(format nil "~a" size) 
    77            :maxsize ,(format nil "~a" (or maxsize size)) 
    78            :name ,(symbol-name variable) 
    79            :value ,(or variable "")))) 
     77  `((:input :type "text" 
     78            :size ,(format nil "~a" size) 
     79            :maxsize ,(format nil "~a" (or maxsize size)) 
     80            :name ,(symbol-name variable) 
     81            :value ,(or variable "")))) 
    8082 
    8183(defmacro html-warn (&rest warning) 
    …… 
    8385currently generated XHTML output as a comment." 
    8486  `(progn 
    85     (html (:princ-safe (format nil "<!-- ~a -->~%" (format nil ,@warning)))) 
    86     (warn ,@warning))) 
     87    (html (:princ-safe (format nil "<!-- ~a -->~%" (format nil ,@warning)))) 
     88    (warn ,@warning))) 
    8789 
    8890(defmacro cmslink (url &body body) 
    8991  `(html ((:a :class "cmslink" :href (website-make-path *website* ,url)) 
    90          ,@body))) 
     92          ,@body))) 
    9193 
    9294(defvar *xml-sink*) 
    …… 
    9799     (with-query-params (download) 
    98100       (when download 
    99         (setf (hunchentoot:header-out :content-disposition) 
     101        (setf (hunchentoot:header-out :content-disposition) 
    100102               (format nil "attachment; filename=~A" download)))) 
    101103     (with-output-to-string (s) 

  • trunk/bknr/web/src/web/web-utils.lisp

    r3709 r3719  
    1919(defun redirect-uri (uri) 
    2020  (make-instance 'uri :path (uri-path uri) 
    21                 :query (uri-query uri))) 
     21                :query (uri-query uri))) 
    2222 
    2323(defun request-uploaded-files () 
    …… 
    2828            (dolist (upload-info uploads) 
    2929              (destructuring-bind (name pathname original-filename content-type) upload-info 
    30                 (push (make-upload :name name :pathname pathname :original-filename original-filename :content-type content-type) retval))) 
     30                (push (make-upload :name name :pathname pathname :original-filename original-filename 
     31                                   :content-type content-type) retval))) 
    3132            (nreverse retval)))) 
    3233  (aux-request-value 'uploaded-files)) 
    …… 
    3738(defmacro with-image-from-upload ((image upload &rest args) &body body) 
    3839  `(with-image-from-file (,image (upload-pathname ,upload) 
    39                           (make-keyword-from-string (pathname-type (upload-original-filename ,upload))) ,@args) 
    40     ,@body)) 
     40                                 (make-keyword-from-string (pathname-type (upload-original-filename ,upload))) 
     41                                 ,@args) 
     42     ,@body)) 
    4143 
    4244(defmacro with-image-from-upload* ((upload &rest args) &body body) 
    4345  `(with-image-from-upload (cl-gd:*default-image* ,upload ,@args) 
    44     ,@body)) 
     46    ,@body)) 
    4547 
    4648(defmethod bknr.images:import-image ((upload upload) &rest args &key &allow-other-keys) 
    …… 
    5759  (unless (aux-request-value 'bknr-parsed-parameters) 
    5860    (setf (aux-request-value 'bknr-parsed-parameters) 
    59            (remove-if (lambda (value) 
    60                          "Remove empty strings (reported as NIL) and uploaded files" 
    61                          (or (equal value "") 
    62                              (listp value))) 
    63                        (query-params) 
    64                        :key #'cdr))) 
     61          (remove-if (lambda (value) 
     62                       "Remove empty strings (reported as NIL) and uploaded files" 
     63                       (or (equal value "") 
     64                           (listp value))) 
     65                     (query-params) 
     66                     :key #'cdr))) 
    6567  (aux-request-value 'bknr-parsed-parameters)) 
    6668 
    …… 
    8688(defun request-variables () 
    8789  (loop for key being the hash-keys of *req-var-hash* 
    88        collect key 
    89        collect (request-variable key))) 
     90     collect key 
     91     collect (request-variable key))) 
    9092 
    9193(defun http-error (response message) 
    …… 
    9698(defun keywords-from-query-param-list (param &key (remove-empty t)) 
    9799  (let ((keywords (mapcar #'(lambda (s) 
    98                              (make-keyword-from-string (string-trim '(#\Space #\Tab #\Newline) s))) 
    99                          param))) 
     100                              (make-keyword-from-string (string-trim '(#\Space #\Tab #\Newline) s))) 
     101                          param))) 
    100102    (if remove-empty 
    101        (remove-if #'(lambda (x) (eq x :||)) keywords) 
    102        keywords))) 
     103        (remove-if #'(lambda (x) (eq x :||)) keywords) 
     104        keywords))) 
    103105 
    104106(defun html-quote (string) 
    105107  (regex-replace-all "([&<>])" string #'(lambda (target-string start end match-start &rest args) 
    106                                          (declare (ignore start end args)) 
    107                                          (ecase (elt target-string match-start) 
    108                                            (#\& "&amp;") 
    109                                            (#\< "&lt;") 
    110                                            (#\> "&gt;"))))) 
     108                                          (declare (ignore start end args)) 
     109                                          (ecase (elt target-string match-start) 
     110                                            (#\& "&amp;") 
     111                                            (#\< "&lt;") 
     112                                            (#\> "&gt;"))))) 
    111113 
    112114(defun parse-url () 
    …… 
    120122(defun parse-date-field (name) 
    121123  (let ((timespec (mapcar #'(lambda (var) (parse-integer 
    122                                           (query-param (concatenate 'string name "-" var)) 
    123                                           :junk-allowed t)) 
    124                          '("minute" "hour" "day" "month" "year")))) 
     124                                           (query-param (concatenate 'string name "-" var)) 
     125                                           :junk-allowed t)) 
     126                          '("minute" "hour" "day" "month" "year")))) 
    125127    (unless (car timespec) 
    126128      (rplaca timespec 0)) 
    …… 
    128130      (rplaca (cdr timespec) 0)) 
    129131    (if (every #'identity timespec) 
    130        (apply #'encode-universal-time 0 timespec) 
    131        nil))) 
     132        (apply #'encode-universal-time 0 timespec) 
     133        nil))) 
    132134 
    133135(defun bknr-url-path (handler) 
    …… 
    138140(defun self-url (&key command prefix) 
    139141  (destructuring-bind 
    140        (empty old-prefix object-id &rest old-command) 
     142        (empty old-prefix object-id &rest old-command) 
    141143      (split "/" (script-name*)) 
    142144    (declare (ignore empty)) 
    …… 
    150152images become image tags." 
    151153  (setf string (regex-replace-all 
    152                #?r"bknr:([0-9A-Za-z$-_.+!*'()]+)" string 
    153                #'(lambda (target-string start end match-start match-end reg-starts reg-ends) 
    154                    (declare (ignore start end match-start match-end)) 
    155                    (let ((url (subseq target-string (aref reg-starts 0) (aref reg-ends 0)))) 
    156                      (regex-replace-all "URL" (if (all-matches "^/image" url) 
    157                                                   "<img src=\"URL\" />" 
    158                                                   "<a href=\"URL\">URL</a>") 
    159                                         url))))) 
     154                #?r"bknr:([0-9A-Za-z$-_.+!*'()]+)" string 
     155                #'(lambda (target-string start end match-start match-end reg-starts reg-ends) 
     156                    (declare (ignore start end match-start match-end)) 
     157                    (let ((url (subseq target-string (aref reg-starts 0) (aref reg-ends 0)))) 
     158                      (regex-replace-all "URL" (if (all-matches "^/image" url) 
     159                                                   "<img src=\"URL\" />" 
     160                                                   "<a href=\"URL\">URL</a>") 
     161                                        url))))) 
    160162  (setf string (regex-replace-all 
    161                #?r"(http://[0-9A-Za-z$-_.+!*'()]+)" string 
    162                #'(lambda (target-string start end match-start match-end &rest args) 
    163                    (declare (ignore start end args)) 
    164                    (let ((url (subseq target-string match-start match-end))) 
    165                      (regex-replace-all "URL" (if (all-matches "(?i)\\.(gif|jpe?g|png)$" url) 
    166                                                   "<img src=\"URL\" />" 
    167                                                   "<a href=\"URL\" target=\"_blank\">URL</a>") 
    168                                         url))))) 
     163                #?r"(http://[0-9A-Za-z$-_.+!*'()]+)" string 
     164                #'(lambda (target-string start end match-start match-end &rest args) 
     165                    (declare (ignore start end args)) 
     166                    (let ((url (subseq target-string match-start match-end))) 
     167                      (regex-replace-all "URL" (if (all-matches "(?i)\\.(gif|jpe?g|png)$" url) 
     168                                                   "<img src=\"URL\" />" 
     169                                                   "<a href=\"URL\" target=\"_blank\">URL</a>") 
     170                                        url))))) 
    169171  (setf string (regex-replace-all "[\\r\\n]" string "<br>")) 
    170172  string) 
    …… 
    172174(defun make-wiki-hrefs (string) 
    173175  (regex-replace-all #?r"\[(.+?)\]" string 
    174                     #'(lambda (target-string start end match-start match-end 
    175                                reg-starts reg-ends) 
    176                         (declare (ignore start end match-start match-end)) 
    177                         (let ((keyword (subseq target-string 
    178                                                (svref reg-starts 0) 
    179                                                (svref reg-ends 0)))) 
    180                           (format nil "<a class=\"wikilink\" href=\"/wiki/~a\">~a</a>" 
    181                                   keyword 
    182                                   keyword))))) 
     176                     #'(lambda (target-string start end match-start match-end 
     177                                reg-starts reg-ends) 
     178                        (declare (ignore start end match-start match-end)) 
     179                        (let ((keyword (subseq target-string 
     180                                                (svref reg-starts 0) 
     181                                                (svref reg-ends 0)))) 
     182                           (format nil "<a class=\"wikilink\" href=\"/wiki/~a\">~a</a>" 
     183                                   keyword 
     184                                   keyword))))) 
    183185 
    184186(defmacro bknr-handler-case (body &rest handler-forms) 
    185187  `(if *bknr-debug* 
    186     ,body 
    187     (handler-case 
    188        ,body 
    189       ,@handler-forms))) 
     188       ,body 
     189       (handler-case 
     190           ,body 
     191         ,@handler-forms))) 
    190192 
    191193(defun emit-element-attributes (attributes) 
    192194  (loop for (key value) on attributes by #'cddr 
    193         do (progn 
    194              (princ " ") 
    195              (princ (string-downcase (symbol-name key))) 
    196              (princ "=\"") 
    197              (princ value) 
    198              (princ "\"")))) 
     195     do (progn 
     196          (princ " ") 
     197          (princ (string-downcase (symbol-name key))) 
     198          (princ "=\"") 
     199          (princ value) 
     200          (princ "\"")))) 
    199201 
    200202(defun emit-html (&rest forms) 
    …… 
    206208      (cons (if (consp (car element)) 
    207209                (handle-tag (caar element) (cdar element) (cdr element)) ; ((:foo ...) ...) 
    208                 (handle-tag (car element) nil (cdr element))))           ; (:foo ...) 
     210                (handle-tag (car element) nil (cdr element)))) ; (:foo ...) 
    209211      ;; "foo" 
    210212      (string (princ element)))) 
    …… 
    222224      (emit-element-attributes attributes)) 
    223225    (if body 
    224        ;; emit tag body 
    225        (progn 
    226          (princ ">") 
    227          (apply #'emit-html body) 
    228          (princ "</") 
    229          (princ tag-name) 
    230          (princ ">")) 
    231        ;; empty body, close tag immediately 
    232        (princ " />")))) 
     226        ;; emit tag body 
     227        (progn 
     228          (princ ">") 
     229          (apply #'emit-html body) 
     230          (princ "</") 
     231          (princ tag-name) 
     232          (princ ">")) 
     233        ;; empty body, close tag immediately 
     234        (princ " />")))) 
    233235 
    234236(defun encode-urlencoded (string) 
    235 (regex-replace-all #?r"\+" (url-encode string) "%20")) 
     237  (regex-replace-all #?r"\+" (url-encode string) "%20"))