[lgtk-cvs] CVS update: lgtk/examples/dialog.lisp

Mario Mommer mmommer at common-lisp.net
Mon Nov 10 21:45:24 UTC 2003


Update of /project/lgtk/cvsroot/lgtk/examples
In directory common-lisp.net:/tmp/cvs-serv20662

Modified Files:
	dialog.lisp 
Log Message:
The dialog example is now complete.

Date: Mon Nov 10 16:45:24 2003
Author: mmommer

Index: lgtk/examples/dialog.lisp
diff -u lgtk/examples/dialog.lisp:1.1 lgtk/examples/dialog.lisp:1.2
--- lgtk/examples/dialog.lisp:1.1	Wed Nov  5 16:19:42 2003
+++ lgtk/examples/dialog.lisp	Mon Nov 10 16:45:23 2003
@@ -3,35 +3,39 @@
 (use-package :gtk)
 
 (defun dialog ()
-  (let ((dialog (gtk-dialog-new))
-	(button1 (gtk-button-new-with-label "Ok..."))
-	(button2 (gtk-button-new-with-label "Well..."))
-	(button3 (gtk-button-new-with-label "Ehm..."))
-	(frame (gtk-frame-new "I want your opinion:"))
-	(label (gtk-label-new "Aren't dialogs cool?")))
-
-    (gtk-box-pack-start
-     (gtkdialog-action_area dialog)
-     button1)
-
-    (gtk-box-pack-start
-     (gtkdialog-action_area dialog)
-     button2)
-
-    (gtk-box-pack-start
-     (gtkdialog-action_area dialog)
-     button3)
-
-    (gtk-box-pack-start
-     (gtkdialog-vbox dialog)
-     frame)
-
-    (gtk-container-add
-      frame label)
+  (labels ((its-over (&rest args) (declare (ignore args))
+		     (gtk-main-quit)))
+    (let ((dialog (gtk-dialog-new))
+	  (frame (gtk-frame-new "I want your opinion:"))
+	  (label (gtk-label-new "Aren't dialogs cool?"))
+	  (button1 (gtk-button-new-with-label "Ok..."))
+	  (button2 (gtk-button-new-with-label "Well..."))
+	  (button3 (gtk-button-new-with-label "Ehm...")))
+
+      (gtk-box-pack-start
+       (gtkdialog-action-area dialog)
+       button1)
+
+      (gtk-box-pack-start
+       (gtkdialog-action-area dialog)
+       button2)
+
+      (gtk-box-pack-start
+       (gtkdialog-action-area dialog)
+       button3)
+
+      (gtk-box-pack-start
+       (gtkdialog-vbox dialog)
+       frame)
+    
+      (gtk-container-add
+       frame label)
 
-    (gtk-container-set-border-width frame 10)
-    (gtk-widget-set-size-request label 30 30)
+      (gtk-container-set-border-width frame 10)
+      (gtk-widget-set-size-request label 30 30)
 
-    (gtk-widget-show-all dialog)
+      (g-signal-connect dialog gtkdestroy #'its-over)
 
-    (gtk-main)))
\ No newline at end of file
+      (gtk-widget-show-all dialog)
+
+      (gtk-main))))
\ No newline at end of file





More information about the Lgtk-cvs mailing list