A Lisp CodeSmith implementation

Hello Reader,

Here's a nifty little tool that I made from bits of string and wire and pieces of code that I ganked from the internet (due to a bug in the blogging software, you'll need to replace "" with a backquote in the source):

;;---------------------------------------------------------------------------
;; Code to parse templates
;;---------------------------------------------------------------------------

(defmacro automaton (event-func states &key (stop 'stop) (debug nil) )
    ""(tagbody
	 ,@(reduce 
	    #'append 
	    (mapcar (lambda (state)
		      (let ((state-name (car state))
			    (transitions (cdr state)))
			(list state-name 
                  ""(let ((current (funcall, event-func)))
    			      (case current
    				,@(mapcar (lambda (trans)
    					    (let ((match (car trans))
    						  (next (cadr trans))
    						  (actions (cddr trans)))
    					      (cons match
    						    (append actions
    							    (when debug
    							      ""((format t "Matched ~A. Transitioning to state ~A.~%" ,match (quote ,next))))
    							    ""((go ,next))))))
    					  transitions)))
    			      ""(go ,state-name))))
		    states))
	 ,stop))

(defmacro add-char (s c)
    ""(setf ,s (concatenate 'string ,s (string ,c))))

(defun parse (file-name)
    (with-open-file (is file-name :direction :input)
        (let ((text "") (output ""))
            (automaton (lambda () (read-char is nil 'eof))
                ((just-text
                    ; Found beginning of escape sequence
                    (#\< open-escape)
                    ; Found end of file, dump remaining output
                    ('eof stop
                        (setf output (concatenate 'string output
                            (format NIL "~S" text))))
                    ; Ordinary character, just write to output string
                    (otherwise just-text
                        (add-char text current)))
                 (open-escape
                    ; Escape sequence found
                    (#\% escaped
                        (setf output (concatenate 'string output
                            (format NIL "~S" text)))
                        (setf text ""))
                    ; The <% was not found, so write out < and current
                    ; and go back to collecting text
                    (otherwise just-text
                        (add-char text #\<)
                        (add-char text current)))
                 (escaped
                    ; Found start of end escape sequence
                    (#\% close-escape)
                    ; Found end of file, dump remaining output
                    ('eof stop)
                    ; in escaped mode, this should be valid code that we are emitting
                    (otherwise escaped
                        (add-char output current)))
                 (close-escape
                    ; Found second character for end escape sequence
                    (#\> just-text)
                    ; The %> was not found, so write out % and current
                    ; and go back to collecting text
                    (otherwise escaped
                        (add-char output #\%)
                        (add-char output current)))))
            output)))

(defun generate-text (template)
    (with-input-from-string (s template)
        (let ((result ""))
            (loop
                (let ((form (read s nil 'eof)))
                    (if (eq form 'eof)
                        (return-from generate-text result)
                        (let* ((form-result (eval form))
                                (extend 
                                    (if (and form-result (not (stringp form-result)))
                                        (format nil "~S" form-result)
                                        form-result)))
                            ;(format t "~S" extend)
                            (setf result (concatenate 'string result extend)))))))))
        
;;---------------------------------------------------------------------------
;; Set up environment
;;---------------------------------------------------------------------------
(setf (current-directory) "c:/programming/lispplayground/")

(defparameter *recipient* "Proggit")
(defparameter *sender* 'TIM)
(defparameter *rich* T)

(setf template-text (parse "Hello.gen"))
(generate-text template-text)

 Here's the sample template:

Hello <% *recipient* %>!

<%
(when *rich*
%>I am Muffo, president of New Nigeria, can I borrow $5?<% 
    ) 
(unless *rich*
%>Here's $5, you poor wretch!<% ) %>

Sincerely,
<% *sender* %> 

And the output is:

AUTOMATON
ADD-CHAR
PARSE
GENERATE-TEXT
#P"c:\programming\nitemplatematerial\"
*RECIPIENT*
*SENDER*
*RICH*
"\"Hello \" *recipient* \"!

\"
(when *rich*
\"I am Muffo, president of New Nigeria, can I borrow $5?\" 
    ) 
(unless *rich*
\"Here's $5, you poor wretch!\" ) \"

Sincerely,
\" *sender* \" \""
"Hello Proggit!

I am Muffo, president of New Nigeria, can I borrow $5?

Sincerely,
TIM "

I love how easy it is to extend Lisp in ways that would be absolutely aggravating in just about any other language. Macroexpand the automaton in the parse function, and you can see how the finite state machine is automatically wired for you. If you need quickly generate HTML, code, mailmerge, or any other code generation technique for non-lisp code from Lisp, this is a very lightweight implementation.

-Tim Kerchmar