xmlgen.el

   1 ;;; xml-gen.el --- A DSL for generating XML.
   2
   3 ;; Copyright (C) 2008 Philip Jackson
   4
   5 ;; Author: Philip Jackson <phil@shellarchive.co.uk>
   6 ;; Version: 0.4
   7
   8 ;; This file is not currently part of GNU Emacs.
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program ; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; Generate xml using sexps with the function `xmlgen':
  28
  29 ;; (xmlgen '(p :class "big"))      => "<p class=\"big\" />")
  30 ;; (xmlgen '(p :class "big" "hi")) => "<p class=\"big\">hi</p>")
  31
  32 ;; (xmlgen '(html
  33 ;;           (head
  34 ;;            (title "hello")
  35 ;;            (meta :something "hi"))
  36 ;;           (body
  37 ;;            (h1 "woohhooo")
  38 ;;            (p "text")
  39 ;;            (p "more text"))))
  40
  41 ;; produces this (though wrapped):
  42
  43 ;; <html>
  44 ;;   <head>
  45 ;;     <title>hello</title>
  46 ;;     <meta something="hi" />
  47 ;;   </head>
  48 ;;   <body>
  49 ;;     <h1>woohhooo</h1>
  50 ;;     <p>text</p>
  51 ;;     <p>more text</p>
  52 ;;   </body>
  53 ;; </html>
  54
  55 (eval-when-compile (require 'cl))
  56
  57 (defvar xmlgen-escape-attribute-vals t
  58   "When non-nil xmlgen will escape the characters <>'\"&' in an
  59 attribute value.")
  60
  61 (defvar xmlgen-escape-elm-vals t
  62   "When non-nil xmlgen will escape the characters <>'\"&' in an
  63 elements content.")
  64
  65 (defvar xmlgen-escapees
  66   '(("&"  . "&amp;")
  67     ("'"  . "&apos;")
  68     ("\"" . "&quot;")
  69     ("<"  . "&lt;")
  70     (">"  . "&gt;"))
  71     "List of (find . replace) pairs for escaping. See
  72 `xmlgen-escape-elm-vals' and `xmlgen-escape-attribute-vals'")
  73
  74 ;;;###autoload
  75 (defun xmlgen (form &optional in-elm level)
  76   "Convert a sexp to xml:
  77   '(p :class \"big\")) => \"<p class=\\\"big\\\" />\""
  78   (let ((level (or level 0)))
  79     (cond
  80       ((numberp form) (number-to-string form))
  81       ((stringp form) form)
  82       ((listp form)
  83        (destructuring-bind (xml attrs) (xmlgen-extract-plist form)
  84          (let ((el (car xml)))
  85            (unless (symbolp el)
  86              (error "Element must be a symbol (got '%S')." el))
  87            (setq el (symbol-name el))
  88            (concat "<" el (xmlgen-attr-to-string attrs)
  89                    (if (> (length xml) 1)
  90                        (concat ">" (mapconcat
  91                                     (lambda (s) (xmlgen s el (1+ level)))
  92                                     (if xmlgen-escape-elm-vals
  93                                         (mapcar 'xmlgen-string-escape (cdr xml))
  94                                       (cdr xml))
  95                                     "")
  96                                "</" el ">")
  97                        "/>"))))))))
  98
  99 (defun xmlgen-string-escape (string)
 100   "Escape STRING for inclusion in some XML."
 101   (when (stringp string)
 102     (mapc
 103      '(lambda (e)
 104        (setq string
 105         (replace-regexp-in-string (car e) (cdr e) string)))
 106      xmlgen-escapees))
 107   string)
 108
 109 (defun xmlgen-attr-to-string (plist)
 110   "Convert a plist to xml style attributes."
 111   (let ((res ""))
 112     (while plist
 113       (let* ((sym (pop plist))
 114              (val (pop plist))
 115              (treated (cond
 116                         ((numberp val)
 117                          (number-to-string val))
 118                         ((stringp val)
 119                          val))))
 120         (setq res
 121               (concat res " " (substring (symbol-name sym) 1 ) "=\""
 122                       (if xmlgen-escape-attribute-vals
 123                           (xmlgen-string-escape treated)
 124                           treated)
 125                       "\""))))
 126     res))
 127
 128 (defun xmlgen-extract-plist (list)
 129   "Extract a plist from LIST returning the original list without
 130 the plist and the plist."
 131   (let ((nlist '())
 132         (plist '())
 133         (last-keyword nil))
 134     (mapc
 135      '(lambda (item)
 136        (let ((item (pop list)))
 137          (cond
 138            (last-keyword
 139             (setq plist (append plist (list last-keyword)))
 140             (setq plist (append plist (list item)))
 141             (setq last-keyword nil))
 142            ((keywordp item) (setq last-keyword item))
 143            (t (setq nlist (append nlist (list item)))))))
 144      list)
 145     (when last-keyword
 146       (error "No value to satisfy keyword '%s'"
 147              (symbol-name last-keyword)))
 148     (list nlist plist)))
 149
 150 (provide 'xmlgen)