A solution that seems to work =)
- it ignores blank lines - it ignores comments starting with ; - it expects the !# to be alone in a single line - it gets screwed up with multiline strings and #| ... |# comments, and possibly with most extensions to the reader - I keep overusing format and loop =b
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar *blanks* '(#\Space #\Tab #\Newline #\Return)) (defvar *tabs* '(#\Tab)) (defvar *comment-markers* `(#;)) (defvar *tab-width* 8)
(defun width (char) (if (member char *tabs*) *tab-width* 1))
(defun distance (str) (do ((col 0 (+ col (width (aref str col))))) ((not (member (aref str col) *blanks* :test #'char=)) col)))
(defun trim-blanks (str) (string-trim *blanks* str))
(defun blank-line-p (str) (let ((trimmed (trim-blanks str))) (or (string= "" trimmed) (member (aref trimmed 0) *comment-markers* :test #'char=))))
(defun last-line-p (line) (or (eq line 'eof) (string= (trim-blanks line) "!#")))
(defun read-off-side-to-string (stream) (let ((prev-lines (list (list "PROGN"))) (prev-dists (list -1)) (prev-dist -1)) (flet ((pop-expr () (let* ((tail (pop prev-lines)) (head (pop (first prev-lines)))) (push (format nil "(~A~%~{~A~%~})" head (nreverse tail)) (first prev-lines)))) (next-line () (loop for line = (read-line stream nil 'eof) while (and (not (eq line 'eof)) (blank-line-p line)) finally (return line)))) (with-output-to-string (s) (loop for line = (next-line) while (not (last-line-p line)) do (let ((dist (distance line))) (when (> dist prev-dist) (push dist prev-dists) (push (list) prev-lines)) (loop while (and (not (null (cdr prev-dists))) (< dist (car prev-dists))) do (pop prev-dists) do (pop-expr)) (push line (first prev-lines)) (setf prev-dist dist)))
(loop while (not (null (cdr prev-dists))) do (pop prev-dists) do (pop-expr)) (format s "~{~A~%~}" (nreverse (pop prev-lines)))))))
(defun read-off-side (stream c n) (let ((r (nth-value 0 (read-from-string (read-off-side-to-string stream))))) (if (atom r) (list r) r)))