Index: cells-gtk/dialogs.lisp
===================================================================
RCS file: /project/cells-gtk/cvsroot/root/cells-gtk/dialogs.lisp,v
retrieving revision 1.7
diff -u -r1.7 dialogs.lisp
--- cells-gtk/dialogs.lisp	7 Jun 2006 16:35:03 -0000	1.7
+++ cells-gtk/dialogs.lisp	4 Aug 2006 12:03:29 -0000
@@ -18,8 +18,38 @@
 
 (in-package :cgtk)
 
+(def-widget dialog (window)
+  ((content-area :accessor content-area :initarg :content-area :initform nil)
+   (fn-response :accessor fn-response :initarg :fn-response :initform  (lambda (self response) (declare (ignore self)) response))
+   (buttons :accessor buttons :initarg :buttons :initform nil)
+   (buttons-id :accessor buttons-id :initarg :buttons-id :initform (c-in nil)))
+  (markup)
+  ()
+  :position :mouse
+  :new-args nil)
 
-(def-widget message-dialog (window)
+(defmethod md-awaken :after ((self dialog))
+  (let ((response (gtk-dialog-run (id self))))
+    (funcall (fn-response self) self response))
+  (gtk-widget-destroy (id self))
+  (gtk-object-forget (id self) self)
+  (with-slots (content-area) self
+    (when content-area 
+      (setf (md-value self) (md-value content-area))
+      (gtk-object-forget (id content-area) content-area))))
+
+(def-c-output content-area ((self dialog))
+  (when new-value
+    (to-be new-value)
+    (let ((vbox (gtk-adds-dialog-vbox (id self))))
+        (gtk-box-pack-start vbox (id new-value) nil nil 5))))
+
+(def-c-output buttons ((self dialog))
+  (when new-value
+    (setf (buttons-id self) (mapcar #'(lambda (b) (gtk-dialog-add-button (id self) (car b) (car (cdr b)))) new-value))))
+
+
+(def-widget message-dialog (dialog)
   ((message :accessor message :initarg :message :initform nil)
    (message-type :accessor message-type :initarg :message-type :initform :info)
    (buttons-type :accessor buttons-type :initarg :buttons-type :initform (c? (if (eql (message-type self) :question)
@@ -29,6 +59,13 @@
   (markup)
   ()
   :position :mouse
+  :fn-response (lambda (self response) (setf (md-value self)
+	  (case response
+	    (-5 :ok)
+	    (-6 :cancel)
+	    (-7 :close)
+	    (-8 :yes)
+	    (-9 :no))))
   :new-args (c? (list +c-null+
 		      2
 		      (ecase (message-type self)
@@ -45,22 +82,6 @@
 			(:ok-cancel 5))
 		      (message self))))
 
-(defmethod md-awaken :after ((self message-dialog))
-  (let ((response (gtk-dialog-run (id self))))
-    (setf (md-value self)
-	  (case response
-	    (-5 :ok)
-	    (-6 :cancel)
-	    (-7 :close)
-	    (-8 :yes)
-	    (-9 :no))))
-  (gtk-widget-destroy (id self))
-  (gtk-object-forget (id self) self)
-  (with-slots (content-area) self
-    (when content-area 
-      (setf (md-value self) (md-value content-area))
-      (gtk-object-forget (id content-area) content-area))))
-	   
 (defun show-message (text &rest inits)
   (let ((message-widget (to-be (apply #'mk-message-dialog :message text inits))))
     (md-value message-widget)))
@@ -71,12 +92,6 @@
   (name)
   ())
 
-(def-c-output content-area ((self message-dialog))
-  (when new-value
-    (to-be new-value)
-    (let ((vbox (gtk-adds-dialog-vbox (id self))))
-        (gtk-box-pack-start vbox (id new-value) nil nil 5))))
-
 (def-c-output mime-types ((self file-filter))
   (dolist (mime-type new-value)
     (gtk-file-filter-add-mime-type (id self) mime-type)))
@@ -119,12 +134,16 @@
   ()
   :new-args (c? (list (action-id self))))
 
-(def-widget file-chooser-dialog (file-chooser window)
+(def-widget file-chooser-dialog (file-chooser dialog)
   ()
   ()
   ()
   :on-selection-changed nil
   :position :mouse
+  :fn-response (lambda (self response) (when (eql response -5)
+      (if (select-multiple self)
+	  (setf (md-value self) (gtk-file-chooser-get-filenames-strs (id self)))
+	  (setf (md-value self) (gtk-file-chooser-get-filename (id self))))))
   :new-args (c? (list (title self) +c-null+ (action-id self)
 		      "gtk-cancel" -6 ;;response-cancel
 		      (format nil "gtk-~a"
@@ -138,15 +157,6 @@
 		      -5  ;;response-ok
 		      +c-null+)))
 
-(defmethod md-awaken :after ((self file-chooser-dialog))
-  (let ((response (gtk-dialog-run (id self))))
-    (when (eql response -5)
-      (if (select-multiple self)
-	  (setf (md-value self) (gtk-file-chooser-get-filenames-strs (id self)))
-	  (setf (md-value self) (gtk-file-chooser-get-filename (id self)))))
-    (gtk-widget-destroy (id self))
-    (gtk-object-forget (id self) self)))
-
 (defun file-chooser (&rest inits)
   (let ((dialog (to-be (apply #'mk-file-chooser-dialog inits))))
     (md-value dialog)))
