From: MORIOKA Tomohiko Date: Thu, 18 Mar 2010 20:40:14 +0000 (+0900) Subject: (www-xml-parse-string): New function. X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=b1f63d5f3393eb115894454030b44fe1f1e6cbec;p=chise%2Fest.git (www-xml-parse-string): New function. (www-xml-to-stext-props): New function. (www-xml-to-stext-unit): New function. (www-xml-to-stext-list): New function. (www-stext-parse-xml-string): New function. (www-parse-string-as-wiki-text): Use `www-stext-parse-xml-string'. --- diff --git a/cwiki-set.el b/cwiki-set.el index 7d11822..2b552c3 100644 --- a/cwiki-set.el +++ b/cwiki-set.el @@ -6,6 +6,71 @@ (require 'cwiki-view) +;;; @ stext parser +;;; + +(defun www-xml-parse-string (string) + (require 'xml) + (nthcdr + 2 + (car + (with-temp-buffer + (insert "") + (insert string) + (insert "") + (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 @@ -45,7 +110,10 @@ ten 32))))) (defun www-parse-string-as-wiki-text (string) - (list (decode-uri-string string 'utf-8-mcs-er))) + (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 @@ -75,6 +143,10 @@ (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))) @@ -106,10 +178,10 @@ (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))) + ;; (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))