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
)) (leave-gtk-main)))
7 (container-add window v-box
)
8 (let ((button (make-instance 'button
:label
"Dialog 1")))
9 (box-pack-start v-box button
)
10 (g-signal-connect button
"clicked" (lambda (b) (declare (ignore b
))
11 (let ((dialog (make-instance 'dialog
)))
12 (dialog-add-button dialog
"OK" :ok
)
13 (dialog-add-button dialog
"Yes" :yes
)
14 (dialog-add-button dialog
"Cancel" :cancel
)
15 (setf (dialog-default-response dialog
) :cancel
)
16 (set-dialog-alternative-button-order dialog
(list :yes
:cancel
:ok
))
17 (format t
"Response was: ~S~%" (dialog-run dialog
))
18 (object-destroy dialog
)))))
19 (let ((button (make-instance 'button
:label
"About")))
20 (box-pack-start v-box button
)
21 (g-signal-connect button
"clicked" (lambda (b) (declare (ignore b
))
22 (let ((dialog (make-instance 'about-dialog
:program-name
"Dialogs examples" :version
"0.01" :copyright
"(c) Kalyanov Dmitry"
23 :website
"http://common-lisp.net/project/cl-gtk+" :website-label
"Project web site"
24 :license
"LLGPL" :authors
'("Kalyanov Dmitry") :documenters
'("Kalyanov Dmitry")
26 :logo-icon-name
"applications-development" :wrap-license t
)))
27 (format t
"Response was: ~S~%" (dialog-run dialog
))
28 (object-destroy dialog
)))))
