(in-package :kira)

(defmacro definput (name lambda-list &body body)
  `(defun ,name ,lambda-list
     (when (and value name (symbolp name) (not (keywordp name)))
       (setf value (funcall name value) name (symbol-name name)))
     ,@body))

(definput text-field (name value &key (type "text") id (size :max) onchange maxlength)
  (html
   ((:input
     :type type
     :name name
     :id (:when id id)
     :style (:when (eq size :max) "width: 100%")
     :size (:if (eq size :max) 50 size)
     :onchange (:when onchange onchange)
     :maxlength (:when maxlength
		  (:if (eq maxlength t)
		       size
		       maxlength))
     :value (:when (or (not (typep value 'sequence)) (plusp (length value)))
	      (:princ-safe value))))))

(definput checkbox (name value label &key (id (gensym)) option key)
  (html
   ((:input
     :type "checkbox"
     :id (:when id id)
     :name name
     :value (:princ-safe (or (and option (if key (funcall key option) option)) t))
     :checked (:when (if option (containsp value option) value) t)))
   (:when (and id label)
     " "
     ((:label :for id) label))))

(definput radio-button (name value label &key (id (gensym)) option key)
  (html
   ((:input
     :type "radio"
     :id (:when id id)
     :name name
     :value (:princ-safe (if key (funcall key option) option))
     :checked (:when (equal value option) t)))
   (:when (and id label)
     " "
     ((:label :for id) label))))

(definput menu-field (name value buttons &key multiple compact)
  (let ((fn (if multiple #'checkbox #'radio-button)))
    (html
     (loop with firstp = t
	   for (button . rest) on buttons
	   for option = (if (consp button) (first button) button)
	   for label = (if (consp button) (second button) button)
	   do (html
	       (cond
		 (firstp (setf firstp nil))
		 (compact (html " "))
		 (t (html (:br))))
	       (funcall
		fn
		name
		value
		label
		:option option))))))

(definput textarea (name value &key id (width :max) (height :max))
  (html
   ((:textarea
     :id (:when id id)
     :name name
     :style (:when (eq width :max) "width: 100%")
     :cols (:if (eq width :max) 50 width)
     :rows (:if (eq height :max) 20 height))
    (:when (plusp (length value))
      (:princ-safe value +element-escapes+)))))

(definput markup-field (name value &key id (width :max) (height :max) &rest options)
  (ecase (preferred-editor *person*)
    (:fckeditor
     (html
      ((:hidden-field :id name :style "display: none")
       name
       (when (plusp (length value))
	 (escape (html-output (render-markup value)))))
      ((:iframe
	:id (:progn name "___Frame")
	:src (:progn "/FCKeditor/editor/fckeditor.html?InstanceName=" name)
	:width "100%"
	:height (:princ (if (eq height :max) 600 (* height 40)))
	:frameborder "no"
	:scrolling "no"))))
    ((nil)
     (apply #'textarea name value options))))

(definput select-box (name value options &key id onchange)
  (html
   ((:select
     :name name
     :id (:when id id)
     :onchange (:when onchange onchange))
    (loop for option-element in options
	  for option = (if (consp option-element) (first option-element) option-element)
	  for label = (if (consp option-element) (second option-element) option-element)
	  do (html
	      ((:option
		:value option
		:selected (:when (equal value option) t))
	       label))))))

(definput file-field (name value &key id)
  (html
   (:when value
     (:small "[now: " ((:a* :target "_blank") value) "]")
     " ")
   ((:input
     :type "file"
     :name name
     :id (:when id id)
     :size 15))))

(defelement :standard-form html
    (&attributes
     (&rest attributes
      &key
      (action '(:uri-to (request-uri)))
      (method :post)
      (enctype (when (eq method :post) "multipart/form-data"))
      &allow-other-keys)
     &body body)
  `((:form
     ,@(when action `(:action ,action))
     ,@(when method `(:method ,method))
     ,@(when enctype `(:enctype ,enctype))
     ,@(sans attributes :action :method :enctype))
    ,@body))

(defelement :field html (&attributes attributes label &body body)
  `((:p ,@(unless (getf attributes :class) '(:class "field"))
        ,@attributes)
    ((:label :class "field") ,label ":") (:br)
    ,@body))

(defelement :fieldset html (&attributes attributes label &body body)
  `(("fieldset" ,@attributes)
    (:legend ,label)
    ((:div :class "fieldset")
     ,@body)))

(defun submit-button (&optional name label &key confirm onclick)
  (html
   ((:input
     :type "submit"
     :class "button"
     :name (:when name name)
     :value (:if label label (render-title-from-query))
     "onClick" (:when (or confirm onclick)
		 onclick
		 (:when confirm
		   (:format
		    ";return confirm(~a);"
		    (js-quote confirm))))))))