From: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Date: Fri, 9 Apr 2010 00:47:12 +0000 (+0900)
Subject: (chise-wiki-displayed-features): New variable.
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=1632eb1a4e71684291201b568da64d577f4f1b88;p=chise%2Fest.git

(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
--- 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
 	  ""