;; -*- coding: utf-8-mcs-er -*-
(require 'cwiki-common)


;;; @ XML generator
;;;

(defun est-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
		    (format "%s"
			    (est-format-unit val 'without-tags
					     'without-edit 'as-property))
		    )))
    dest))

(defun est-format-unit (format-unit
			&optional output-format without-edit as-property
			separator)
  (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
				(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
       ((or (eq name 'list)
	    (eq name 'image-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)
	(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))))
	  )
	 ((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)
	(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)))
	  ))
	)
       ((eq name 'next-char)
	(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)))
	  ))
	)
       ((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)
	(when (eq output-format 'html)
	  (when (and (setq object (plist-get props :object))
		     (setq feature (plist-get props :feature)))
	    (setq children
		  (list
		   (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)
	(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))
	  ))
	)
       ((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)))
	  )
	 ((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))
	     (setq feature (plist-get props :feature)))
	(setq format (or (plist-get props :format) 'default))
	(setq name 'a
	      props (list :href (format "%s?%s=%s&feature=%s&format=%s"
					chise-wiki-edit-url
					(est-object-genre object)
					(www-uri-encode-object object)
					(www-uri-encode-feature-name feature)
					format)))
	)
       ((memq name '(div
		     a ul ol p
		     span
		     input img))
	)
       (t
	(when (eq output-format 'html)
	  (setq props (list* :class name props)
		name 'span))
	))
      (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 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 output-format without-edit as-property))
	       format-list separator)
    )))


;;; @ End.
;;;

(provide 'est-format)

;;; est-format.el ends here