From: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Date: Mon, 15 Nov 2010 05:20:39 +0000 (+0900)
Subject: (www-uri-encode-char): Support non-character object.
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=e9093fddf7fd668ec776cd306987cf63e454ef88;p=chise%2Fest.git

(www-uri-encode-char): Support non-character object.
(www-format-value-as-char-list): Add link and readable presentation
for non-character object.
---

diff --git a/cwiki-common.el b/cwiki-common.el
index 195ec73..53749f9 100644
--- a/cwiki-common.el
+++ b/cwiki-common.el
@@ -387,47 +387,49 @@
 	))))))
 
 (defun www-uri-encode-char (char)
-  (if (encode-char char '=ucs)
-      (mapconcat
-       (lambda (byte)
-	 (format "%%%02X" byte))
-       (encode-coding-string (char-to-string char) 'utf-8-mcs-er)
-       "")
-    (let ((ccs-list '(; =ucs
-		      =cns11643-1 =cns11643-2 =cns11643-3
-		      =cns11643-4 =cns11643-5 =cns11643-6 =cns11643-7
-		      =gb2312 =gb12345
-		      =jis-x0208 =jis-x0208@1990
-		      =jis-x0212
-		      =cbeta =jef-china3
-		      =jis-x0213-1@2000 =jis-x0213-1@2004
-		      =jis-x0208@1983 =jis-x0208@1978
-		      =zinbun-oracle =>zinbun-oracle
-		      =daikanwa
-		      =gt =gt-k
-		      =>>jis-x0208 =>>jis-x0213-1
-		      =>jis-x0208 =>jis-x0213-1
-		      =>>gt
-		      =ruimoku-v6
-		      =big5
-		      =big5-cdp))
-	  ccs ret)
-      (while (and ccs-list
-		  (setq ccs (pop ccs-list))
-		  (not (setq ret (encode-char char ccs 'defined-only)))))
-      (cond (ret
-	     (format "%s:0x%X"
-		     (www-uri-encode-feature-name ccs)
-		     ret))
-	    ((and (setq ccs (car (split-char char)))
-		  (setq ret (encode-char char ccs)))
-	     (format "%s:0x%X"
-		     (www-uri-encode-feature-name ccs)
-		     ret))
-	    (t
-	     (format "system-char-id:0x%X"
-		     (encode-char char 'system-char-id))
-	     )))))
+  (if (characterp char)
+      (if (encode-char char '=ucs)
+	  (mapconcat
+	   (lambda (byte)
+	     (format "%%%02X" byte))
+	   (encode-coding-string (char-to-string char) 'utf-8-mcs-er)
+	   "")
+	(let ((ccs-list '(; =ucs
+			  =cns11643-1 =cns11643-2 =cns11643-3
+			  =cns11643-4 =cns11643-5 =cns11643-6 =cns11643-7
+			  =gb2312 =gb12345
+			  =jis-x0208 =jis-x0208@1990
+			  =jis-x0212
+			  =cbeta =jef-china3
+			  =jis-x0213-1@2000 =jis-x0213-1@2004
+			  =jis-x0208@1983 =jis-x0208@1978
+			  =zinbun-oracle =>zinbun-oracle
+			  =daikanwa
+			  =gt =gt-k
+			  =>>jis-x0208 =>>jis-x0213-1
+			  =>jis-x0208 =>jis-x0213-1
+			  =>>gt
+			  =ruimoku-v6
+			  =big5
+			  =big5-cdp))
+	      ccs ret)
+	  (while (and ccs-list
+		      (setq ccs (pop ccs-list))
+		      (not (setq ret (encode-char char ccs 'defined-only)))))
+	  (cond (ret
+		 (format "%s:0x%X"
+			 (www-uri-encode-feature-name ccs)
+			 ret))
+		((and (setq ccs (car (split-char char)))
+		      (setq ret (encode-char char ccs)))
+		 (format "%s:0x%X"
+			 (www-uri-encode-feature-name ccs)
+			 ret))
+		(t
+		 (format "system-char-id:0x%X"
+			 (encode-char char 'system-char-id))
+		 ))))
+    (format "rep.id:%s" (concord-object-id char))))
 
 (defun est-format-object (object)
   (if (characterp object)
@@ -557,13 +559,38 @@
 			"%s")
 		      unit)
 	      'without-tags))
-	 (lambda (unit)
-	   (if (characterp unit)
-	       (format "<a href=\"%s?char=%s\">%s</a>"
+	 (let (genre-o name-f ret)
+	   (lambda (unit)
+	     (if (characterp unit)
+		 (format "<a href=\"%s?char=%s\">%s</a>"
+			 chise-wiki-view-url
+			 (www-uri-encode-char unit)
+			 (www-format-encode-string (char-to-string unit)))
+	       (format "<a href=\"%s?%s=%s\">%s</a>"
 		       chise-wiki-view-url
-		       (www-uri-encode-char unit)
-		       (www-format-encode-string (char-to-string unit)))
-	     (www-format-encode-string (format "%s" unit)))))
+		       (concord-object-genre unit)
+		       (concord-object-id unit)
+		       (cond
+			((setq ret
+			       (www-get-feature-value
+				unit
+				(setq name-f
+				      (if (setq genre-o
+						(concord-decode-object
+						 '=id
+						 (concord-object-genre unit)
+						 'genre))
+					  (www-get-feature-value genre-o 'name)
+					'name))))
+			 (www-format-eval-feature-value
+			  unit name-f nil nil nil ret
+			  'without-tags 'without-edit)
+			 )
+                        (t
+			 (www-format-encode-string
+			  (format "%S" unit))
+			 ))
+		       unit)))))
        value " ")
     (www-format-encode-string (format "%s" value) without-tags)))