X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=est-format.el;h=1b2703d1e48b461f570510bb6ad73728af1648fb;hb=05ffd00f104110357b6674700ad56a8e4af2ee26;hp=c7a74747bc2354e3ab5f808b39b6bf7b4355b8f6;hpb=064fb21a731624826bc09b70f426f2cf031e7c12;p=chise%2Fest.git

diff --git a/est-format.el b/est-format.el
index c7a7474..1b2703d 100644
--- a/est-format.el
+++ b/est-format.el
@@ -26,94 +26,202 @@
     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 subtype)
     (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 subtype (plist-get props :subtype))
+	  (setq output-string
+		(est-format-list children output-format
+				 without-edit as-property separator subtype))
+	  )
+	 ((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 'omitted)
+	(cond
+	 ((eq output-format 'wiki-text)
+	  (setq output-string "{{...}}")
+	  )
+	 ((and (eq output-format 'html)
+	       (setq object (plist-get props :object))
+	       (setq feature (plist-get props :feature)))
+	  (setq children
+		(list
+		 (list* 'a
+			(list :href
+			      (concat (www-uri-make-object-url object)
+				      (if est-hide-cgi-mode
+					  "/feature="
+					"&feature=")
+				      (www-uri-encode-feature-name feature)))
+			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
 		  (list
-		   (list* 'a
-			  (list :href
-				(www-uri-make-feature-name-url
-				 (www-uri-encode-feature-name feature)
-				 (www-uri-encode-object object)))
-			  children)))))
+		   (list 'span
+			 '(:class "feature-name")
+			 (list* 'a
+				(list :href
+				      (www-uri-make-feature-name-url
+				       (est-object-genre object)
+				       (www-uri-encode-feature-name feature)
+				       (www-uri-encode-object object)))
+				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))
@@ -133,41 +241,75 @@
 		     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)))
+	(setq subtype (plist-get props :subtype))
+	(if children
+	    (cond
+	     ((eq output-format 'plain-text)
+	      (est-format-list children output-format as-property separator
+			       subtype)
+	      )
+	     ((eq subtype 'unordered-list)
+	      (format "<ul\n%s><li\n>%s</li></ul\n>"
+		      (if props
+			  (est-format-props props)
+			"")
+		      (est-format-list
+		       children output-format
+		       without-edit as-property "</li\n><li\n>")
+		      )
+	      
+	      )
+	     (t
+	      (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
-			separator)
-  (if (atom format-list)
-      (est-format-unit
-       format-list without-tags without-edit as-property separator)
+			&optional output-format without-edit as-property
+			separator subtype)
+  (cond
+   ((atom format-list)
+    (est-format-unit
+     format-list output-format without-edit as-property separator)
+    )
+   ((eq subtype 'unordered-list)
+    (concat "<ul\n><li>"
+	    (mapconcat (lambda (unit)
+			 (est-format-unit
+			  unit output-format without-edit as-property separator))
+		       format-list "</li\n><li>")
+	    "</li\n></ul\n>")
+    )
+   (t
     (mapconcat (lambda (unit)
 		 (est-format-unit
-		  unit without-tags without-edit as-property separator))
-	       format-list separator)))
+		  unit output-format without-edit as-property))
+	       format-list separator)
+    )))
 
 
 ;;; @ End.