(in-package :gui-goodies)

(cl-syntax:use-syntax 'gui-utils:nodgui-color-syntax)

(defparameter *toplevel* gui:*tk*)

(defparameter *gui-server* nil)

(defparameter *main-frame* nil)

(a:define-constant +font-h1+       "sans 20 bold" :test #'string=)

(a:define-constant +font-h2+       "sans 15 bold" :test #'string=)

(a:define-constant +font-h3+       "bold"         :test #'string=)

(defgeneric parse-color (object))

(defmethod parse-color ((object symbol))
  (parse-color (string-downcase (symbol-name object))))

(defmethod parse-color ((object string))
  (nodgui.utils:rgb->tk (cl-colors2:as-rgb object)))

(defmethod parse-color ((object number))
  (nodgui.utils:rgb->tk (cl-colors2:as-rgb object)))

(defun make-font (font-name font-size font-weight font-slant underline)
  (gui:font-create (nodgui.utils:create-name)
                   :family     font-name
                   :size       font-size
                   :weight     font-weight
                   :slant      font-slant
                   :underline  underline
                   :overstrike nil))

(defun gui-resize-grid-all (w)
  (gui:grid-columnconfigure w :all :weight 1)
  (gui:grid-rowconfigure    w :all :weight 1))

(defun confirm-deletion (parent how-many)
  (gui:ask-yesno (format nil (n_ "~a element will be deleted; continue?"
                                 "~a elements will be deleted; continue?"
                                 how-many)
                         how-many)
                 :title  (_ "Confirm operation")
                 :parent parent))

(defun info-operation-completed (parent)
  (gui:message-box (_ "Operation completed") (_ "information") :ok "info" :parent parent))

(defun info-dialog (parent message &key (title (_ "Information")))
  (gui:message-box message title :ok "info" :parent parent))

(defun error-dialog (parent message &key (title (_ "Error")))
  (gui:message-box message title :ok "error" :parent parent))

(defun re-validate (parent datum regex error-message)
  (let* ((validator (make-instance 'validation:regexp-validator
                                   :error-message error-message
                                   :regexp        regex))
         (passedp   (validation:validate validator datum)))
    (if (not passedp)
        (progn
          (error-dialog parent error-message)
          nil)
        t)))

(defmacro with-re-validate ((parent &rest filters) &body body)
  "each filter is -> '(datum regexp error-message)"
  `(and ,@(loop for filter in filters collect
               `(apply #'re-validate (list ,parent ,@filter)))
        ,@body))

(defmacro with-entry-text-validate ((parent &rest filters) &body body)
  "filtrers -> '(entry-widget regex error-message)"
  `(with-re-validate (,parent ,@(loop for filter in filters collect
                                     `((text ,(elt filter 0))
                                       ,(elt filter 1)
                                       ,(elt filter 2))))
        ,@body))

(defun attach-tooltip (widget tootltip-message)
  (let ((tooltip (make-instance 'nodgui.mw:tooltip
                                :borderwidth 1
                                :relief      :solid)))
      (nodgui.mw:register-tooltip tooltip widget tootltip-message)))

(defmacro attach-tooltips (&rest widget-text)
  `(progn
     ,@(loop for i in widget-text collect
            `(attach-tooltip ,(first i) ,(second i)))))

(defmacro with-busy* ((root-widget) &body body)
  `(progn
     (with-busy (,root-widget)
       (with-hourglass ,(list root-widget)
         ,@body))))

(defun password-dialog (parent title message &key (button-message "OK"))
  (let ((res nil))
    (gui:with-modal-toplevel (toplevel :title title)
      (gui:transient toplevel parent)
      (let* ((widget    (make-instance 'gui-mw:password-entry
                                       :show-password nil
                                       :master        toplevel))
             (label     (make-instance 'gui:label
                                       :master toplevel
                                       :text   message))
             (ok-button (make-instance 'gui:button
                                       :text   button-message
                                       :master toplevel
                                       :command (lambda ()
                                                  (setf res (gui-mw:secret-string widget))
                                                  (gui:break-mainloop)))))
        (gui:grid label     0 0 :sticky :news)
        (gui:grid widget    1 0 :sticky :news)
        (gui:grid ok-button 1 1 :sticky :news)))
    res))