From: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Date: Thu, 18 Mar 2010 20:40:14 +0000 (+0900)
Subject: (www-xml-parse-string): New function.
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=b1f63d5f3393eb115894454030b44fe1f1e6cbec;p=chise%2Fest.git

(www-xml-parse-string): New function.
(www-xml-to-stext-props): New function.
(www-xml-to-stext-unit): New function.
(www-xml-to-stext-list): New function.
(www-stext-parse-xml-string): New function.
(www-parse-string-as-wiki-text): Use `www-stext-parse-xml-string'.
---

diff --git a/cwiki-set.el b/cwiki-set.el
index 7d11822..2b552c3 100644
--- a/cwiki-set.el
+++ b/cwiki-set.el
@@ -6,6 +6,71 @@
 (require 'cwiki-view)
 
 
+;;; @ stext parser
+;;;
+
+(defun www-xml-parse-string (string)
+  (require 'xml)
+  (nthcdr
+   2
+   (car
+    (with-temp-buffer
+      (insert "<top>")
+      (insert string)
+      (insert "</top>")
+      (xml-parse-region (point-min)(point-max))))))
+
+(defun www-xml-to-stext-props (props)
+  (let (dest)
+    (dolist (cell props)
+      (setq dest (cons (cdr cell)
+		       (cons (intern (format ":%s" (car cell)))
+			     dest))))
+    (nreverse dest)))
+
+(defun www-xml-to-stext-unit (unit)
+  (let (name props children)
+    (cond
+     ((stringp unit)
+      unit)
+     ((consp unit)
+      (setq name (car unit))
+      (if (stringp name)
+	  nil
+	(setq props (nth 1 unit)
+	      children (nthcdr 2 unit))
+	(if children
+	    (setq children (www-xml-to-stext-list children)))
+	(if children
+	    (list* name
+		   (www-xml-to-stext-props props)
+		   children)
+	  (if props
+	      (list name (www-xml-to-stext-props props))
+	    (list name))))
+      )
+     (t
+      (format "%S" unit)))))
+
+(defun www-xml-to-stext-list (trees)
+  (cond
+   ((atom trees)
+    (www-xml-to-stext-unit trees)
+    )
+   ((equal trees '(("")))
+    nil)
+   (t
+    (mapcar #'www-xml-to-stext-unit
+	    trees))))
+
+(defun www-stext-parse-xml-string (string)
+  (www-xml-to-stext-list
+   (www-xml-parse-string string)))
+
+
+;;; @ parser
+;;;
+
 (defun www-parse-string-default (string)
   (setq string (decode-uri-string string 'utf-8-mcs-er))
   (condition-case nil
@@ -45,7 +110,10 @@
 	       ten 32)))))
 
 (defun www-parse-string-as-wiki-text (string)
-  (list (decode-uri-string string 'utf-8-mcs-er)))
+  (www-stext-parse-xml-string
+   (decode-uri-string string 'utf-8-mcs-er))
+  ;; (list (decode-uri-string string 'utf-8-mcs-er))
+  )
 
 (defun www-feature-parse-string (feature-name string &optional format)
   (unless format
@@ -75,6 +143,10 @@
 	 (www-parse-string-default string)
 	 )))
 
+
+;;; @ display
+;;;
+
 (defun www-set-display-char-desc (uri-char feature value format &optional lang)
   (when (stringp feature)
     (setq feature (intern feature)))
@@ -106,10 +178,10 @@
 	  (if (equal (www-char-feature char feature) value)
 	      (www-html-display-paragraph
 	       "Feature-value is not changed.")
-	    (www-html-display-paragraph
-	     (format "New feature-value = %S is different from old value %S"
-		     value
-		     (www-char-feature char feature)))
+            ;; (www-html-display-paragraph
+            ;;  (format "New feature-value = %S is different from old value %S"
+            ;;          value
+            ;;          (www-char-feature char feature)))
 	    (put-char-attribute char latest-feature value)
 	    (save-char-attribute-table latest-feature)
 	    (setq ret (char-feature-property '$object 'additional-features))