New file.
authorMORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Mon, 6 Dec 2010 10:08:31 +0000 (19:08 +0900)
committerMORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Mon, 6 Dec 2010 10:08:31 +0000 (19:08 +0900)
est-xml.el [new file with mode: 0644]

diff --git a/est-xml.el b/est-xml.el
new file mode 100644 (file)
index 0000000..c92dec0
--- /dev/null
@@ -0,0 +1,76 @@
+;; -*- coding: utf-8-mcs-er -*-
+(require 'cwiki-common)
+
+
+;;; @ XML generator
+;;;
+
+(defun www-xml-format-props (props)
+  (let ((dest "")
+       key val)
+    (while props
+      (setq key (pop props)
+           val (pop props))
+      (if (symbolp key)
+         (setq key (symbol-name key)))
+      (if (eq (aref key 0) ?:)
+         (setq key (substring key 1)))
+      (setq dest
+           (format "%s %s=\"%s\""
+                   dest key
+                   (www-format-encode-string
+                    (format "%s" val) 'without-tags))))
+    dest))
+
+(defun www-xml-format-unit (format-unit)
+  (let (name props children ret)
+    (cond
+     ((stringp format-unit)
+      (mapconcat (lambda (c)
+                  (cond
+                   ((eq c ?&) "&amp;")
+                    ;; ((eq c ?<) "&amp;lt;")
+                    ;; ((eq c ?>) "&amp;gt;")
+                   (t
+                    (char-to-string c))))
+                (www-format-encode-string format-unit 'without-tags)
+                "")
+      )
+     ((consp format-unit)
+      (setq name (car format-unit)
+           props (nth 1 format-unit)
+           children (nthcdr 2 format-unit))
+      (when (eq name 'link)
+       (setq ret (plist-get props :ref))
+       (unless (stringp ret)
+         (setq props (plist-remprop (copy-list props) :ref))
+         (setq children
+               (cons (list* 'ref nil ret)
+                     children))))
+      (if children
+         (format "<%s%s>%s</%s>"
+                 name
+                 (if props
+                     (www-xml-format-props props)
+                   "")
+                 (www-xml-format-list children)
+                 name)
+       (format "<%s%s/>"
+               name (www-xml-format-props props)))
+      )
+     (t
+      (format "%s" format-unit)))))
+
+(defun www-xml-format-list (format-list)
+  (if (atom format-list)
+      (www-xml-format-unit format-list)
+    (mapconcat #'www-xml-format-unit
+              format-list "")))
+
+
+;;; @ End.
+;;;
+
+(provide 'est-xml)
+
+;;; est-xml.el ends here