(www-parse-string-as-space-separated-char-list): Add argument `genre'.
authorMORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Fri, 10 Dec 2010 11:21:00 +0000 (20:21 +0900)
committerMORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Fri, 10 Dec 2010 11:21:00 +0000 (20:21 +0900)
(www-feature-parse-string): Likewise.
(www-set-display-object-desc):
- Support non-character genre objects.
- Use `www-display-object-desc'.
(www-set-display-feature-desc): Modify for `www-feature-parse-string'.
(www-batch-set): Fixed.

cwiki-set.el

index fc56eb7..78ae36a 100644 (file)
            (nreverse dest))))
     (error nil)))
 
-(defun www-parse-string-as-space-separated-char-list (string)
+(defun www-parse-string-as-space-separated-char-list (string genre)
   (let (dest char)
     (dolist (unit (split-string string "\\+"))
-      (if (setq char (www-uri-decode-object 'character unit))
+      (if (setq char (www-uri-decode-object genre unit))
          (setq dest (cons char dest))))
     (nreverse dest)))
 
   ;; (list (decode-uri-string string 'utf-8-mcs-er))
   )
 
-(defun www-feature-parse-string (feature-name string &optional format)
+(defun www-feature-parse-string (genre feature-name string &optional format)
   (unless format
     (setq format (www-feature-value-format feature-name)))
   (cond ((eq format 'space-separated-char-list)
-        (www-parse-string-as-space-separated-char-list string))
+        (www-parse-string-as-space-separated-char-list string genre))
        ((eq format 'space-separated-ids)
         (www-parse-string-as-space-separated-ids string))
        ((eq format 'ku-ten)
     (setq feature (intern feature)))
   (when (stringp format)
     (setq format (intern format)))
-  (let ((object (www-uri-decode-object 'character uri-object))
+  (let ((object (www-uri-decode-object genre uri-object))
        latest-feature
        logical-feature displayed-features
        ret)
-    (when (characterp object)
+    (when object
       (princ
        (encode-coding-string
        (format "<head>
-<title>CHISE-wiki character: %s</title>
+<title>EsT %s = %s</title>
 </head>\n"
+               genre
                (decode-uri-string uri-object 'utf-8-mcs-er))
        'utf-8-mcs-er))
       (princ "<body>\n")
       (www-html-display-paragraph
-       (format "char: %S %S %S %S\n"
-              uri-object feature value lang))
-      (setq value (www-feature-parse-string feature value format))
+       (format "object: %S (%S) %S %S %S\n"
+              uri-object genre feature value lang))
+      (setq value (www-feature-parse-string genre feature value format))
       (www-html-display-paragraph
-       (format "char = %c : %S \u2190 %S"
-              object feature value))
+       (format "object = %s (%s) : %S \u2190 %S"
+              (est-format-object object) genre feature value))
       (setq latest-feature
            (char-feature-name-at-domain feature '$rev=latest))
       (if value
             ;;  (format "New feature-value = %S is different from old value %S"
             ;;          value
             ;;          (www-get-feature-value object feature)))
-           (put-char-attribute object latest-feature value)
-           (save-char-attribute-table latest-feature)
-           (setq ret (char-feature-property '$object 'additional-features))
-           (unless (memq feature ret)
-             (put-char-feature-property
-              '$object 'additional-features (cons feature ret)))
+           (cond
+            ((characterp object)
+             (put-char-attribute object latest-feature value)
+             (save-char-attribute-table latest-feature)
+             (setq ret (char-feature-property '$object 'additional-features))
+             (unless (memq feature ret)
+               (put-char-feature-property
+                '$object 'additional-features (cons feature ret)))
+             )
+            (t
+             (concord-object-put object latest-feature value)
+             ))
            )
        (www-html-display-paragraph
         "New feature-value is nil, so it is ignored (may be syntax error).")
        )
-      (princ (format "<h1>%s</h1>\n"
-                    (www-format-encode-string (char-to-string object))))
-      (dolist (feature (char-feature-property '$object 'additional-features))
-       (mount-char-attribute-table
-        (char-feature-name-at-domain feature '$rev=latest)))
-      (dolist (cell (sort (char-attribute-alist object)
-                         (lambda (a b)
-                           (char-attribute-name< (car a)(car b)))))
-       (setq logical-feature
-             (char-feature-name-sans-versions (car cell)))
-       (unless (memq logical-feature displayed-features)
-         (push logical-feature displayed-features)
-         (princ "<p>")
-         (princ
-          (www-format-eval-list
-           (or (char-feature-property logical-feature 'format)
-               '((name) " : " (value)))
-           object logical-feature lang uri-object))
-         (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-object)
-                  (www-format-encode-string
-                   (www-uri-encode-feature-name
-                    (intern (format "%s*note" logical-feature))))))
-         (princ "</p>\n")
-         ))
-      (princ
-       (format "<p><a href=\"%s?char=%s\"
-><input type=\"submit\" value=\"add feature\" /></a></p>"
-              chise-wiki-add-url
-              (www-format-encode-string uri-object)))
+      (www-display-object-desc genre uri-object lang 1)
+      ;; (princ (format "<h1>%s</h1>\n"
+      ;;                (www-format-encode-string (char-to-string object))))
+      ;; (dolist (feature (char-feature-property '$object 'additional-features))
+      ;;   (mount-char-attribute-table
+      ;;    (char-feature-name-at-domain feature '$rev=latest)))
+      ;; (dolist (cell (sort (char-attribute-alist object)
+      ;;                     (lambda (a b)
+      ;;                       (char-attribute-name< (car a)(car b)))))
+      ;;   (setq logical-feature
+      ;;         (char-feature-name-sans-versions (car cell)))
+      ;;   (unless (memq logical-feature displayed-features)
+      ;;     (push logical-feature displayed-features)
+      ;;     (princ "<p>")
+      ;;     (princ
+      ;;      (www-format-eval-list
+      ;;       (or (char-feature-property logical-feature 'format)
+      ;;           '((name) " : " (value)))
+      ;;       object logical-feature lang uri-object))
+      ;;     (princ
+      ;;      (format " <a href=\"%s?char=%s&feature=%s&format=wiki-text\"
+;;><inpu;; t type=\"submit\" value=\"note\" /></a>"
+      ;;              chise-wiki-edit-url
+      ;;              (www-format-encode-string uri-object)
+      ;;              (www-format-encode-string
+      ;;               (www-uri-encode-feature-name
+      ;;                (intern (format "%s*note" logical-feature))))))
+      ;;     (princ "</p>\n")
+      ;;     ))
+      ;; (princ
+      ;;  (format "<p><a href=\"%s?char=%s\"
+;;><inpu;; t type=\"submit\" value=\"add feature\" /></a></p>"
+      ;;          chise-wiki-add-url
+      ;;          (www-format-encode-string uri-object)))
       )))
 
 (defun www-set-display-feature-desc (feature-name property-name value format
    (format
     "set: feature: %S, property-name: %S, format: %S, value: %S, lang: %S, object: %S\n"
     feature-name property-name format value lang uri-object))
-  (setq value (www-feature-parse-string property-name value format))
+  (setq value (www-feature-parse-string 'feature property-name value format))
   (www-html-display-paragraph
    (format
     "set: feature: %S, property-name: %S, format: %S, value: %S, lang: %S, object: %S\n"
                )
               )
              (t
-              (setq prop (nth 3 target))
+              (setq prop (nth 2 target))
               (www-set-display-object-desc
                (car ret)
                (cdr ret) ; (decode-uri-string (cdr ret) 'utf-8-mcs-er)