(est-format-object): New function.

[chise/est.git] / cwiki-common.el

diff --git a/cwiki-common.el b/cwiki-common.el
index c682cbd..d814406 100644 (file)
--- a/cwiki-common.el
+++ b/cwiki-common.el
@@ -1,6 +1,14 @@
 ;; -*- coding: utf-8-mcs-er -*-
 (require 'char-db-util)
 
+(setq file-name-coding-system 'utf-8-mcs-er)
+
+(concord-assign-genre 'creator "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'bibliography "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'era "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'period "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'journal "/usr/local/var/ruimoku/db")
+
 (defvar chise-wiki-view-url "view.cgi")
 (defvar chise-wiki-edit-url "edit.cgi")
 
@@ -114,11 +122,18 @@
        (intern (substring feature-name 0 (match-beginning 0)))
       feature)))
 
-(defun www-char-feature (character feature)
+(defun www-get-feature-value (object feature)
   (let ((latest-feature (char-feature-name-at-domain feature '$rev=latest)))
-    (mount-char-attribute-table latest-feature)
-    (or (char-feature character latest-feature)
-       (char-feature character feature))))
+    (cond
+     ((characterp object)
+      (mount-char-attribute-table latest-feature)
+      (or (char-feature object latest-feature)
+         (char-feature object feature))
+      )
+     (t
+      (or (concord-object-get object latest-feature)
+         (concord-object-get object feature))
+      ))))
 
 (defun get-previous-code-point (ccs code)
   (let ((chars (charset-chars ccs))
@@ -335,7 +350,7 @@
   (format "%s?feature=%s&char=%s"
          chise-wiki-view-url uri-feature-name uri-char))
 
-(defun www-uri-decode-char (char-rep)
+(defun www-uri-decode-object (genre char-rep)
   (let (ccs cpos)
     (cond
      ((string-match "\\(%3A\\|:\\)" char-rep)
@@ -348,16 +363,28 @@
              (string-to-number (substring cpos (match-end 0)) 16))
        )
        (t
-       (setq cpos (string-to-number cpos))
+       (setq cpos (car (read-from-string cpos)))
        ))
-      (if (numberp cpos)
-         (decode-char ccs cpos))
+      (if (and (eq genre 'character)
+              (numberp cpos))
+         (decode-char ccs cpos)
+       (concord-decode-object ccs cpos genre))
       )
      (t
       (setq char-rep (decode-uri-string char-rep 'utf-8-mcs-er))
-      (when (= (length char-rep) 1)
-       (aref char-rep 0))
-      ))))
+      (cond
+       ((eq genre 'character)
+       (when (= (length char-rep) 1)
+         (aref char-rep 0))
+       )
+       ((eq genre 'feature)
+       (concord-decode-object
+        '=id (www-uri-decode-feature-name char-rep) 'feature)
+       )
+       (t
+       (concord-decode-object
+        '=id (car (read-from-string char-rep)) genre)
+       ))))))
 
 (defun www-uri-encode-char (char)
   (if (encode-char char '=ucs)
@@ -402,6 +429,11 @@
                     (encode-char char 'system-char-id))
             )))))
 
+(defun est-format-object (object)
+  (if (characterp object)
+      (char-to-string object)
+    (format "%s" (concord-object-id object))))
+
 
 ;;; @ Feature name presentation
 ;;;
@@ -648,7 +680,7 @@
                                &optional value format
                                without-tags without-edit)
   (unless value
-    (setq value (www-char-feature object feature-name)))
+    (setq value (www-get-feature-value object feature-name)))
   (www-format-apply-value object feature-name
                          format nil value nil nil
                          without-tags without-edit)
@@ -827,8 +859,8 @@
            (setq char (decode-char 'system-char-id code))
            (cond
             ((and (setq variants
-                        (or (www-char-feature char '->subsumptive)
-                            (www-char-feature char '->denotational)))
+                        (or (www-get-feature-value char '->subsumptive)
+                            (www-get-feature-value char '->denotational)))
                   (progn
                     (while (and variants
                                 (setq ret (www-format-encode-string
@@ -841,8 +873,8 @@
                (delete-region start end)
                (insert ret))
              )
-            ((setq ret (or (www-char-feature char 'ideographic-combination)
-                           (www-char-feature char 'ideographic-structure)))
+            ((setq ret (or (www-get-feature-value char 'ideographic-combination)
+                           (www-get-feature-value char 'ideographic-structure)))
              (setq ret
                    (mapconcat
                     (lambda (ch)
@@ -944,7 +976,7 @@
                                      &optional format lang uri-char value
                                      without-tags without-edit)
   (unless value
-    (setq value (www-char-feature char feature-name)))
+    (setq value (www-get-feature-value char feature-name)))
   (unless format
     (setq format (www-feature-value-format feature-name)))
   (cond
@@ -973,7 +1005,7 @@
                                 &optional lang uri-char value
                                 without-tags without-edit)
   (unless value
-    (setq value (www-char-feature char feature-name)))
+    (setq value (www-get-feature-value char feature-name)))
   (unless uri-char
     (setq uri-char (www-uri-encode-char char)))
   (cond
@@ -990,11 +1022,11 @@
            (setq fn (intern fn)))
          (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))
+         (if (setq ret (www-get-feature-value char domain-fn))
              (setq feature-name domain-fn
                    value ret)
            (setq feature-name fn
-                 value (www-char-feature char fn)))
+                 value (www-get-feature-value char fn)))
          (push feature-name chise-wiki-displayed-features)
           ))
       (if (eq (car exp) 'value)