[clhp-cvs] CVS update: clhp/clhp.lisp clhp/cgi.lisp clhp/ChangeLog
Anthony Ventimiglia
aventimiglia at common-lisp.net
Wed Oct 8 15:43:33 UTC 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 (, at bindings) (cond , at body)))
+
+(defmacro if-bind ((&rest bindings) test if else)
+ "An IF wrapped in a LET"
+ `(let (, at 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 at 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 at 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
More information about the Clhp-cvs
mailing list