mirror of https://codeberg.org/cage/tinmop/
73 lines
2.7 KiB
Common Lisp
73 lines
2.7 KiB
Common Lisp
(in-package :gui-goodies)
|
|
|
|
(cl-syntax:use-syntax 'gui-utils:nodgui-color-syntax)
|
|
|
|
(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=)
|
|
|
|
(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 text)
|
|
(let ((tooltip (make-instance 'nodgui.mw:tooltip
|
|
:borderwidth 1
|
|
:relief :solid)))
|
|
(nodgui.mw:register-tooltip tooltip widget text)))
|
|
|
|
(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))))
|