;;; xml-gen.el --- A DSL for generating XML. ;; Copyright (C) 2008 Philip Jackson ;; Author: Philip Jackson ;; Version: 0.4 ;; This file is not currently part of GNU Emacs. ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as ;; published by the Free Software Foundation; either version 2, or (at ;; your option) any later version. ;; This program is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program ; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; Generate xml using sexps with the function `xmlgen': ;; (xmlgen '(p :class "big")) => "

") ;; (xmlgen '(p :class "big" "hi")) => "

") ;; (xmlgen '(html ;; (head ;; (title "hello") ;; (meta :something "hi")) ;; (body ;; (h1 "woohhooo") ;; (p "text") ;; (p "more text")))) ;; produces this (though wrapped): ;; ;; ;; hello ;; ;; ;; ;;

woohhooo

;;

text

;;

more text

;; ;; (eval-when-compile (require 'cl)) (defun xmlgen (form) "Convert a sexp to xml: '(p :class \"big\")) => \"

\"" (cond ((numberp form) (number-to-string form)) ((stringp form) form) ((listp form) (destructuring-bind (xml attrs) (xmlgen-extract-plist form) (let ((el (car xml))) (unless (symbolp el) (error "Element must be a symbol (got '%S')." el)) (setq el (symbol-name el)) (concat "<" el (xmlgen-attr-to-string attrs) (if (> (length xml) 1) (concat ">" (mapconcat '(lambda (s) (xmlgen s)) (cdr xml) " ") "") " />"))))))) (defun xmlgen-attr-to-string (plist) "Convert a plist to xml style attributes." (let ((res "")) (while plist (let ((sym (pop plist)) (val (pop plist))) (setq res (concat res " " (substring (symbol-name sym) 1 ) "=\"" val "\"")))) res)) (defun xmlgen-extract-plist (list) "Extract a plist from LIST returning the original list without the plist and the plist." (let ((nlist '()) (plist '()) (last-keyword nil)) (mapc '(lambda (item) (let ((item (pop list))) (cond (last-keyword (setq plist (append plist (list last-keyword))) (setq plist (append plist (list item))) (setq last-keyword nil)) ((keywordp item) (setq last-keyword item)) (t (setq nlist (append nlist (list item))))))) list) (when last-keyword (error "No value to satisfy keyword '%s'" (symbol-name last-keyword))) (list nlist plist))) (provide 'xmlgen)