X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=gtk%2Fgtk.dialog.lisp;h=f4ea8db1e309a41523810540b2e5378430cac08b;hb=9af0a44db2b9491749a7936c782c3d7ff1b804a3;hp=6f92abee9d670522e19824dac04d26876d8ae0f6;hpb=0d03b82a77743d2ea5ef69bea08735fa12857d92;p=cl-gtk2.git

diff --git a/gtk/gtk.dialog.lisp b/gtk/gtk.dialog.lisp
index 6f92abe..f4ea8db 100644
--- a/gtk/gtk.dialog.lisp
+++ b/gtk/gtk.dialog.lisp
@@ -90,3 +90,16 @@
 
 (export 'dialog-alternative-button-order)
 
+(defmacro with-gtk-message-error-handler (&body body)
+  (let ((dialog (gensym))
+        (e (gensym)))
+    `(handler-case
+         (progn ,@body)
+       (error (,e) (using* ((,dialog (make-instance 'message-dialog 
+                                                    :message-type :error :buttons :ok
+                                                    :text (format nil "Error~%~A~%during execution of~%~A" ,e '(progn ,@body)))))
+                           (dialog-run ,dialog)
+                           (object-destroy ,dialog)
+                           nil)))))
+
+(export 'with-gtk-message-error-handler)
\ No newline at end of file