gtk/gtk.dialog.example.lisp

   1 (in-package :gtk-examples)
   2
   3 (defun test-dialog ()
   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                                                    (setf (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")
  25                                                                               :artists '("None")
  26                                                                               :logo-icon-name "applications-development" :wrap-license t)))
  27                                                    (format t "Response was: ~S~%" (dialog-run dialog))
  28                                                    (object-destroy dialog)))))
  29
  30     (widget-show window)
  31     (ensure-gtk-main)))