[rfc2388-cvs] CVS update: rfc2388/rfc2388.lisp
Janis Dzerins
jdzerins at common-lisp.net
Tue Aug 2 09:01:48 UTC 2005
Update of /project/rfc2388/cvsroot/rfc2388
In directory common-lisp.net:/tmp/cvs-serv20604
Modified Files:
rfc2388.lisp
Log Message:
Code cleanup (with untabify).
Date: Tue Aug 2 11:01:47 2005
Author: jdzerins
Index: rfc2388/rfc2388.lisp
diff -u rfc2388/rfc2388.lisp:1.8 rfc2388/rfc2388.lisp:1.9
--- rfc2388/rfc2388.lisp:1.8 Tue Aug 2 10:46:00 2005
+++ rfc2388/rfc2388.lisp Tue Aug 2 11:01:47 2005
@@ -50,10 +50,8 @@
(let ((length (length boundary)))
(unless (<= 1 length 70)
(warn "Boundary has invalid length -- must be between 1 and 70, but is: ~S" length))
- (let ((last-char (schar boundary (1- length))))
- (when (or (char= last-char #\space)
- (char= last-char #\tab))
- (warn "Boundary has trailing whitespace: ~S" boundary))))
+ (when (lwsp-char-p (schar boundary (1- length)))
+ (warn "Boundary has trailing whitespace: ~S" boundary)))
(flet ((run (result)
"This one writes everything up to a boundary to RESULT stream,
@@ -87,9 +85,9 @@
(setq closed t)
(return))
- #-(and)
- (format t "~&S:~D BI:~2,'0D CH:~:[~;*~]~S~%"
- state boundary-index leave-char char)
+ #-(and)
+ (format t "~&S:~D QI:~D BI:~2,'0D CH:~:[~;*~]~S~%"
+ state queue-index boundary-index leave-char char)
(case state
(1 ;; optional starting CR
@@ -373,7 +371,7 @@
(defstruct (content-type (:type list)
- (:constructor make-content-type (super sub)))
+ (:constructor make-content-type (super sub)))
super
sub)
@@ -381,25 +379,25 @@
(defun parse-content-type (string)
"Returns content-type which is parsed from STRING."
(let ((sep-offset (position #\/ string))
- (type (array-element-type string)))
+ (type (array-element-type string)))
(if (numberp sep-offset)
- (make-content-type (make-array sep-offset
- :element-type type
- :displaced-to string)
- (make-array (- (length string) (incf sep-offset))
- :element-type type
- :displaced-to string
- :displaced-index-offset sep-offset))
- (make-content-type string nil))))
+ (make-content-type (make-array sep-offset
+ :element-type type
+ :displaced-to string)
+ (make-array (- (length string) (incf sep-offset))
+ :element-type type
+ :displaced-to string
+ :displaced-index-offset sep-offset))
+ (make-content-type string nil))))
(defun unparse-content-type (ct)
"Returns content-type CT in string representation."
(let ((super (content-type-super ct))
- (sub (content-type-sub ct)))
+ (sub (content-type-sub ct)))
(cond ((and super sub)
- (concatenate 'string super "/" sub))
- (t (or super "")))))
+ (concatenate 'string super "/" sub))
+ (t (or super "")))))
(defstruct (mime-part (:type list)
(:constructor make-mime-part (contents headers)))
@@ -419,19 +417,19 @@
(return-from parse-mime nil))
(let ((result ())
- content-type-header)
+ content-type-header)
(loop
(let ((headers (loop
- for header = (parse-header input)
- while header
- when (string-equal "CONTENT-TYPE" (header-name header))
- do (setf content-type-header header
- (header-value header) (parse-content-type (header-value header)))
- collect header)))
- (if (and recursive-p
- (string-equal "MULTIPART" (content-type-super (header-value content-type-header))))
- (let ((boundary (cdr (find-parameter "BOUNDARY" (header-parameters content-type-header)))))
- (push (make-mime-part (parse-mime input boundary) headers) result))
+ for header = (parse-header input)
+ while header
+ when (string-equal "CONTENT-TYPE" (header-name header))
+ do (setf content-type-header header
+ (header-value header) (parse-content-type (header-value header)))
+ collect header)))
+ (if (and recursive-p
+ (string-equal "MULTIPART" (content-type-super (header-value content-type-header))))
+ (let ((boundary (cdr (find-parameter "BOUNDARY" (header-parameters content-type-header)))))
+ (push (make-mime-part (parse-mime input boundary) headers) result))
(let ((file-name (get-file-name headers)))
(cond ((and write-content-to-file
file-name)
@@ -475,10 +473,10 @@
"Returns the Content-Type header of mime-part PART."
(let ((header (find-header "CONTENT-TYPE" (mime-part-headers part))))
(if header
- (if as-string
- (or (unparse-content-type (header-value header)) "")
- (header-value header))
- (when as-string ""))))
+ (if as-string
+ (or (unparse-content-type (header-value header)) "")
+ (header-value header))
+ (when as-string ""))))
(defun find-content-disposition-header (headers)
More information about the rfc2388-cvs
mailing list