-
Notifications
You must be signed in to change notification settings - Fork 8
/
Copy pathxmlgen.el
159 lines (136 loc) · 5.07 KB
/
xmlgen.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
;;; xmlgen.el --- A DSL for generating XML.
;; Copyright (C) 2008 Philip Jackson
;; Author: Philip Jackson <phil@shellarchive.co.uk>
;; Version: 0.5
;; 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>
;;; Code:
(require 'cl-lib)
(defvar xmlgen-escape-attribute-vals t
"When non-nil xmlgen will escape the characters <>\\='\"& in an attribute value.")
(defvar xmlgen-escape-elm-vals t
"When non-nil xmlgen will escape the characters <>\\='\"& in an elements content.")
(defvar xmlgen-escapees
'(("&" . "&")
("'" . "'")
("\"" . """)
("<" . "<")
(">" . ">"))
"List of (FIND . REPLACE) pairs for escaping.
See `xmlgen-escape-elm-vals' and `xmlgen-escape-attribute-vals'.")
;;;###autoload
(defun xmlgen (form &optional in-elm level)
"Convert a sexp FORM to xml:
\\='(p :class \"big\")) => \"<p class=\\\"big\\\" />\".
IN-ELM is ignored. LEVEL is the element level and defaults to 0."
(let ((level (or level 0)))
(cond
((numberp form) (number-to-string form))
((stringp form) form)
((listp form)
(cl-destructuring-bind (xml attrs) (xmlgen-extract-plist form)
(let ((el (car xml)))
(unless (symbolp el)
(error "Element must be a symbol (got %S)" el))
(if (member el '(!unescape !escape))
(let ((xmlgen-escape-elm-vals (if (equal '!escape el) t nil)))
(mapconcat
(lambda (s) (xmlgen s in-elm (1+ level)))
(cdr xml)
""))
(progn
(setq el (symbol-name el))
(concat "<" el (xmlgen-attr-to-string attrs)
(if (> (length xml) 1)
(concat ">" (mapconcat
(lambda (s) (xmlgen s el (1+ level)))
(if xmlgen-escape-elm-vals
(mapcar 'xmlgen-string-escape (cdr xml))
(cdr xml))
"")
"</" el ">")
"/>"))))))))))
(defun xmlgen-string-escape (string)
"Escape STRING for inclusion in some XML."
(when (stringp string)
(mapc
(lambda (e)
(setq string
(replace-regexp-in-string (car e) (cdr e) string)))
xmlgen-escapees))
string)
(defun xmlgen-attr-to-string (plist)
"Convert a PLIST to xml style attributes."
(let ((res ""))
(while plist
(let* ((sym (pop plist))
(val (pop plist))
(treated (cond
((numberp val)
(number-to-string val))
((stringp val)
val))))
(setq res
(concat res " " (substring (symbol-name sym) 1 ) "=\""
(if xmlgen-escape-attribute-vals
(xmlgen-string-escape treated)
treated)
"\""))))
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)
;;; xmlgen.el ends here