X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=cwiki-set.el;h=c268068b63c303f38e22f319dc7e8fb578606e53;hb=e1822caa0d9b493b819635bf48b9066287467a10;hp=aee080be5b083845ad5a13c64a18ed57ccf4fccf;hpb=b1b856f43b529311257cc9aa1bf822975b799989;p=chise%2Fest.git
diff --git a/cwiki-set.el b/cwiki-set.el
index aee080b..c268068 100644
--- a/cwiki-set.el
+++ b/cwiki-set.el
@@ -96,10 +96,10 @@
(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)))
@@ -151,11 +151,11 @@
;; (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)
@@ -185,97 +185,106 @@
;;; @ display
;;;
-(defun www-set-display-char-desc (uri-char feature value format &optional lang)
+(defun www-set-display-object-desc (genre uri-object feature value format
+ &optional lang)
(when (stringp feature)
(setq feature (intern feature)))
(when (stringp format)
(setq format (intern format)))
- (let ((char (www-uri-decode-object 'character uri-char))
+ (let ((object (www-uri-decode-object genre uri-object))
latest-feature
logical-feature displayed-features
ret)
- (when (characterp char)
+ (when object
(princ
(encode-coding-string
(format "
-CHISE-wiki character: %s
+EsT %s = %s
\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 "\n")
(www-html-display-paragraph
- (format "char: %S %S %S %S\n"
- uri-char 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"
- char 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
- (if (equal (www-get-feature-value char feature) value)
+ (if (equal (www-get-feature-value object feature) value)
(www-html-display-paragraph
"Feature-value is not changed.")
;; (www-html-display-paragraph
;; (format "New feature-value = %S is different from old value %S"
;; value
- ;; (www-get-feature-value char feature)))
- (put-char-attribute char 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)))
+ ;; (www-get-feature-value object feature)))
+ (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 "%s
\n"
- (www-format-encode-string (char-to-string char))))
- (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 char)
- (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 "")
- (princ
- (www-format-eval-list
- (or (char-feature-property logical-feature 'format)
- '((name) " : " (value)))
- char logical-feature lang uri-char))
- (princ
- (format " "
- chise-wiki-edit-url
- (www-format-encode-string uri-char)
- (www-format-encode-string
- (www-uri-encode-feature-name
- (intern (format "%s*note" logical-feature))))))
- (princ "
\n")
- ))
- (princ
- (format "
"
- chise-wiki-add-url
- (www-format-encode-string uri-char)))
+ (www-display-object-desc genre uri-object nil lang 1)
+ ;; (princ (format "%s
\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 "")
+ ;; (princ
+ ;; (www-format-eval-list
+ ;; (or (char-feature-property logical-feature 'format)
+ ;; '((name) " : " (value)))
+ ;; object logical-feature lang uri-object))
+ ;; (princ
+ ;; (format " "
+ ;; 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 "
\n")
+ ;; ))
+ ;; (princ
+ ;; (format "
"
+ ;; chise-wiki-add-url
+ ;; (www-format-encode-string uri-object)))
)))
(defun www-set-display-feature-desc (feature-name property-name value format
- &optional lang uri-char)
+ &optional lang uri-object)
(www-html-display-paragraph
(format
- "set: feature: %S, property-name: %S, format: %S, value: %S, lang: %S, char: %S\n"
- feature-name property-name format value lang uri-char))
- (setq value (www-feature-parse-string property-name value 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 'feature property-name value format))
(www-html-display-paragraph
(format
- "set: feature: %S, property-name: %S, format: %S, value: %S, lang: %S, char: %S\n"
- feature-name property-name format value lang uri-char))
+ "set: feature: %S, property-name: %S, format: %S, value: %S, lang: %S, object: %S\n"
+ feature-name property-name format value lang uri-object))
(put-char-feature-property feature-name property-name value)
(let ((name@lang (intern (format "name@%s" lang)))
(uri-feature-name (www-uri-encode-feature-name feature-name)))
@@ -330,7 +339,7 @@
>"
chise-wiki-edit-url
uri-feature-name
- uri-char))
+ uri-object))
(www-html-display-paragraph
(format "description : %s"
(or (char-feature-property feature-name 'description)
@@ -346,9 +355,9 @@
(princ "
")
(www-html-display-paragraph
(format "ã[[%c|%s?char=%s]]ãã«\u623Bã"
- (www-uri-decode-object 'character uri-char)
+ (www-uri-decode-object 'character uri-object)
chise-wiki-view-url
- uri-char))
+ uri-object))
))
(defun www-batch-set ()
@@ -386,7 +395,8 @@
(setq ret (car target))
(cond ((eq (car ret) 'char)
(setq prop (nth 2 target))
- (www-set-display-char-desc
+ (www-set-display-object-desc
+ 'character
(cdr ret) ; (decode-uri-string (cdr ret) 'utf-8-mcs-er)
(intern (decode-uri-string
(cdr (assq 'feature-name target))
@@ -407,6 +417,18 @@
lang
(cdr (assq 'char target))
)
+ )
+ (t
+ (setq prop (nth 2 target))
+ (www-set-display-object-desc
+ (car ret)
+ (cdr ret) ; (decode-uri-string (cdr ret) 'utf-8-mcs-er)
+ (intern (decode-uri-string
+ (cdr (assq 'feature-name target))
+ 'utf-8-mcs-er))
+ (cdr prop) ; (decode-uri-string (cdr prop) 'utf-8-mcs-er)
+ (car prop)
+ lang)
))
(www-html-display-paragraph
(format "%S" target))