[clhp-cvs] CVS update: clhp/clhp.lisp clhp/cgi.lisp clhp/ChangeLog - clhp-cvs@common-lisp.net - mailman3.common-lisp.net

8 Oct 2003

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

    