diff --git a/resources/icons/dialog-important-2.png b/resources/icons/dialog-important-2.png new file mode 100644 index 0000000..19ab7c9 Binary files /dev/null and b/resources/icons/dialog-important-2.png differ diff --git a/src/events.lisp b/src/events.lisp index 66d7aea..3bd0a36 100644 --- a/src/events.lisp +++ b/src/events.lisp @@ -132,9 +132,26 @@ ,features ,@args)) +(defparameter *icons* (list + :question "dialog-question-2.png" + :important "dialog-important-2.png" + :ok "dialog-ok-3.png" + :information "dialog-information.png" + :warning "dialog-warning-2.png")) + +(defun icon-path (id) + (let ((pathname (or (getf *icons* id) + (error "Icon not found: ~A" id)))) + (or + (probe-file + (asdf:system-relative-pathname :cl-xul + (format nil "resources/icons/~A" pathname))) + (error "Icon file path not found: ~A" pathname)))) + (defun ask (question &key (name "Question") on-accept - on-cancel) + on-cancel + (icon :question)) (with-open-dialog (name '(:modal "yes" :resizable "no")) @@ -145,11 +162,60 @@ (<:ondialogaccept= on-accept) (<:ondialogcancel= on-cancel) (<:hbox (<:flex= 1) - (<:hbox (<:align= :center) - (<:flex= 1) - (<:image (src= (asdf:system-relative-pathname :cl-xul "resources/icons/dialog-question-2.png")))) - (<:hbox (<:flex= 1) (<:align= :center) - (<:description question)))))) + (when icon + (<:hbox (<:align= :center) + (<:flex= 1) + (<:image (src= (icon-path icon))))) + (<:hbox (<:flex= 1) (<:align= :center) + (<:description question)))))) + +(defun prompt (message + &key (name "Prompt") + on-accept + on-cancel + (icon :ok) + (value nil)) + (with-open-dialog (name + '(:modal "yes" + :resizable "no")) + (let ((value value)) + (<:dialog + (<:id= "prompt") + (<:title= name) + (<:buttons= "accept, cancel") + (<:ondialogaccept= (lambda () + (funcall on-accept value))) + (<:ondialogcancel= on-cancel) + (<:hbox (<:flex= 1) + (when icon + (<:hbox (<:align= :center) + (<:flex= 1) + (<:image (src= (icon-path icon))))) + (<:vbox + (<:hbox (<:flex= 1) (<:align= :center) + (<:description message)) + (<:hbox (<:flex= 1) + (<:text-box (on-change=* (val) (setf value val)) + (when value (<:value= value)))))))))) + +(defun inform (message &key (name "Information") + on-accept + (icon :information)) + (with-open-dialog (name + '(:modal "yes" + :resizable "no")) + (<:dialog + (<:id= "information") + (<:title= name) + (<:buttons= "accept") + (<:ondialogaccept= on-accept) + (<:hbox (<:flex= 1) + (when icon + (<:hbox (<:align= :center) + (<:flex= 1) + (<:image (src= (icon-path icon))))) + (<:hbox (<:flex= 1) (<:align= :center) + (<:description message)))))) (defun open-window (window &optional features &rest args) (let ((window-element (with-xul (funcall window)))) diff --git a/src/package.lisp b/src/package.lisp index 79c7951..5292810 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -24,7 +24,9 @@ #:with-open-window #:open-dialog #:with-open-dialog - #:ask)) + #:ask + #:prompt + #:inform)) (defpackage xul-builder (:nicknames :<) diff --git a/test/showcase/dialogs.lisp b/test/showcase/dialogs.lisp index 7331e85..39cc773 100644 --- a/test/showcase/dialogs.lisp +++ b/test/showcase/dialogs.lisp @@ -29,7 +29,13 @@ (<:buttons= "accept") (render (make-instance 'my-dialog)))))) (<:button (<:label= "Ask") - (<:on-command= (ask "Are you sure?"))) + (<:on-command= (ask "Are you sure?"))) + (<:button (<:label= "Prompt") + (<:on-command= (prompt "What is your name?" + :on-accept (lambda (name) + (inform (format nil "Your name is ~A" name)))))) + (<:button (<:label= "Inform") + (<:on-command= (inform "This is information"))) (<:button (<:label= "Open component in window") (<:on-command= (with-open-window ()