From: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Date: Mon, 6 Dec 2010 10:08:31 +0000 (+0900)
Subject: New file.
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=8baf3e3c4dd034554db00b4a8823ba4e4decad4a;p=chise%2Fest.git

New file.
---

diff --git a/est-xml.el b/est-xml.el
new file mode 100644
index 0000000..c92dec0
--- /dev/null
+++ b/est-xml.el
@@ -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