Question standard dialog

mmontone · Dec 3, 2013 · 5cf558f · 5cf558f
1 parent f861deb
commit 5cf558f
Show file tree

Hide file tree

Showing 3 changed files with 26 additions and 4 deletions.
diff --git a/src/events.lisp b/src/events.lisp
@@ -132,6 +132,25 @@
 		,features
 		,@args))
 
+(defun ask (question &key (name "Question")
+		       on-accept
+		       on-cancel)
+  (with-open-dialog (name
+		     '(:modal "yes"
+		       :resizable "no"))
+    (<:dialog
+      (<:id= "question")
+      (<:title= name)
+      (<:buttons= "accept, cancel")
+      (<: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))))))
+
 (defun open-window (window &optional features &rest args)
   (let ((window-element (with-xul (funcall window))))
     (flet ((serialize-features (features)

diff --git a/src/package.lisp b/src/package.lisp
@@ -23,7 +23,8 @@
 	   #:open-window
 	   #:with-open-window
 	   #:open-dialog
-	   #:with-open-dialog))
+	   #:with-open-dialog
+	   #:ask))
 
 (defpackage xul-builder
   (:nicknames :<)

diff --git a/test/showcase/dialogs.lisp b/test/showcase/dialogs.lisp
@@ -6,7 +6,7 @@
 	   (<:vbox 
 	     (<:button (<:label= "Open dialog")
 		       (<:on-command=
-			(xul::with-open-dialog
+			(with-open-dialog
 			    ("Dialog test"
 			     '(:modal "yes"
 			       :resizable "no"))
@@ -20,17 +20,19 @@
 			      (<:description "This is a dialog"))))))
 	     (<:button (<:label= "Open component in dialog")
 		       (<:on-command=
-			(xul::with-open-dialog ("Component in dialog"
+			(with-open-dialog ("Component in dialog"
 						'(:modal "yes"
 						  :resizable "no"))
 			  (<:dialog
 			    (<:id= "componentindialog")
 			    (<:title= "Component in dialog")
 			    (<:buttons= "accept")
 			    (render (make-instance 'my-dialog))))))
+	     (<:button (<:label= "Ask")
+		       (<:on-command= (ask "Are you sure?")))			
 	     (<:button (<:label= "Open component in window")
 		       (<:on-command=
-			(xul::with-open-window ()
+			(with-open-window ()
 			  (<:window
 			    (<:id= "componentinwindow")
 			    (<:title= "Component in window")