(est-format-unit): Change optional argument `without-tags' to
authorMORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Sun, 5 Jun 2011 14:01:46 +0000 (23:01 +0900)
committerMORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Sun, 5 Jun 2011 14:01:46 +0000 (23:01 +0900)
`output-format'; now `output-format' accepts various formats such as
'html, 'plain-text and 'wiki-text instead of nil and non-nil.
(est-format-list): Likewise.

est-format.el

index 7288d8f..116d412 100644 (file)
     dest))
 
 (defun est-format-unit (format-unit
-                       &optional without-tags without-edit as-property
+                       &optional output-format without-edit as-property
                        separator)
-  (let (name props children ret object feature format value)
+  (cond
+   ((or (eq output-format 'without-tags)
+       (eq output-format t))
+    (setq output-format 'plain-text)
+    )
+   ((eq output-format 'wiki-text)
+    )
+   ((eq output-format 'xml)
+    )
+   ((null output-format)
+    (setq output-format 'html)
+    ))
+  (let (name props children ret object feature format value
+            output-string)
     (cond
      ((stringp format-unit)
-      (www-format-encode-string format-unit without-tags (not as-property))
+      (www-format-encode-string format-unit
+                               (not (eq output-format 'html))
+                               (not as-property))
+      )
+     ((characterp format-unit)
+      (www-format-encode-string (format "%S" format-unit)
+                               (not (eq output-format 'html))
+                               (not as-property))
+      )
+     ((symbolp format-unit)
+      (www-format-encode-string (format "%s" format-unit)
+                               (not (eq output-format 'html))
+                               (not as-property))
       )
      ((consp format-unit)
       (setq name (car format-unit)
            props (nth 1 format-unit)
            children (nthcdr 2 format-unit))
       (cond
+       ((eq name 'list)
+       (cond
+        ((or (eq output-format 'plain-text)
+             (eq output-format 'wiki-text))
+         (unless separator
+           (setq separator (plist-get props :separator)))
+         (setq output-string
+               (est-format-list children output-format
+                                without-edit as-property separator))
+         )
+        ((eq output-format 'html)
+         (setq props (list* :class name props)
+               name 'span)
+         ))
+       )
        ((eq name 'object)
-       (setq name 'span)
-       (unless without-tags
+       (cond
+        ((eq output-format 'html)
+         (setq name 'span)
          (when (setq object (plist-get props :object))
            (setq children
                  (list
                   (list* 'a
                          (list :href (www-uri-make-object-url object))
-                         children)))))
+                         children))))
+         )
+        ((eq output-format 'wiki-text)
+         (when (setq object (plist-get props :object))
+           (setq output-string
+                 (format "[[%s=%s]]"
+                         (est-object-genre object)
+                         (est-format-object object))))
+         ))
        )
        ((eq name 'prev-char)
-       (when (and (not without-tags)
-                  (setq object (plist-get props :object))
-                  (setq feature (plist-get props :feature))
-                  (setq value (www-get-feature-value object feature))
-                  (setq ret (find-previous-defined-code-point feature value)))
+       (cond
+        ((eq output-format 'wiki-text)
+         (setq output-string "{{prev-char}}")
+         )
+        ((and (eq output-format 'html)
+              (setq object (plist-get props :object))
+              (setq feature (plist-get props :feature))
+              (setq value (www-get-feature-value object feature))
+              (setq ret (find-previous-defined-code-point feature value)))
          (setq children
                (list
                 (list* 'a
                        (list :href (www-uri-make-object-url ret))
-                       children))))
+                       children)))
+         ))
        )
        ((eq name 'next-char)
-       (when (and (not without-tags)
-                  (setq object (plist-get props :object))
-                  (setq feature (plist-get props :feature))
-                  (setq value (www-get-feature-value object feature))
-                  (setq ret (find-next-defined-code-point feature value)))
+       (cond
+        ((eq output-format 'wiki-text)
+         (setq output-string "{{next-char}}")
+         )
+        ((and (eq output-format 'html)
+              (setq object (plist-get props :object))
+              (setq feature (plist-get props :feature))
+              (setq value (www-get-feature-value object feature))
+              (setq ret (find-next-defined-code-point feature value)))
          (setq children
                (list
                 (list* 'a
                        (list :href (www-uri-make-object-url ret))
-                       children))))
+                       children)))
+         ))
        )
        ((eq name 'feature-name)
        (setq name 'span)
-       (unless without-tags
+       (when (eq output-format 'html)
          (when (and (setq object (plist-get props :object))
                     (setq feature (plist-get props :feature)))
            (setq children
                          children)))))
        )
        ((eq name 'value)
-       (setq format
-             (if (consp (car children))
-                 (caar children)))
-       (unless without-edit
-         (setq children
-               (append children
-                       (list (list 'edit-value
-                                   (if format
-                                       (list* :format format props)
-                                     props)
-                                   '(input
-                                     (:type "submit" :value "edit")))))))
-       (unless without-tags
+       (cond
+        ((eq output-format 'wiki-text)
+         (setq output-string
+               (if (and (setq object (plist-get props :object))
+                        (setq feature (plist-get props :feature)))
+                   (format "{{value %s %s=%s}}"
+                           feature
+                           (est-object-genre object)
+                           (www-uri-encode-object object))
+                 "{{value}}"))
+         )
+        ((eq output-format 'html)
+         (setq format
+               (if (consp (car children))
+                   (caar children)))
+         (unless without-edit
+           (setq children
+                 (append children
+                         (list (list 'edit-value
+                                     (if format
+                                         (list* :format format props)
+                                       props)
+                                     '(input
+                                       (:type "submit" :value "edit")))))))
          (setq name 'span
-               props (list* :class "value" props)))
+               props (list* :class "value" props))
+         ))
        )
-       ((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)))
-       (unless without-tags
+       ((or (and (eq name 'link)
+                (setq ret (plist-get props :ref)))
+           (and (eq name 'a)
+                (setq ret (plist-get props :href))))
+       (cond
+        ((eq output-format 'wiki-text)
+         (setq output-string
+               (format "[[%s|%s]]"
+                       (est-format-list children output-format)
+                       (est-format-unit ret output-format)
+                       ))
+         )
+        ((eq output-format 'html)
          (setq name 'a
                props (list* :href ret
-                            (plist-remprop (copy-list props) :ref))))
+                            (plist-remprop (copy-list props) :ref)))
+         )
+        ((eq output-format 'xml)
+         (unless (stringp ret)
+           (setq props (plist-remprop (copy-list props) :ref))
+           (setq children
+                 (cons (list 'ref nil ret)
+                       children)))
+         ))
        )
        ((and (eq name 'edit-value)
             (setq object (plist-get props :object))
        ((memq name '(div
                     a ul ol p
                     span
-                    img
                     input))
        )
        (t
-       (unless without-tags
+       (when (eq output-format 'html)
          (setq props (list* :class name props)
                name 'span))
        ))
-      (unless separator
-       (setq separator (plist-get props :separator)))
-      (if children
-         (if without-tags
-             (est-format-list children without-tags as-property separator)
-           (format "<%s%s>%s</%s>"
-                   name
-                   (if props
-                       (est-format-props props)
-                     "")
-                   (est-format-list
-                    children nil without-edit as-property separator)
-                   name))
-       (if without-tags
-           ""
-         (format "<%s%s/>"
-                 name (est-format-props props))))
+      (cond
+       (output-string)
+       (t
+       (unless separator
+         (setq separator (plist-get props :separator)))
+       (if children
+           (if (eq output-format 'plain-text)
+               (est-format-list children output-format as-property separator)
+             (format "<%s%s>%s</%s>"
+                     name
+                     (if props
+                         (est-format-props props)
+                       "")
+                     (est-format-list
+                      children output-format
+                      without-edit as-property separator)
+                     name))
+         (if (eq output-format 'plain-text)
+             ""
+           (format "<%s%s/>"
+                   name (est-format-props props))))
+       ))
       )
      (t
       (format "%s" format-unit)))))
 
 (defun est-format-list (format-list
-                       &optional without-tags without-edit as-property
+                       &optional output-format without-edit as-property
                        separator)
   (if (atom format-list)
       (est-format-unit
-       format-list without-tags without-edit as-property separator)
+       format-list output-format without-edit as-property separator)
     (mapconcat (lambda (unit)
                 (est-format-unit
-                 unit without-tags without-edit as-property separator))
+                 unit output-format without-edit as-property separator))
               format-list separator)))