(www-feature-value-format): Search ancestors' property if own property
authorMORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Tue, 6 Apr 2010 01:02:26 +0000 (10:02 +0900)
committerMORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Tue, 6 Apr 2010 01:02:26 +0000 (10:02 +0900)
is not found.
(char-feature-name-parent): New function.
(www-format-feature-name*): Search ancestors' property if own property
is not found.

cwiki-common.el

index e5e937c..a3e2ee0 100644 (file)
 
 (defun www-feature-value-format (feature-name)
   (or (char-feature-property feature-name 'value-format)
+      (let (fn parent ret)
+       (setq fn feature-name)
+       (while (and (setq parent (char-feature-name-parent fn))
+                   (null (setq ret
+                               (char-feature-property
+                                parent 'value-format))))
+         (setq fn parent))
+       ret)
       (let ((type (www-feature-type feature-name)))
        (cond ((eq type 'relation)
               'space-separated-char-list)
       (intern (format "%s@%s" name domain))
       ))))
 
+(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-sans-versions (feature)
   (let ((feature-name (symbol-name feature)))
     (if (string-match "[@/]\\$rev=latest$" feature-name)
      (t dest))))
 
 (defun www-format-feature-name* (feature-name &optional lang)
-  (let (name)
+  (let (name fn parent ret)
     (cond
      ((or (and lang
               (char-feature-property
                (intern (format "name@%s" lang))))
          (char-feature-property
           feature-name 'name)))
-     ((find-charset feature-name)
-      (www-format-feature-name-as-CCS feature-name))
      ((and (setq name (symbol-name feature-name))
           (string-match "\\*" name))
       (www-format-feature-name-as-metadata feature-name lang))
-     ((string-match "^\\(->\\)" name)
-      (www-format-feature-name-as-rel-to feature-name))
-     ((string-match "^\\(<-\\)" name)
-      (www-format-feature-name-as-rel-from feature-name))
      (t
-      (www-format-feature-name-default feature-name)))))
+      (setq fn feature-name)
+      (while (and (setq parent (char-feature-name-parent fn))
+                 (null (setq ret
+                             (or (and lang
+                                      (char-feature-property
+                                       parent
+                                       (intern (format "name@%s" lang))))
+                                 (char-feature-property
+                                  parent 'name)))))
+       (setq fn parent))
+      (cond
+       (ret
+       (concat ret (substring (symbol-name feature-name)
+                              (length (symbol-name parent)))))
+       ((find-charset feature-name)
+       (www-format-feature-name-as-CCS feature-name))
+       ((string-match "^\\(->\\)" name)
+       (www-format-feature-name-as-rel-to feature-name))
+       ((string-match "^\\(<-\\)" name)
+       (www-format-feature-name-as-rel-from feature-name))
+       (t
+       (www-format-feature-name-default feature-name)
+       ))
+      ))))
 
 (defun www-format-feature-name (feature-name &optional lang)
   (www-format-encode-string