Update of /project/clhp/cvsroot/clhp In directory common-lisp.net:/tmp/cvs-serv29753 Modified Files: clhp.lisp cgi.lisp ChangeLog Log Message: (cond-bind): Addedd COND-BIND, basically it's a COND wrapped up inside a LET. Imported into clhp, and used there as well. (IF-BIND): This is similar to COND-BIND, the whole aim here is to reduce parentheses and make it all a little more readable Date: Wed Oct 8 11:43:33 2003 Author: aventimiglia Index: clhp/clhp.lisp diff -u clhp/clhp.lisp:1.10 clhp/clhp.lisp:1.11 --- clhp/clhp.lisp:1.10 Thu Oct 2 22:40:39 2003 +++ clhp/clhp.lisp Wed Oct 8 11:43:33 2003 @@ -1,5 +1,5 @@ (ext:file-comment - "$Id: clhp.lisp,v 1.10 2003/10/03 02:40:39 aventimiglia Exp $") + "$Id: clhp.lisp,v 1.11 2003/10/08 15:43:33 aventimiglia Exp $") ;; ;; CLHP the Common Lisp Hypertext Preprocessor ;; (C) 2003 Anthony J Ventimiglia @@ -27,6 +27,7 @@ (defpackage :clhp (:use :cgi :cl) + (:import-from :cgi #:cond-bind #:list-to-a-list) (:export #:parse #:*clhp-version* #:echo #:include #:xml-element #:make-xml-element #:copy-xml-element #:xml-element-attributes #:xml-element-name #:xml-element-contents #:xml-element-p #:tag)) @@ -38,7 +39,7 @@ ;; will override the CVS keyword (defconstant *CLHP-VERSION* #.(or nil ; Set this for releases - (let* ((trimmed (string-trim "$ Date:" "$Date: 2003/10/03 02:40:39 $")) + (let* ((trimmed (string-trim "$ Date:" "$Date: 2003/10/08 15:43:33 $")) (date (subseq trimmed 0 (search " " trimmed)))) (concatenate 'string (subseq date 0 4) @@ -115,10 +116,9 @@ the <?clhp ?> elements, and dumps the rest through unscathed." (declare (type (array character 1) buffer) (type fixnum end)) - (let ((index (if in-block - (find-pi-end buffer :start start :end end) - (find-pi-start buffer :start start :end end)))) - (cond + (cond-bind ((index (if in-block + (find-pi-end buffer :start start :end end) + (find-pi-start buffer :start start :end end)))) ((>= start end) ; Done with this buffer nil) ((and in-block index) ; Found the end of a code-block @@ -135,7 +135,7 @@ :in-block t)) (in-block (signal 'parse-error)) (t ; Not in code-block no start in sight - (write-sequence buffer *standard-output* :start start :end end))))) + (write-sequence buffer *standard-output* :start start :end end)))) (defun evaluate-code-block (code-block) "Read the Lisp object represented by CODE-BLOCK, and evaluate it." @@ -198,7 +198,7 @@ --> <IMG SRC=\"pic.png\"></IMG>" (multiple-value-bind (att-list contents) - (cgi::list-to-a-list (cdr args)) + (list-to-a-list (cdr args)) (make-xml-element :name (car args) :attributes att-list :contents contents))) Index: clhp/cgi.lisp diff -u clhp/cgi.lisp:1.6 clhp/cgi.lisp:1.7 --- clhp/cgi.lisp:1.6 Thu Oct 2 22:40:39 2003 +++ clhp/cgi.lisp Wed Oct 8 11:43:33 2003 @@ -1,4 +1,4 @@ -#+cmu (ext:file-comment "$Id: cgi.lisp,v 1.6 2003/10/03 02:40:39 aventimiglia Exp $") +#+cmu (ext:file-comment "$Id: cgi.lisp,v 1.7 2003/10/08 15:43:33 aventimiglia Exp $") ;; ;; CLHP the Common Lisp Hypertext Preprocessor ;; (C) 2003 Anthony J Ventimiglia @@ -45,6 +45,15 @@ "returns the value from a (KEY . VALUE) A-LIST" `(cadr (assoc ,key ,a-list))) +(defmacro cond-bind ((&rest bindings) &body body) + "A COND wrapped in a Let" + `(let (,@bindings) (cond ,@body))) + +(defmacro if-bind ((&rest bindings) test if else) + "An IF wrapped in a LET" + `(let (,@bindings) (if ,test ,if ,else))) + + ;; External Symbol section (defvar *server-env* nil @@ -94,14 +103,14 @@ accessed" (setf *server-env* (ca-list-to-a-list ext:*environment-list*) *query-vars* - (let ((request-method (make-keyword + (cond-bind + ((request-method (make-keyword (a-list-value :REQUEST_METHOD *server-env*)))) - (cond - ((eql request-method :POST) - (query-to-a-list (post-data))) - ((eql request-method :GET) - (query-to-a-list (get-data)))))) + ((eql request-method :POST) + (query-to-a-list (post-data))) + ((eql request-method :GET) + (query-to-a-list (get-data))))) (values)) ;; @@ -129,12 +138,12 @@ (labels ((split (char-list split-list) - (let ((position (position char char-list))) - (if (null position) + (if-bind ((position (position char char-list))) + (null position) (remove nil (nreverse (cons char-list split-list))) (split (nthcdr (1+ position) char-list) (cons (butlast char-list (- (length char-list) position)) - split-list)))))) + split-list))))) (split char-list nil))) ;; !!!!!!!!! This should most likely be tested and improved , because @@ -202,35 +211,35 @@ :message (format nil "~S is a malformed URL encoded string." (implode-string char-list)))) - (decode-next (encoded-part &optional decoded-part) - (let ((front-char (car encoded-part))) - (cond - ((null encoded-part) (nreverse decoded-part)) - ((char= #\% front-char) - (if (<= 3 (length encoded-part)) - (decode-next (cdddr encoded-part) - (cons (decode-char - (subseq encoded-part 1 3)) - decoded-part)) - (decode-error))) - ((char= #\+ front-char) - (decode-next (cdr encoded-part) - (cons #\Space decoded-part))) - (t (decode-next (cdr encoded-part) - (cons front-char decoded-part)))))) + (decode-next + (encoded-part &optional decoded-part) + (cond-bind ((front-char (car encoded-part))) + ((null encoded-part) (nreverse decoded-part)) + ((char= #\% front-char) + (if (<= 3 (length encoded-part)) + (decode-next (cdddr encoded-part) + (cons (decode-char + (subseq encoded-part 1 3)) + decoded-part)) + (decode-error))) + ((char= #\+ front-char) + (decode-next (cdr encoded-part) + (cons #\Space decoded-part))) + (t (decode-next (cdr encoded-part) + (cons front-char decoded-part))))) (hex2dec (string-num) (setf *read-base* 16) (prog1 (read-from-string string-num) (setf *read-base* 10))) (decode-char (char-code-list) - (let ((great (car char-code-list)) - (least (cadr char-code-list))) - (if (and (digit-char-p great 16) - (digit-char-p least 16)) - (code-char (hex2dec - (format nil "~a~a" great least))) - (decode-error))))) + (if-bind ((great (car char-code-list)) + (least (cadr char-code-list))) + (and (digit-char-p great 16) + (digit-char-p least 16)) + (code-char (hex2dec + (format nil "~a~a" great least))) + (decode-error)))) (decode-next char-list)))) (defun implode-string (char-list) Index: clhp/ChangeLog diff -u clhp/ChangeLog:1.9 clhp/ChangeLog:1.10 --- clhp/ChangeLog:1.9 Fri Oct 3 01:14:23 2003 +++ clhp/ChangeLog Wed Oct 8 11:43:33 2003 @@ -1,3 +1,11 @@ +2003-10-08 <ant@afghan.dogpound> + + * cgi.lisp, clhp.lisp (cond-bind): Addedd COND-BIND, basically + it's a COND wrapped up inside a LET. Imported into clhp, and used + there as well. + (IF-BIND): This is similar to COND-BIND, the whole aim here is to + reduce parentheses and make it all a little more readable + 2003-10-03 <ant@afghan.dogpound> * tests/cgi-test.lisp (SIDE-EFFECT-FUNCTION-TEST-DATA): Test class @@ -54,4 +62,4 @@ used to create tables from (CONS . TYPE) a-lists. Also added some comments. -$Id: ChangeLog,v 1.9 2003/10/03 05:14:23 aventimiglia Exp $ \ No newline at end of file +$Id: ChangeLog,v 1.10 2003/10/08 15:43:33 aventimiglia Exp $ \ No newline at end of file