70行で emacs に Text::MicroTemplate like なテンプレートを実装する

>>>> 2010/04/23 追記
未使用の変数消したので、69行になってしまいました。<<<< 2010/04/23 追記ここまで


「(eval-when-compile (require 'cl))」まで加えて丁度70行です。

(eval-when-compile
  (require 'cl))

(defun* micro-template (mt/template &key (mt/source-type 'string))
  (flet ((mt/parse ()
          (let* ((state 'text)
                 (multiline_expression nil)
                 (tag-end "?>")
                 (tag-start "<?")
                 (tag-comment-start "<?#")
                 (tag-expression-start "<?=")
                 (token-separator-re
                  (regexp-opt (list tag-end tag-start
                                    tag-comment-start tag-expression-start))))
            (loop initially (goto-char (point-min))
                  with tokens
                  for token = (let ((p (point)))
                                (cond
                                 ((eobp) nil)
                                 ((looking-at token-separator-re)
                                  (prog1 (match-string 0)
                                    (goto-char (match-end 0))))
                                 ((re-search-forward token-separator-re nil t)
                                  (goto-char (match-beginning 0))
                                  (buffer-substring p (point)))
                                 (t
                                  (prog1 (buffer-substring p (point-max))
                                    (goto-char (point-max))))))
                  while token
                  do (cond ((string= tag-end token)
                            (setq state 'text
                                  multiline_expression nil))
                           ((string= tag-start token)
                            (setq state 'code))
                           ((string= tag-comment-start token)
                            (setq state 'comment))
                           ((string= tag-expression-start token)
                            (setq state 'expr))
                           (t
                            (unless (eq state 'comment)
                              (when multiline_expression
                                (setq state 'code))
                              (when (eq state 'expr)
                                (setq multiline_expression t))
                              (push (list state token) tokens))))
                  finally return (nreverse tokens))))
         (mt/compile (tree)
          (with-temp-buffer
            (insert "(progn ")
            (loop for (type value) in tree
                  do (ecase type
                       (text (prin1 `(insert ,value) (current-buffer)))
                       (code (insert value))
                       (expr (insert "(insert " value ")"))))
            (insert ")")
            (condition-case err
                (progn (goto-char (point-min)) (read (current-buffer)))
              (error (error "ERROR at compile time.\ntree: %S\ncompiled source: %s"
                            tree (buffer-string)))))))
    (with-temp-buffer
      (ecase mt/source-type
        (string (insert mt/template))
        (file (insert-file-contents mt/template)))
      (let ((mt/--form (mt/compile (mt/parse))))
        (with-temp-buffer
          (condition-case err
              (progn (eval mt/--form) (buffer-string))
            (error (error "ERROR at eval time.\ncompiled source: %S"
                          mt/--form))))))))

次のテストは pass します。

(dont-compile
  (when (fboundp 'expectations)
    (expectations
      (desc "+++++ micro-template +++++")

      (desc "output the result of expression")
      (expect "The perfect insider."
        (let ((o "insider")
              (tmpl "The perfect <?= o ?>."))
          (micro-template tmpl)))

      (desc "execute lisp code")
      (expect "The perfect outsider."
        (let ((o "outsider")
              (tmpl "The perfect <? (insert o) ?>."))
          (micro-template tmpl)))

      (desc "comment")
      (expect "comment-><-comment"
        (let ((tmpl "comment-><?# ya ya ya ?><-comment"))
          (micro-template tmpl)))

      (desc "backslash")
      (expect "The perfect <\\?= o ?\\>."
        (let ((o "insider")
              (tmpl "The perfect <\\?= o ?\\>."))
          (micro-template tmpl)))

      (desc "write literal tag inside template")
      (expect " ?> ."
        (let ((tmpl "<? (insert \" ?\\> \") ?>."))
          (micro-template tmpl)))

      (desc "complex")
      (expect "The perfect insider\nflag is non-nil"
        (let ((o "insider")
              (flag t)
              (tmpl "\
The perfect <?= o ?>
\<? (cond (flag ?>flag is non-nil<? ) ?><?# COND flag  ?>
<? (t ?><?# ELSE ?>flag is nil<? )) ?><?# end COND ?>"))
          (micro-template tmpl)))
      (desc "file")
      (expect "The perfect insider\nflag is non-nil"
        (let ((o "insider")
              (flag t)
              (tmpl "\
The perfect <?= o ?>
\<? (cond (flag ?>flag is non-nil<? ) ?><?# COND flag  ?>
<? (t ?><?# ELSE ?>flag is nil<? )) ?><?# end COND ?>"))
          (let ((tmp-file (make-temp-file "temp-file.")))
            (with-temp-file tmp-file
              (insert tmpl))
            (micro-template tmp-file :mt/source-type 'file))))
      )))

perl module の Text::MicroTemplate のコードを参考にしました。シンプルで美しかったです。ありがとうございます。