Phil Jackson | 15 Aug 11:27

xml-gen.el --- A DSL for generating XML.

Hi,

There may already be something like this but I couldn't find it (I wrote
the majority of it on the train this morning, so it may need some
polish):

 (xmlgen '(html
           (head
            (title "hello")
            (meta :something "hi"))
           (body
            (h1 "woohhooo")
            (p "text")
            (p "more text"))))

Produces this (though wrapped):

 <html>
   <head>
     <title>hello</title>
     <meta something="hi" />
   </head>
   <body>
     <h1>woohhooo</h1>
     <p>text</p>
     <p>more text</p>
   </body>
 </html>

;;; xml-gen.el --- A DSL for generating XML.

;; Copyright (C) 2008 Philip Jackson

;; Author: Philip Jackson <phil <at> shellarchive.co.uk>
;; 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"))      => "<p class=\"big\" />")
;; (xmlgen '(p :class "big" "hi")) => "<p class=\"big\">hi</p>")

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

;; produces this (though wrapped):

;; <html>
;;   <head>
;;     <title>hello</title>
;;     <meta something="hi" />
;;   </head>
;;   <body>
;;     <h1>woohhooo</h1>
;;     <p>text</p>
;;     <p>more text</p>
;;   </body>
;; </html>

(defun xmlgen (form)
  "Convert a sexp to xml:
  '(p :class \"big\")) => \"<p class=\\\"big\\\" />\""
  (cond
    ((numberp form) (number-to-string form))
    ((stringp form) form)
    ((listp form)
     (destructuring-bind (xml attrs) (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 (attr-to-string attrs)
                 (if (> (length xml) 1)
                     (concat ">" (mapconcat
                                  '(lambda (s) (xmlgen s))
                                  (cdr xml)
                                  " ")
                     "</" el ">")
                 " />")))))))

(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 xml-gen-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)))

--

-- 
 Phil Jackson
 http://www.shellarchive.co.uk
_______________________________________________
gnu-emacs-sources mailing list
gnu-emacs-sources <at> gnu.org
http://lists.gnu.org/mailman/listinfo/gnu-emacs-sources

Gmane