(chise-wiki-displayed-features): New variable.

(char-feature-name-at-domain): Fix problem when `domain' is nil.
(char-feature-name-domain): New function.
(www-uri-make-feature-name-url): New function.
(www-format-props-to-string): Fix problem when :len's value is string.
(www-format-eval-unit):
- When :feature is specified, prefer FEATURE@DOMAIN to FEATURE.
- When :feature is specified in value related format functions, add
  the displayed feature-name to `chise-wiki-displayed-features'.
- Support `name-url' and `domain-name'.

diff --git a/cwiki-common.el b/cwiki-common.el
index 72103fe..c682cbd 100644 (file)
--- a/cwiki-common.el
+++ b/cwiki-common.el
@@ -10,6 +10,8 @@
 (defvar chise-wiki-glyph-cgi-url
   "http://chise.zinbun.kyoto-u.ac.jp/chisewiki/glyph.cgi")
 
+(defvar chise-wiki-displayed-features nil)
+
 (defun decode-uri-string (string &optional coding-system)
   (if (> (length string) 0)
       (let ((i 0)
@@ -85,20 +87,27 @@
            '("0x" (HEX) " (" (decimal) ") " (prev-char) (next-char))))))
 
 (defun char-feature-name-at-domain (feature-name domain)
-  (let ((name (symbol-name feature-name)))
-    (cond
-     ((string-match "@[^*]+$" name)
-      (intern (format "%s/%s" name domain))
-      )
-     (t
-      (intern (format "%s@%s" name domain))
-      ))))
+  (if domain
+      (let ((name (symbol-name feature-name)))
+       (cond
+        ((string-match "@[^*]+$" name)
+         (intern (format "%s/%s" name domain))
+         )
+        (t
+         (intern (format "%s@%s" name domain))
+         )))
+    feature-name))
 
 (defun char-feature-name-parent (feature-name)
   (let ((name (symbol-name feature-name)))
     (if (string-match "@[^@/*]+\\(/[^@/*]+\\)*$" name)
        (intern (substring name 0 (car (last (match-data) 2)))))))
 
+(defun char-feature-name-domain (feature-name)
+  (let ((name (symbol-name feature-name)))
+    (if (string-match "@[^@/*]+\\(/[^@/*]+\\)*$" name)
+       (intern (substring name (1+ (match-beginning 0)))))))
+
 (defun char-feature-name-sans-versions (feature)
   (let ((feature-name (symbol-name feature)))
     (if (string-match "[@/]\\$rev=latest$" feature-name)
@@ -322,6 +331,10 @@
     )
    (t feature-name)))
 
+(defun www-uri-make-feature-name-url (uri-feature-name uri-char)
+  (format "%s?feature=%s&char=%s"
+         chise-wiki-view-url uri-feature-name uri-char))
+
 (defun www-uri-decode-char (char-rep)
   (let (ccs cpos)
     (cond
@@ -861,7 +874,11 @@
           ;; (if (plist-get props :zero-padding)
           ;;     "0")
          (if (plist-get props :len)
-             (format "0%d" (plist-get props :len)))
+             (format "0%d"
+                     (let ((ret (plist-get props :len)))
+                       (if (stringp ret)
+                           (string-to-int ret)
+                         ret))))
          (cond
           ((eq format 'decimal) "d")
           ((eq format 'hex) "x")
@@ -966,12 +983,20 @@
     (cond
      ((memq (car exp) '(value decimal hex HEX ku-ten kangxi-radical
                              S-exp string default))
-      (let ((fn (plist-get (nth 1 exp) :feature)))
+      (let ((fn (plist-get (nth 1 exp) :feature))
+           domain domain-fn ret)
        (when fn
          (when (stringp fn)
            (setq fn (intern fn)))
-         (setq feature-name fn
-               value (www-char-feature char feature-name))))
+         (setq domain (char-feature-name-domain feature-name))
+         (setq domain-fn (char-feature-name-at-domain fn domain))
+         (if (setq ret (www-char-feature char domain-fn))
+             (setq feature-name domain-fn
+                   value ret)
+           (setq feature-name fn
+                 value (www-char-feature char fn)))
+         (push feature-name chise-wiki-displayed-features)
+          ))
       (if (eq (car exp) 'value)
          (www-format-eval-feature-value char feature-name
                                         (plist-get (nth 1 exp) :format)
@@ -984,20 +1009,40 @@
         without-tags without-edit))
       )
      ((eq (car exp) 'name)
-      (let ((fn (plist-get (nth 1 exp) :feature)))
+      (let ((fn (plist-get (nth 1 exp) :feature))
+           domain domain-fn)
        (when fn
-         (setq feature-name
-               (if (stringp fn)
-                   (intern fn)
-                 fn))))
+         (setq domain (char-feature-name-domain feature-name))
+         (when (stringp fn)
+           (setq fn (intern fn)))
+         (setq domain-fn (char-feature-name-at-domain fn domain))
+         (setq feature-name domain-fn)))
       (if without-tags
          (www-format-feature-name feature-name lang)
-       (format "<a href=\"%s?feature=%s&char=%s\">%s</a>"
-               chise-wiki-view-url
-               (www-uri-encode-feature-name feature-name)
-               uri-char
-               (www-format-feature-name feature-name lang)))
+       (format "<a href=\"%s\">%s</a>"
+               (www-uri-make-feature-name-url
+                (www-uri-encode-feature-name feature-name)
+                uri-char)
+               (www-format-feature-name feature-name lang))
+        )
+      )
+     ((eq (car exp) 'name-url)
+      (let ((fn (plist-get (nth 1 exp) :feature))
+           domain domain-fn)
+       (when fn
+         (setq domain (char-feature-name-domain feature-name))
+         (when (stringp fn)
+           (setq fn (intern fn)))
+         (setq domain-fn (char-feature-name-at-domain fn domain))
+         (setq feature-name domain-fn)))
+      (www-uri-make-feature-name-url
+       (www-uri-encode-feature-name feature-name)
+       uri-char)
       )
+     ((eq (car exp) 'domain-name)
+      (let ((domain (char-feature-name-domain feature-name)))
+       (if domain
+           (format "@%s" domain))))
      ((eq (car exp) 'prev-char)
       (if without-tags
          ""