(defpackage streamcsv) (in-package streamcsv) (defun read-headings (in) " (read-headings in) (Values (list <first line READs>)) " (let ((line (read-line in))) (labels ((get-heading (stream list) (let ((heading (read stream nil nil))) (if heading (get-heading stream (push heading list)) (nreverse list))))) (with-input-from-string (str line) (get-heading str (list)))))) (defvar *assoclosures* (list)) (defun rw-each (headings in out) " (rw-each headings in out) Like (mapl (lambda (x) (apply (cdar x) (list in out)))) Read (describe 'mapl) " (when headings (apply (cdr (assoc (car headings) *assoclosures* :test 'string=)) (list in out)) (rw-each (cdr headings) in out))) (defun rw-rows (headings in out) " (rw-rows headings in out) peeks for eof before doing #'rw-each " (let ((peek1 (peek-char t in nil nil)) (peek2 (peek-char nil in nil nil))) (when peek2 (rw-each (copy-list headings) in out) (rw-rows headings in out)))) ;;;An alist like ;;;(("string" . (lambda (&optional in out) 'foo))) (setq *assoclosures* (list (cons "this" (let ((last-val nil)) (lambda (&optional in out) (if (and in out) (format out "\"~a:~a\" " "this" (setf last-val (read in))) last-val)))) (cons "that" (let ((last-val nil)) (lambda (&optional in out) (if (and in out) (format out "\"~a:~a\" " "that" (setf last-val (read in))) last-val)))) (cons "the" (let ((last-val nil)) (lambda (&optional in out) (if (and in out) (format out "\"~a:~a\" " "the" (setf last-val (read in))) last-val)))) (cons "other" (let ((last-val nil)) (lambda (&optional in out) (if (and in out) (format out "\"~a:~a\" " "other" (setf last-val (read in nil nil))) last-val)))) (cons "rowsum" (let ((last-val nil)) (lambda (&optional in out) (if (and in out) (format out "\"~a:~a\"~%" "rowsum" (setf last-val (reduce '+ (mapcan (lambda (x) (let ((n (funcall (cdr x)))) (and n (list n)))) *assoclosures*)))) last-val)))))) ;;;Test space delimited READable "csv" input. (defvar *test-input* "\"this\" \"that\" \"the\" \"other\" 1 2 3 4 5 6 7 8 9 10 11 12 ") ;;;Test. (with-input-from-string (in *test-input*) (let ((headings (append (read-headings in) (list "rowsum")))) (terpri) (rw-rows headings in t))) (terpri) (ext:quit)