projects
/
cl-gtk2.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
abaf786
)
Improved gtk-demo: ensure that leave-gtk-main is called; use show-message instead...
author
Dmitry Kalyanov
<Kalyanov.Dmitry@gmail.com>
Mon, 25 Jan 2010 02:23:19 +0000
(
05:23
+0300)
committer
Dmitry Kalyanov
<Kalyanov.Dmitry@gmail.com>
Mon, 25 Jan 2010 02:23:19 +0000
(
05:23
+0300)
gtk/gtk.demo.lisp
patch
|
blob
|
history
diff --git
a/gtk/gtk.demo.lisp
b/gtk/gtk.demo.lisp
index
e514969
..
a838460
100644
(file)
--- 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))
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)
(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))
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)
(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))
(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))))
(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*))
(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"
(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))
(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)
(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))
(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))))
(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)))
(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)
(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)))
"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 ()
(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))
(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)
(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)
(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~%"
(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))
(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 ()
(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)))
(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))
(connect-signal btn "clicked"
(lambda (b)
(declare (ignore b))
@@
-1142,6
+1148,7
@@
:buttons :ok)))
(dialog-run dialog)
(object-destroy dialog)))))
: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 ()
(widget-show w))))
(defun test-tree-store ()
@@
-1190,6
+1197,7
@@
:buttons :ok)))
(dialog-run dialog)
(object-destroy dialog)))))
: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)
(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 "destroy" (lambda (widget)
- (declare (ignore widget))
- (leave-gtk-main)))
(connect-signal window "expose-event"
(lambda (widget event)
(declare (ignore widget event))
(connect-signal window "expose-event"
(lambda (widget event)
(declare (ignore widget event))