(:fn "Testing GtkUIManager" test-ui-manager)
(:fn "GtkFontChooser" test-font-chooser)))
+(defun clear-text-tag-table (table)
+ (let (tags)
+ (text-tag-table-foreach table
+ (lambda (tag)
+ (push tag tags)))
+ (iter (for tag in tags)
+ (text-tag-table-remove table tag))))
+
(defun fill-demo-text-buffer (buffer text-view &optional (page 'index))
(declare (ignorable text-view))
- (setf (text-buffer-tag-table buffer) (make-instance 'text-tag-table))
+ (clear-text-tag-table (text-buffer-tag-table buffer))
(setf (text-buffer-text buffer) "")
(text-tag-table-add (text-buffer-tag-table buffer) (make-instance 'text-tag :name "bold" :weight 700))
(labels ((insert-text (text)
:hscrollbar-policy :automatic
:vscrollbar-policy :automatic
(:expr (make-demo-text-view))))
+ (connect-signal w "destroy"
+ (lambda (w)
+ (declare (ignore w))
+ (leave-gtk-main)))
(widget-show w))))
(defun test ()
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)
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)
(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))))
(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"
(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)
(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))))
(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)
"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 ()
(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~%"
(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 ()
(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))
: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 ()
: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)
(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))