(www-display-object-desc): Renamed from `www-display-char-desc'; add
authorMORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Tue, 12 Oct 2010 01:12:45 +0000 (10:12 +0900)
committerMORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Tue, 12 Oct 2010 01:12:45 +0000 (10:12 +0900)
new argument `genre'.

cwiki-view.el

index 826503f..075fce9 100644 (file)
@@ -5,28 +5,31 @@
 (defvar chise-wiki-edit-url "edit.cgi")
 (defvar chise-wiki-add-url "add.cgi")
 
-(defun www-display-char-desc (uri-char &optional lang level simple)
+(defun www-display-object-desc (genre uri-object &optional lang level simple)
   (unless level
     (setq level 1))
-  (let ((char (www-uri-decode-char uri-char))
+  (let ((object (www-uri-decode-object genre uri-object))
        logical-feature chise-wiki-displayed-features
        parents
        GlyphWiki-id)
-    (when (characterp char)
-      (when (= (length uri-char) 1)
-       (setq uri-char (www-uri-encode-char char)))
+    (when object
+      (when (and (eq genre 'character)
+                (= (length uri-object) 1))
+       (setq uri-object (www-uri-encode-char object)))
       (when (= level 1)
        (princ
         (encode-coding-string
          (format "<head>
-<title>CHISE-wiki character: %s</title>
+<title>EsT %s = %s</title>
 </head>\n"
-                 (decode-uri-string uri-char 'utf-8-mcs-er))
+                 genre
+                 (decode-uri-string uri-object 'utf-8-mcs-er))
          'utf-8-mcs-er))
        (princ "<body>\n"))
-      (dolist (feature (char-feature-property '$object 'additional-features))
-       (mount-char-attribute-table
-        (char-feature-name-at-domain feature '$rev=latest)))
+      (when (eq genre 'character)
+       (dolist (feature (char-feature-property '$object 'additional-features))
+         (mount-char-attribute-table
+          (char-feature-name-at-domain feature '$rev=latest))))
       (princ
        (format
        (if simple
 </a>
 </div>
 <hr />\n")
-       uri-char))
-      (when (setq parents (www-char-feature char '<-denotational))
+       uri-object))
+      (when (setq parents (www-get-feature-value object '<-denotational))
        (princ (format "<p>%s %s</p>\n<hr>\n"
                       (www-format-value-as-char-list parents)
                       (www-format-feature-name '->denotational lang))))
-      (when (setq parents (www-char-feature char '<-subsumptive))
+      (when (setq parents (www-get-feature-value object '<-subsumptive))
        (princ (format "<p>%s %s</p>\n<hr>\n"
                       (www-format-value-as-char-list parents)
                       (www-format-feature-name '->subsumptive lang))))
-      (setq GlyphWiki-id (char-GlyphWiki-id char))
+      (when (eq genre 'character)
+       (setq GlyphWiki-id (char-GlyphWiki-id object)))
       (princ (format "<h%d>%s%s</h%d>\n"
                     level
-                    (www-format-encode-string (char-to-string char))
+                    (www-format-encode-string (char-to-string object))
                     (if GlyphWiki-id
                         (format
                          " <a href=\"http://glyphwiki.org/wiki/%s\"><img alt=\"%s\" src=\"http://glyphwiki.org/glyph/%s.50px.png\" /></a>"
@@ -65,7 +69,9 @@
                     level))
       (if (> level 1)
          (princ "<ul>"))
-      (dolist (cell (sort (char-attribute-alist char)
+      (dolist (cell (sort (if (eq genre 'character)
+                             (char-attribute-alist object)
+                           (concord-object-spec object))
                          (lambda (a b)
                            (char-attribute-name<
                             (char-feature-name-sans-versions (car a))
          (princ
           (www-format-eval-list
            (www-feature-format logical-feature)
-            ;; (or (char-feature-property logical-feature ; (car cell)
-            ;;                            'format)
-            ;;     '((name) " : " (value)))
-           char
+           object
            logical-feature ; (car cell)
-           lang uri-char
+           lang uri-object
            nil simple))
          (unless simple
            (princ
             (format " <a href=\"%s?char=%s&feature=%s&format=wiki-text\"
 ><input type=\"submit\" value=\"note\" /></a>"
                     chise-wiki-edit-url
-                    (www-format-encode-string uri-char)
+                    (www-format-encode-string uri-object)
                     (www-format-encode-string
                      (www-uri-encode-feature-name
                       (intern (format "%s*note"
 ><input type=\"submit\" value=\"add feature\" /></a>
 "
                 chise-wiki-add-url
-                (www-format-encode-string uri-char))))
+                (www-format-encode-string uri-object))))
       (princ
        (if (= level 1)
           "<p>\n"
        "<form action=\"http://chise.zinbun.kyoto-u.ac.jp/ids-find\">\n")
       (princ
        (www-format-encode-string
-       (format "%c" char)))
+       (format "%c" object)))
       (princ
        (format
        " <input type=\"text\" name=\"components\"
 size=\"30\" maxlength=\"30\" value=\"%s\" />"
-       (encode-coding-string (char-to-string char) 'utf-8-jp-er)))
-      ;; (princ (www-format-encode-string "と"))
-      ;; (princ "<input type=\"text\" name=\"additional-components\"
-size=\;; "30\" maxlength=\"30\" value=\"\" />")
+       (encode-coding-string (char-to-string object) 'utf-8-jp-er)))
       (princ
        (www-format-encode-string
        "を\u542Bむ\u6F22\u5B57を\u63A2す"))
@@ -142,14 +142,14 @@ size=\;; "30\" maxlength=\"30\" value=\"\" />")
         "<li>\n"))
       )))
 
-(defun www-display-feature-desc (uri-feature-name uri-char
+(defun www-display-feature-desc (uri-feature-name uri-object
                                                  &optional lang simple)
   (let ((feature-name (www-uri-decode-feature-name uri-feature-name))
        (name@lang (intern (format "name@%s" lang))))
     (princ
      (encode-coding-string
       (format "<head>
-<title>CHISE-wiki feature: %s</title>
+<title>EsT feature: %s</title>
 </head>\n"
              feature-name)
       'utf-8-mcs-er))
@@ -170,7 +170,7 @@ size=\;; "30\" maxlength=\"30\" value=\"\" />")
 </a>
 </div>
 <hr />\n")
-      uri-feature-name uri-char))
+      uri-feature-name uri-object))
     (princ
      (format "<h1>%s</h1>\n"
             (www-format-encode-string
@@ -183,7 +183,7 @@ size=\;; "30\" maxlength=\"30\" value=\"\" />")
        " <a href=\"%s?feature=%s&property=name&format=string&char=%s\">"
        chise-wiki-edit-url
        uri-feature-name
-       uri-char))
+       uri-object))
       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
     (princ "</p>\n")
     (when lang
@@ -200,7 +200,7 @@ size=\;; "30\" maxlength=\"30\" value=\"\" />")
          chise-wiki-edit-url
          uri-feature-name
          name@lang
-         uri-char))
+         uri-object))
        (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
       (princ "</p>\n"))
     (www-html-display-paragraph
@@ -222,7 +222,7 @@ size=\;; "30\" maxlength=\"30\" value=\"\" />")
 >"
        chise-wiki-edit-url
        uri-feature-name
-       uri-char))
+       uri-object))
       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
     (princ "</p>\n")
 
@@ -239,7 +239,7 @@ size=\;; "30\" maxlength=\"30\" value=\"\" />")
 >"
        chise-wiki-edit-url
        uri-feature-name
-       uri-char))
+       uri-object))
       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
     (princ "</p>\n")
     
@@ -285,7 +285,8 @@ size=\;; "30\" maxlength=\"30\" value=\"\" />")
            (setq target
                  (concat "char="
                          (www-uri-encode-char
-                          (www-uri-decode-char (match-string 1 target)))
+                          (www-uri-decode-object
+                           'character (match-string 1 target)))
                          (substring target ret))))
          (setq target
                (mapcar (lambda (cell)
@@ -300,7 +301,8 @@ size=\;; "30\" maxlength=\"30\" value=\"\" />")
                        (split-string target "&")))
          (setq ret (car target))
          (cond ((eq (car ret) 'char)
-                (www-display-char-desc
+                (www-display-object-desc
+                 'character
                   (cdr ret)
                  lang nil
                  (eq mode 'simple))