(www-xml-to-stext-unit): Support <link><ref>...</ref>...</link>.

[chise/est.git] / cwiki-common.el

diff --git a/cwiki-common.el b/cwiki-common.el
index bb339a6..4f62691 100644 (file)
--- a/cwiki-common.el
+++ b/cwiki-common.el
@@ -35,6 +35,12 @@
   (or (char-feature-property feature-name 'type)
       (let ((str (symbol-name feature-name)))
        (cond
+        ((string-match "\\*note\\(@[^*]+\\)?$" str)
+         'stext)
+        ((string-match "\\*sources\\(@[^*]+\\)?$" str)
+         'domain-list)
+        ((string-match "\\*" str)
+         nil)
         ((string-match "^\\(->\\|<-\\)" str)
          'relation)
         ((string-match "^ideographic-structure\\(@\\|$\\)" str)
@@ -47,7 +53,10 @@
        (cond ((eq type 'relation)
               'space-separated-char-list)
              ((eq type 'structure)
-              'space-separated-ids)))
+              'space-separated-ids)
+             ((eq type 'stext)
+              'wiki-text)
+             ))
       (if (find-charset feature-name)
          (if (and (= (charset-dimension feature-name) 2)
                   (= (charset-chars feature-name) 94))
@@ -65,6 +74,12 @@
       (intern (format "%s@%s" name domain))
       ))))
 
+(defun char-feature-name-sans-versions (feature)
+  (let ((feature-name (symbol-name feature)))
+    (if (string-match "[@/]\\$rev=latest$" feature-name)
+       (intern (substring feature-name 0 (match-beginning 0)))
+      feature)))
+
 (defun www-char-feature (character feature)
   (let ((latest-feature (char-feature-name-at-domain feature '$rev=latest)))
     (mount-char-attribute-table latest-feature)
@@ -235,6 +250,19 @@
     "-")
    " "))
 
+(defun www-format-feature-name-as-metadata (feature-name &optional lang)
+  (let ((str (symbol-name feature-name))
+       base meta)
+    (cond
+     ((string-match "\\*[^*]+$" str)
+      (setq base (substring str 0 (match-beginning 0))
+           meta (substring str (match-beginning 0)))
+      (concat (www-format-feature-name* (intern base) lang)
+             meta))
+     (t
+      (www-format-feature-name-default feature-name)
+      ))))
+
 (defun www-format-feature-name-as-rel-to (feature-name)
   (concat "\u2192" (substring (symbol-name feature-name) 2)))
 
@@ -273,7 +301,9 @@
      ((find-charset feature-name)
       (www-format-feature-name-as-CCS feature-name))
      ((and (setq name (symbol-name feature-name))
-          (string-match "^\\(->\\)" name))
+          (string-match "\\*" name))
+      (www-format-feature-name-as-metadata feature-name lang))
+     ((string-match "^\\(->\\)" name)
       (www-format-feature-name-as-rel-to feature-name))
      ((string-match "^\\(<-\\)" name)
       (www-format-feature-name-as-rel-from feature-name))
@@ -358,19 +388,12 @@
              value)
     (www-format-value-as-S-exp value)))
 
-(defun www-format-value (value &optional feature-name format without-tags)
-  ;; (cond
-  ;;  ((find-charset feature-name)
-  ;;   (cond
-  ;;    ((and (= (charset-chars feature-name) 94)
-  ;;          (= (charset-dimension feature-name) 2))
-  ;;     (www-format-value-as-CCS-94x94 value))
-  ;;    (t
-  ;;     (www-format-value-as-CCS-default value)))
-  ;;   )
-  ;;  (t
-  ;;   (www-format-value-as-S-exp value)))
-  (www-format-apply-value format nil value nil nil without-tags)
+(defun www-format-value (object feature-name
+                               &optional value format without-tags)
+  (unless value
+    (setq value (www-char-feature object feature-name)))
+  (www-format-apply-value object feature-name
+                         format nil value nil nil without-tags)
   )
 
 
@@ -556,7 +579,8 @@
           ((eq format 'S-exp) "S")
           (t "s"))))      
 
-(defun www-format-apply-value (format props value
+(defun www-format-apply-value (object feature-name
+                                     format props value
                                      &optional uri-char uri-feature
                                      without-tags)
   (let (ret)
@@ -570,6 +594,11 @@
               (format "%s" value)
               without-tags))
            )
+          ((eq format 'wiki-text)
+           (if without-tags
+               (www-xml-format-list value)
+             (www-format-eval-list value object feature-name nil uri-char))
+           )
           ((eq format 'S-exp)
            (www-format-encode-string
             (format (www-format-props-to-string props format)
@@ -582,7 +611,7 @@
           ((eq format 'space-separated-ids)
            (www-format-value-as-ids value without-tags))
           (t
-           (setq format 'default)
+            ;; (setq format 'default)
            (www-format-encode-string
             (format (www-format-props-to-string props 'default)
                     value)
@@ -605,6 +634,7 @@
   (cond
    ((symbolp format)
     (www-format-apply-value
+     char feature-name
      format nil value
      uri-char (www-uri-encode-feature-name feature-name))
     )
@@ -612,6 +642,7 @@
     (cond ((null (cdr format))
           (setq format (car format))
           (www-format-apply-value
+           char feature-name
            (car format) (nth 1 format) value
            uri-char (www-uri-encode-feature-name feature-name))
           )
@@ -636,6 +667,7 @@
                                         (plist-get (nth 1 exp) :format)
                                         lang uri-char value)
        (www-format-apply-value
+        char feature-name
         (car exp) (nth 1 exp) value
         uri-char (www-uri-encode-feature-name feature-name)))
       )
@@ -674,6 +706,61 @@
     (www-format-eval-unit format-list char feature-name lang uri-char)))
 
 
+;;; @ XML generator
+;;;
+
+(defun www-xml-format-props (props)
+  (let ((dest "")
+       key val)
+    (while props
+      (setq key (pop props)
+           val (pop props))
+      (if (symbolp key)
+         (setq key (symbol-name key)))
+      (if (eq (aref key 0) ?:)
+         (setq key (substring key 1)))
+      (setq dest
+           (format "%s %s=\"%s\""
+                   dest key val)))
+    dest))
+
+(defun www-xml-format-unit (format-unit)
+  (let (name props children ret)
+    (cond
+     ((stringp format-unit)
+      format-unit)
+     ((consp format-unit)
+      (setq name (car format-unit)
+           props (nth 1 format-unit)
+           children (nthcdr 2 format-unit))
+      (when (eq name 'link)
+       (setq ret (plist-get props :ref))
+       (unless (stringp ret)
+         (setq props (plist-remprop (copy-list props) :ref))
+         (setq children
+               (cons (list* 'ref nil ret)
+                     children))))
+      (if children
+         (format "<%s%s>%s</%s>"
+                 name
+                 (if props
+                     (www-xml-format-props props)
+                   "")
+                 (www-xml-format-list children)
+                 name)
+       (format "<%s%s/>"
+               name (www-xml-format-props props)))
+      )
+     (t
+      (format "%s" format-unit)))))
+
+(defun www-xml-format-list (format-list)
+  (if (atom format-list)
+      (www-xml-format-unit format-list)
+    (mapconcat #'www-xml-format-unit
+              format-list "")))
+
+
 ;;; @ HTML generator
 ;;;