X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=cwiki-set.el;h=77cc431f8c59e2c7b5c1616c70bb6c91b160c386;hb=d13e4ba30d1413c0aff76863a142d5e738a338be;hp=7d11822fd1846925e5464e2df4246296f49ac87c;hpb=d6431c7b387ca7bf15ba527ef78a9e424e5c3865;p=chise%2Fest.git
diff --git a/cwiki-set.el b/cwiki-set.el
index 7d11822..77cc431 100644
--- a/cwiki-set.el
+++ b/cwiki-set.el
@@ -6,14 +6,95 @@
(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 (www-xml-to-stext-props (nth 1 unit))
+ children (nthcdr 2 unit))
+ (if children
+ (setq children (www-xml-to-stext-list children)))
+ (when (and (eq name 'link)
+ (consp (car children))
+ (eq (caar children) 'ref))
+ (setq props (list* :ref (nthcdr 2 (car children))
+ props)
+ children (cdr children)))
+ (if children
+ (list* name props children)
+ (if props
+ (list name 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)))
+ ;; (let ((ret
+ ;; (mapcar #'read (split-string string " "))))
+ ;; (if (cdr ret)
+ ;; ret
+ ;; (car ret)))
+ (let ((i 0)
+ (len (length string))
+ dest ret)
+ (while (< i len)
+ (setq ret (read-from-string string i))
+ (setq dest (cons (car ret) dest)
+ i (cdr ret)))
+ (if (cdr dest)
+ (nreverse dest)
+ (if (atom (car dest))
+ (car dest)
+ (nreverse dest))))
(error nil)))
(defun www-parse-string-as-space-separated-char-list (string)
@@ -45,7 +126,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 +159,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 +194,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))
@@ -155,12 +243,17 @@
(www-format-encode-string uri-char)))
)))
-(defun www-set-display-feature-desc (feature-name property-name value
+(defun www-set-display-feature-desc (feature-name property-name value format
&optional lang uri-char)
(www-html-display-paragraph
(format
- "set: feature: %S, property-name: %S, value: %S, lang: %S, char: %S\n"
- feature-name property-name value lang uri-char))
+ "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))
+ (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))
(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)))
@@ -202,6 +295,20 @@
(or (www-feature-type feature-name)
;; (char-feature-property feature-name 'type)
'generic)))
+ (princ (format "value-format : %s "
+ (www-format-value
+ nil 'value-format
+ (or (www-feature-value-format feature-name)
+ 'default)
+ 'default
+ 'without-tags)))
+ (princ
+ (format
+ "
"
+ chise-wiki-edit-url
+ uri-feature-name
+ uri-char))
(www-html-display-paragraph
(format "description : %s"
(or (char-feature-property feature-name 'description)
@@ -265,14 +372,16 @@
lang)
)
((eq (car ret) 'feature)
- (setq prop (nth 2 target))
+ (setq prop (nth 3 target))
(www-set-display-feature-desc
(intern (decode-uri-string (cdr ret) 'utf-8-mcs-er))
+ (intern (decode-uri-string
+ (cdr (assq 'feature-name (cdr target)))
+ 'utf-8-mcs-er))
+ (cdr prop) ; (decode-uri-string (cdr prop) 'utf-8-mcs-er)
(car prop)
- (decode-uri-string (cdr prop) 'utf-8-mcs-er)
lang
(cdr (assq 'char target))
- ;; (decode-uri-string (cdr (assq 'char target)))
)
))
(www-html-display-paragraph