From: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Date: Thu, 18 Mar 2010 20:33:51 +0000 (+0900)
Subject: (www-format-value): Add the first variable `object' and the second
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=89f389a5fd069b72625e1b9c1aa44d8b2373aa58;p=chise%2Fest.git

(www-format-value): Add the first variable `object' and the second
variable `feature-name'; change variable `variable' to optional;
modify for `www-format-apply-value'.
(www-format-apply-value): Add the first variable `object' and the
second variable `feature-name'; support format `wiki-text'.
(www-format-eval-feature-value): Modify for `www-format-apply-value'.
(www-format-eval-unit): Likewise.
(www-xml-format-props): New function.
(www-xml-format-unit): New function.
(www-xml-format-list): New function.
---

diff --git a/cwiki-common.el b/cwiki-common.el
index 9681fbe..28fbcda 100644
--- a/cwiki-common.el
+++ b/cwiki-common.el
@@ -373,19 +373,12 @@
 	      value)
     (www-format-value-as-S-exp value)))
 
-(defun www-format-value (value &optional feature-name format without-tags)
-  ;; (cond
-  ;;  ((find-charset feature-name)
-  ;;   (cond
-  ;;    ((and (= (charset-chars feature-name) 94)
-  ;;          (= (charset-dimension feature-name) 2))
-  ;;     (www-format-value-as-CCS-94x94 value))
-  ;;    (t
-  ;;     (www-format-value-as-CCS-default value)))
-  ;;   )
-  ;;  (t
-  ;;   (www-format-value-as-S-exp value)))
-  (www-format-apply-value format nil value nil nil without-tags)
+(defun www-format-value (object feature-name
+				&optional value format without-tags)
+  (unless value
+    (setq value (www-char-feature object feature-name)))
+  (www-format-apply-value object feature-name
+			  format nil value nil nil without-tags)
   )
 
 
@@ -571,7 +564,8 @@
 	   ((eq format 'S-exp) "S")
 	   (t "s"))))	   
 
-(defun www-format-apply-value (format props value
+(defun www-format-apply-value (object feature-name
+				      format props value
 				      &optional uri-char uri-feature
 				      without-tags)
   (let (ret)
@@ -585,6 +579,11 @@
 	       (format "%s" value)
 	       without-tags))
 	    )
+	   ((eq format 'wiki-text)
+	    (if without-tags
+		(www-xml-format-list value)
+	      (www-format-eval-list value object feature-name nil uri-char))
+	    )
 	   ((eq format 'S-exp)
 	    (www-format-encode-string
 	     (format (www-format-props-to-string props format)
@@ -620,6 +619,7 @@
   (cond
    ((symbolp format)
     (www-format-apply-value
+     char feature-name
      format nil value
      uri-char (www-uri-encode-feature-name feature-name))
     )
@@ -627,6 +627,7 @@
     (cond ((null (cdr format))
 	   (setq format (car format))
 	   (www-format-apply-value
+	    char feature-name
 	    (car format) (nth 1 format) value
 	    uri-char (www-uri-encode-feature-name feature-name))
 	   )
@@ -651,6 +652,7 @@
 					 (plist-get (nth 1 exp) :format)
 					 lang uri-char value)
 	(www-format-apply-value
+	 char feature-name
 	 (car exp) (nth 1 exp) value
 	 uri-char (www-uri-encode-feature-name feature-name)))
       )
@@ -689,6 +691,54 @@
     (www-format-eval-unit format-list char feature-name lang uri-char)))
 
 
+;;; @ 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 val)))
+    dest))
+
+(defun www-xml-format-unit (format-unit)
+  (let (name props children)
+    (cond
+     ((stringp format-unit)
+      format-unit)
+     ((consp format-unit)
+      (setq name (car format-unit)
+	    props (nth 1 format-unit)
+	    children (nthcdr 2 format-unit))
+      (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 "")))
+
+
 ;;; @ HTML generator
 ;;;