From: Dmitry Kalyanov Date: Mon, 25 Jan 2010 02:23:19 +0000 (+0300) Subject: Improved gtk-demo: ensure that leave-gtk-main is called; use show-message instead... X-Git-Url: http://repo.macrolet.net/gitweb/?p=cl-gtk2.git;a=commitdiff_plain;h=586cdfb30c25058e139fff0484af8761f8735746 Improved gtk-demo: ensure that leave-gtk-main is called; use show-message instead of format --- diff --git a/gtk/gtk.demo.lisp b/gtk/gtk.demo.lisp index e514969..a838460 100644 --- a/gtk/gtk.demo.lisp +++ b/gtk/gtk.demo.lisp @@ -500,7 +500,7 @@ 0))))) (connect-signal tv "row-activated" (lambda (tv path column) (declare (ignore tv column)) - (format t "You clicked on row ~A~%" (tree-path-indices path)))) + (show-message (format nil "You clicked on row ~A" (tree-path-indices path))))) (container-add window v-box) (box-pack-start v-box h-box :expand nil) (box-pack-start h-box title-entry :expand nil) @@ -553,7 +553,7 @@ 0))))) (connect-signal combo-box "changed" (lambda (c) (declare (ignore c)) - (format t "You clicked on row ~A~%" (combo-box-active combo-box)))) + (show-message (format nil "You clicked on row ~A~%" (combo-box-active combo-box))))) (container-add window v-box) (box-pack-start v-box h-box :expand nil) (box-pack-start h-box title-entry :expand nil) @@ -614,7 +614,7 @@ (connect-signal window "destroy" (lambda (w) (declare (ignore w)) (leave-gtk-main))) (connect-signal button "color-set" (lambda (b) (declare (ignore b)) - (format t "Chose color ~A~%" (color-button-color button)))) + (show-message (format nil "Chose color ~A" (color-button-color button))))) (container-add window button) (widget-show window)))) @@ -863,7 +863,7 @@ (defun demo-class-browser () "Show slots of a given class" (let ((output *standard-output*)) - (with-main-loop + (within-main-loop (let* ((window (make-instance 'gtk-window :window-position :center :title "Class Browser" @@ -908,6 +908,7 @@ (class (find-class class-name))) (display-class-slots class))))) (connect-signal search-button "clicked" #'on-search-clicked)) + (connect-signal window "destroy" (lambda (w) (declare (ignore w)) (leave-gtk-main))) (widget-show window))))) (defun make-tree-from-sexp (l) @@ -940,7 +941,7 @@ (tree-view-tooltip-column tree-view) 0) (connect-signal tree-view "row-activated" (lambda (tv path column) (declare (ignore tv column)) - (format t "You clicked on row ~A~%" (tree-path-indices path)))) + (show-message (format nil "You clicked on row ~A" (tree-path-indices path))))) (connect-signal button "clicked" (lambda (b) (declare (ignore b)) (let ((object (read-from-string (entry-text entry)))) @@ -968,6 +969,7 @@ (tree-view-append-column tree-view column) (print (tree-view-column-tree-view column)) (print (tree-view-column-cell-renderers column))) + (connect-signal window "destroy" (lambda (w) (declare (ignore w)) (leave-gtk-main))) (widget-show window)))) (defclass custom-window (gtk-window) @@ -999,6 +1001,7 @@ "Simple test of non-GObject subclass of GtkWindow" (within-main-loop (let ((w (make-instance 'custom-window))) + (connect-signal w "destroy" (lambda (w) (declare (ignore w)) (leave-gtk-main))) (widget-show w)))) (defun test-assistant () @@ -1031,14 +1034,15 @@ (let ((w (make-instance 'label :label "A label in action area"))) (widget-show w) (assistant-add-action-widget d w)) + (connect-signal d "destroy" (lambda (w) (declare (ignore w)) (leave-gtk-main))) (connect-signal d "cancel" (lambda (assistant) (declare (ignore assistant)) (object-destroy d) - (format output "Canceled~%"))) + (show-message "Canceled"))) (connect-signal d "close" (lambda (assistant) (declare (ignore assistant)) (object-destroy d) - (format output "Thank you, ~A~%" (entry-text entry)))) + (show-message (format nil "Thank you, ~A!" (entry-text entry))))) (connect-signal d "prepare" (lambda (assistant page-widget) (declare (ignore assistant page-widget)) (format output "Assistant ~A has ~A pages and is on ~Ath page~%" @@ -1062,6 +1066,7 @@ (e (make-instance 'entry :completion completion))) (setf (entry-completion-text-column completion) 0) (container-add w e)) + (connect-signal w "destroy" (lambda (w) (declare (ignore w)) (leave-gtk-main))) (widget-show w)))) (defun test-ui-markup () @@ -1093,6 +1098,7 @@ (label :label "2 x 1") :left 0 :right 2 :top 0 :bottom 1 (label :label "1 x 1") :left 0 :right 1 :top 1 :bottom 2 (label :label "1 x 1") :left 1 :right 2 :top 1 :bottom 2))) + (connect-signal w "destroy" (lambda (w) (declare (ignore w)) (leave-gtk-main))) (connect-signal btn "clicked" (lambda (b) (declare (ignore b)) @@ -1142,6 +1148,7 @@ :buttons :ok))) (dialog-run dialog) (object-destroy dialog))))) + (connect-signal w "destroy" (lambda (w) (declare (ignore w)) (leave-gtk-main))) (widget-show w)))) (defun test-tree-store () @@ -1190,6 +1197,7 @@ :buttons :ok))) (dialog-run dialog) (object-destroy dialog))))) + (connect-signal w "destroy" (lambda (w) (declare (ignore w)) (leave-gtk-main))) (widget-show w)))) (defun test-gdk-expose (gdk-window) @@ -1234,9 +1242,6 @@ (connect-signal window "destroy" (lambda (widget) (declare (ignore widget)) (leave-gtk-main))) - (connect-signal window "destroy" (lambda (widget) - (declare (ignore widget)) - (leave-gtk-main))) (connect-signal window "expose-event" (lambda (widget event) (declare (ignore widget event))