1 (in-package :gtk-examples)
4 (let ((window (make-instance 'gtk-window :type :toplevel :title "Testing dialogs"))
5 (v-box (make-instance 'v-box)))
6 (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit)))
7 (container-add window v-box)
9 (let ((button (make-instance 'button :label "Dialog 1")))
10 (box-pack-start v-box button)
11 (g-signal-connect button "clicked" (lambda (b) (declare (ignore b))
12 (let ((dialog (make-instance 'dialog)))
13 (dialog-add-button dialog "OK" :ok)
14 (dialog-add-button dialog "Yes" :yes)
15 (dialog-add-button dialog "Cancel" :cancel)
16 (setf (dialog-default-response dialog) :cancel)
17 (setf (dialog-alternative-button-order dialog) (list :yes :cancel :ok))
18 (format t "Response was: ~S~%" (dialog-run dialog))
19 (object-destroy dialog)))))
20 (let ((button (make-instance 'button :label "About")))
21 (box-pack-start v-box button)
22 (g-signal-connect button "clicked" (lambda (b) (declare (ignore b))
23 (let ((dialog (make-instance 'about-dialog :program-name "Dialogs examples" :version "0.01" :copyright "(c) Kalyanov Dmitry"
24 :website "http://common-lisp.net/project/cl-gtk+" :website-label "Project web site"
25 :license "LLGPL" :authors '("Kalyanov Dmitry") :documenters '("Kalyanov Dmitry")
27 :logo-icon-name "applications-development" :wrap-license t)))
28 (format t "Response was: ~S~%" (dialog-run dialog))
29 (object-destroy dialog)))))
31 (gtk-widget-show-all window)