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

(defun est-format-unit (format-unit
			&optional without-tags without-edit as-property
			separator)
  (let (name props children ret object feature format value)
    (cond
     ((stringp format-unit)
      (www-format-encode-string format-unit without-tags (not as-property))
      )
     ((consp format-unit)
      (setq name (car format-unit)
	    props (nth 1 format-unit)
	    children (nthcdr 2 format-unit))
      (cond
       ((eq name 'object)
	(setq name 'span)
	(unless without-tags
	  (when (setq object (plist-get props :object))
	    (setq children
		  (list
		   (list* 'a
			  (list :href (www-uri-make-object-url object))
			  children)))))
	)
       ((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)))
	  (setq children
		(list
		 (list* 'a
			(list :href (www-uri-make-object-url ret))
			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)))
	  (setq children
		(list
		 (list* 'a
			(list :href (www-uri-make-object-url ret))
			children))))
	)
       ((eq name 'feature-name)
	(setq name 'span)
	(unless without-tags
	  (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)))))
	)
       ((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
	  (setq name 'span
		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
	  (setq name 'a
		props (list* :href ret
			     (plist-remprop (copy-list props) :ref))))
	)
       ((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))
	)
       (t
	(unless without-tags
	  (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))))
      )
     (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)
    (mapconcat (lambda (unit)
		 (est-format-unit
		  unit without-tags without-edit as-property separator))
	       format-list separator)))


;;; @ End.
;;;

(provide 'est-format)

;;; est-format.el ends here