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                                     (cdr xml)
  93                                     "")
  94                                "</" el ">")
  95                        "/>"))))))))
  96
  97 (defun xmlgen-string-escape (string)
  98   "Escape STRING for inclusion in some XML."
  99   (when (stringp string)
 100     (mapc
 101      '(lambda (e)
 102        (setq string
 103         (replace-regexp-in-string (car e) (cdr e) string)))
 104      xmlgen-escapees))
 105   string)
 106
 107 (defun xmlgen-attr-to-string (plist)
 108   "Convert a plist to xml style attributes."
 109   (let ((res ""))
 110     (while plist
 111       (let* ((sym (pop plist))
 112              (val (pop plist))
 113              (treated (cond
 114                         ((numberp val)
 115                          (number-to-string val))
 116                         ((stringp val)
 117                          val))))
 118         (setq res
 119               (concat res " " (substring (symbol-name sym) 1 ) "=\""
 120                       (if xmlgen-escape-attribute-vals
 121                           (xmlgen-string-escape treated)
 122                           treated)
 123                       "\""))))
 124     res))
 125
 126 (defun xmlgen-extract-plist (list)
 127   "Extract a plist from LIST returning the original list without
 128 the plist and the plist."
 129   (let ((nlist '())
 130         (plist '())
 131         (last-keyword nil))
 132     (mapc
 133      '(lambda (item)
 134        (let ((item (pop list)))
 135          (cond
 136            (last-keyword
 137             (setq plist (append plist (list last-keyword)))
 138             (setq plist (append plist (list item)))
 139             (setq last-keyword nil))
 140            ((keywordp item) (setq last-keyword item))
 141            (t (setq nlist (append nlist (list item)))))))
 142      list)
 143     (when last-keyword
 144       (error "No value to satisfy keyword '%s'"
 145              (symbol-name last-keyword)))
 146     (list nlist plist)))
 147
 148 (provide 'xmlgen)