From: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Date: Tue, 30 Mar 2010 09:56:41 +0000 (+0900)
Subject: (www-format-value-as-domain-list): New function.
X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fest.git;a=commitdiff_plain;h=9a97c38f7a05c4f573301a4e8555c0b075b1b5bc

(www-format-value-as-domain-list): New function.
(www-format-apply-value): Support `space-separated-domain-list'.
(char-GlyphWiki-id): Try to avoid uHHHH-{u|us}.
---

diff --git a/cwiki-common.el b/cwiki-common.el
index e395bfd..b0e1628 100644
--- a/cwiki-common.el
+++ b/cwiki-common.el
@@ -354,6 +354,63 @@
        value " ")
     (www-format-encode-string (format "%s" value) without-tags)))
 
+(defun www-format-value-as-domain-list (value &optional without-tags)
+  (let (name source0 source num dest rest unit start end ddest)
+    (if (listp value)
+	(if without-tags
+	    (mapconcat
+	     (lambda (unit)
+	       (format "%s" unit))
+	     value " ")
+	  (setq rest value)
+	  (while rest
+	    (setq unit (pop rest))
+	    (if (symbolp unit)
+		(setq name (symbol-name unit)))
+	    (setq dest
+		  (concat
+		   dest
+		   (cond
+		    ((string-match "^zob1968=" name)
+		     (setq source (intern (substring name 0 (match-end 0)))
+			   num (substring name (match-end 0)))
+		     (if (string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" num)
+			 (setq start (string-to-number
+				      (match-string 1 num))
+			       end (string-to-number
+				    (match-string 2 num)))
+		       (setq start (string-to-number num)
+			     end start))
+		     (setq ddest
+			   (if (eq source source0)
+			       (format
+				", <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
+				start start)
+			     (setq source0 source)
+			     (format
+			      " <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/\">%s</a>=<a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
+			      (www-format-encode-string "\u4EAC大人\u6587研甲\u9AA8")
+			      start start)))
+		     (setq start (1+ start))
+		     (while (<= start end)
+		       (setq ddest
+			     (concat
+			      ddest
+			      (format
+			       ", <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
+			       start start)))
+		       (setq start (1+ start)))
+		     ddest)
+		    (t
+		     (setq source unit)
+		     (if (eq source source0)
+			 ""
+		       (setq source0 source)
+		       (concat " " name))
+		     )))))
+	  dest)
+      (www-format-encode-string (format "%s" value) without-tags))))
+
 (defun www-format-value-as-ids (value &optional without-tags)
   (if (listp value)
       (mapconcat
@@ -640,6 +697,8 @@
 	    (www-format-value-as-char-list value without-tags))
 	   ((eq format 'space-separated-ids)
 	    (www-format-value-as-ids value without-tags))
+	   ((eq format 'space-separated-domain-list)
+	    (www-format-value-as-domain-list value without-tags))
 	   ((eq format 'string)
 	    (www-format-encode-string (format "%s" value) without-tags)
 	    )
@@ -850,7 +909,6 @@
     (=ucs@unicode	"u"	4 x "-us")
     (=adobe-japan1-6	"aj1-"	5 d nil)
     (=gt		"gt-"	5 d nil)
-    (=gt-k		"gt-k"	5 d nil)
     (=big5-cdp		"cdp-"	4 x nil)
     (=cbeta		"cb"	5 d nil)
     (=jis-x0208@1978/1pr "j78-"	4 x nil)
@@ -870,6 +928,7 @@
     (=cns11643-6	"c6-"	4 x nil)
     (=cns11643-7	"c7-"	4 x nil)
     (=daikanwa		"dkw-"	5 d nil)
+    (=gt-k		"gt-k"	5 d nil)
     (=jef-china3	"jc3-"	4 x nil)
     (=big5		"b-"	4 x nil)
     (=ks-x1001		"k0-"	4 x nil)
@@ -877,18 +936,45 @@
 
 (defun char-GlyphWiki-id (char)
   (let ((rest coded-charset-GlyphWiki-id-alist)
-	spec
-	ret)
+	spec ret code)
     (while (and rest
 		(setq spec (pop rest))
 		(null (setq ret (char-feature char (car spec))))))
     (when ret
-      (format (format "%s%%0%d%s%s"
-		      (nth 1 spec)
-		      (nth 2 spec)
-		      (nth 3 spec)
-		      (or (nth 4 spec) ""))
-	      ret))))
+      (or
+       (and (memq (car spec) '(=ucs@unicode '=ucs@iso))
+	    (cond
+	     ((and (or (encode-char char '=jis-x0208@1990)
+		       (encode-char char '=jis-x0212)
+		       (encode-char char '=jis-x0213-1))
+		   (setq code (encode-char char '=ucs@jis)))
+	      (format "u%04x" code)
+	      )
+	     ((and (or (encode-char char '=gb2312)
+		       (encode-char char '=gb12345))
+		   (setq code (encode-char char '=ucs@gb)))
+	      (format "u%04x-g" code)
+	      )
+	     ((and (or (encode-char char '=cns11643-1)
+		       (encode-char char '=cns11643-2)
+		       (encode-char char '=cns11643-3)
+		       (encode-char char '=cns11643-4)
+		       (encode-char char '=cns11643-5)
+		       (encode-char char '=cns11643-6)
+		       (encode-char char '=cns11643-7))
+		   (setq code (encode-char char '=ucs@cns)))
+	      (format "u%04x-t" code)
+	      )
+	     ((and (encode-char char '=ks-x1001)
+		   (setq code (encode-char char '=ucs@ks)))
+	      (format "u%04x-k" code)
+	      )))
+       (format (format "%s%%0%d%s%s"
+		       (nth 1 spec)
+		       (nth 2 spec)
+		       (nth 3 spec)
+		       (or (nth 4 spec) ""))
+	       ret)))))
 
 
 ;;; @ End.