(defun parse-ccldoc-string (string) (labels ((parse (string start) (when (< start (length string)) (let ((startpos (delim-pos string start))) (if (null startpos) `(quote ,(subseq string start)) (if (eql (char string startpos) #\}) (error "Stray close brace: ~s" (string-chunk string startpos)) (let* ((head (and (> startpos start) `(quote ,(subseq string start startpos)))) ;; Could allow unmatched braces in lisp args by deferring end-delim-pos til after read all the lisp args, ;; but doesn't seem worth the complication... (endpos (or (end-delim-pos string (1+ startpos)) (error "Unclosed directive: ~s..." (string-chunk string startpos)))) (middle (multiple-value-bind (command nextpos) (lisp-from-string string :start (1+ startpos)) (assert (non-nil-symbolp command) () "Invalid directive: ~s" (string-chunk string startpos nextpos)) (let ((parser (or (ccldoc-string-parser command) (error "Unknown directive ~s" command)))) (funcall parser command string nextpos endpos)))) (tail (parse string (1+ endpos))) (forms (nconc (and head (list head)) (and middle (list middle)) (and tail (if (and (consp tail) (eq (car tail) 'clause)) (cdr tail) (list tail)))))) (cond ((null forms) nil) ((null (cdr forms)) (car forms)) (t `(clause ,@forms))))))))) (listify (x) (and x (if (and (consp x) (eq (car x) 'clause)) (cdr x) (list x)))) (find-blank (string start) (when-let ((lpos (position #\Newline string :start start))) (if-let (epos (position #\Newline string :from-end T :start (1+ lpos) :end (position-if-not #'whitespacep string :start lpos))) (values lpos (1+ epos)) (find-blank string (1+ lpos))))) (breakup (string start) (when (< start (length string)) (multiple-value-bind (epos npos) (find-blank string start) (if (null epos) (list (subseq string start)) (cons (subseq string start epos) (breakup string npos))))))) (let ((strings (breakup string 0))) (if (cdr strings) `(clause ,@(mapcar (lambda (s) `(para ,@(listify (parse s 0)))) strings)) (and strings (parse (car strings) 0))))))