(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 (file)
--- 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.