Function: PARSE-TAL-ATTRIBUTE-VALUE

Documentation

Parser a TAL attribute expression, returns a form for building the expression at run time.

Source

(defun parse-tal-attribute-value (value-string)
  "Parser a TAL attribute expression, returns a form for building
  the expression at run time."
  (let ((parts '()))
    (with-input-from-string (val value-string)
      (with-output-to-string (text)
        (flet ((read-tal-form ()
                 (let ((*readtable* (copy-readtable nil))
                       (*package* *expression-package*))
                   (set-macro-character #\} (get-macro-character #\)) nil *readtable*)
                   (set-macro-character #\$ #'|$ tal reader| nil *readtable*)
                   (read-delimited-list #\} val))))
          (loop
             for char = (read-char val nil nil)
             while char
             do (case char
                  (#\\ (let ((next-char (read-char val nil nil)))
                         (if (null next-char)
                             (error "Parse error in ~S. #\\ at end of string." value-string)
                             (write-char next-char text))))
                  (#\$ (let ((next-char (peek-char nil val nil nil nil)))
                         (if (and next-char (char= #\{ next-char))
                             (progn
                               (read-char val nil nil nil)
                               ;; first push the text uptil now onto parts
                               (let ((up-to-now (get-output-stream-string text)))
                                 (unless (string= "" up-to-now)
                                   (push up-to-now parts)))
                               ;; now push the form
                               (push `(princ-to-string (progn ,@(read-tal-form))) 
                                     parts))
                             (write-char #\$ text))))
                  (#\@ (let ((next-char (peek-char nil val nil nil)))
                         (if (and next-char (char= #\{ next-char))
                             (progn
                               (read-char val nil nil nil)
                               ;; first push the text uptil now onto parts
                               (push (get-output-stream-string text) parts)
                               ;; now push the form
                               (let ((form (read-tal-form))
                                     (stream (gensym))
                                     (i (gensym)))
                                 (push `(with-output-to-string (,stream)
                                          (dolist (,i (progn ,@form))
                                            (princ ,i ,stream)))
                                       parts)))
                             (write-char #\@ text))))
                  (t
                   (write-char char text)))
               finally (let ((remaining-text (get-output-stream-string text)))
                         (unless (string= "" remaining-text)
                           (push remaining-text parts)))))))
    ;; done parsing, parts now contains everything to put in the
    ;; list, but in reverse order.
    (case (length parts)
      (0 "")
      (1 (car parts))
      (t `(concatenate 'string ,@(nreverse parts))))))
Source Context