(require 'cwiki-view)
+;;; @ stext parser
+;;;
+
+(defun www-xml-parse-string (string)
+ (require 'xml)
+ (nthcdr
+ 2
+ (car
+ (with-temp-buffer
+ (insert "<top>")
+ (insert string)
+ (insert "</top>")
+ (xml-parse-region (point-min)(point-max))))))
+
+(defun www-xml-to-stext-props (props)
+ (let (dest)
+ (dolist (cell props)
+ (setq dest (cons (cdr cell)
+ (cons (intern (format ":%s" (car cell)))
+ dest))))
+ (nreverse dest)))
+
+(defun www-xml-to-stext-unit (unit)
+ (let (name props children)
+ (cond
+ ((stringp unit)
+ unit)
+ ((consp unit)
+ (setq name (car unit))
+ (if (stringp name)
+ nil
+ (setq props (nth 1 unit)
+ children (nthcdr 2 unit))
+ (if children
+ (setq children (www-xml-to-stext-list children)))
+ (if children
+ (list* name
+ (www-xml-to-stext-props props)
+ children)
+ (if props
+ (list name (www-xml-to-stext-props props))
+ (list name))))
+ )
+ (t
+ (format "%S" unit)))))
+
+(defun www-xml-to-stext-list (trees)
+ (cond
+ ((atom trees)
+ (www-xml-to-stext-unit trees)
+ )
+ ((equal trees '(("")))
+ nil)
+ (t
+ (mapcar #'www-xml-to-stext-unit
+ trees))))
+
+(defun www-stext-parse-xml-string (string)
+ (www-xml-to-stext-list
+ (www-xml-parse-string string)))
+
+
+;;; @ parser
+;;;
+
+(defun www-parse-string-default (string)
+ (setq string (decode-uri-string string 'utf-8-mcs-er))
+ (condition-case nil
+ (let ((ret
+ (mapcar #'read (split-string string " "))))
+ (if (cdr ret)
+ ret
+ (car ret)))
+ (error nil)))
+
(defun www-parse-string-as-space-separated-char-list (string)
(let (dest char)
(dolist (unit (split-string string "\\+"))
(+ (lsh (+ ku 32) 8)
ten 32)))))
+(defun www-parse-string-as-wiki-text (string)
+ (www-stext-parse-xml-string
+ (decode-uri-string string 'utf-8-mcs-er))
+ ;; (list (decode-uri-string string 'utf-8-mcs-er))
+ )
+
(defun www-feature-parse-string (feature-name string &optional format)
(unless format
(setq format (www-feature-value-format feature-name)))
(string-to-number string))
((or (eq format 'HEX)(eq format 'hex))
(string-to-number string 16))
+ ((eq format 'string)
+ (decode-uri-string string 'utf-8-mcs-er)
+ )
+ ((eq format 'wiki-text)
+ (www-parse-string-as-wiki-text string)
+ )
((eq format 'S-exp)
(if (= (length string) 0)
nil
(read (decode-uri-string string 'utf-8-mcs-er)))
)
- (t (decode-uri-string string 'utf-8-mcs-er))))
+ (t
+ (www-parse-string-default string)
+ )))
+
+
+;;; @ display
+;;;
(defun www-set-display-char-desc (uri-char feature value format &optional lang)
(when (stringp feature)
(setq feature (intern feature)))
(when (stringp format)
(setq format (intern format)))
- (let ((char (www-uri-decode-char uri-char)))
+ (let ((char (www-uri-decode-char uri-char))
+ latest-feature
+ logical-feature displayed-features
+ ret)
(when (characterp char)
(princ
(encode-coding-string
uri-char feature value lang))
(setq value (www-feature-parse-string feature value format))
(www-html-display-paragraph
- (format "char = %c" char))
- (www-html-display-paragraph
- (format "feature-name = %S" feature))
- (www-html-display-paragraph
- (format "feature-value = %S" value))
+ (format "char = %c : %S \u2190 %S"
+ char feature value))
+ (setq latest-feature
+ (char-feature-name-at-domain feature '$rev=latest))
+ (if value
+ (if (equal (www-char-feature char 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-char-feature 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-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 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)))))
- (princ "<p>")
- (princ
- (www-format-eval-list
- (or (char-feature-property (car cell) 'format)
- '((name) " : " (value)))
- char (car cell) lang uri-char))
- (princ
- (format " <a href=\"%s?char=%s&feature=%s\"
+ (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)))
+ char logical-feature lang uri-char))
+ (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
- (www-uri-encode-feature-name
- (intern (format "%s*note" (car cell)))))))
- (princ "</p>\n")
- )
+ 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 "</p>\n")
+ ))
(princ
(format "<p><a href=\"%s?char=%s\"
><input type=\"submit\" value=\"add feature\" /></a></p>"
projects / chise / est.git / blobdiff