X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=gtk%2Fgtk.demo.lisp;h=8fe99b9bb6717942b9a674b4005a36b803295cd9;hb=8b6767cf4830672f2d929b66031f561857b9f1cd;hp=8c5234203cd6d14b94869b4254062a9aa2e7d4c4;hpb=a6508485aa298480a387a9760b032a7b15898ac4;p=cl-gtk2.git diff --git a/gtk/gtk.demo.lisp b/gtk/gtk.demo.lisp index 8c52342..8fe99b9 100644 --- a/gtk/gtk.demo.lisp +++ b/gtk/gtk.demo.lisp @@ -1,5 +1,5 @@ (defpackage :gtk-demo - (:use :cl :gtk :gdk :gobject :anaphora :iter) + (:use :cl :gtk :gdk :gobject :iter) (:export #:test #:test-entry #:table-packing @@ -12,7 +12,6 @@ #:demo-code-editor #:test-treeview-list #:test-combo-box - #:test-toolbar #:test-ui-manager #:test-color-button #:test-color-selection @@ -393,8 +392,9 @@ (for action = (make-instance 'action :name name :stock-id stock-id)) (g-signal-connect action "activate" fn) (action-group-add-action action-group action)) - (awhen (ui-manager-widget ui-manager "/toolbar1") - (container-add window it)) + (let ((widget (ui-manager-widget ui-manager "/toolbar1"))) + (when widget + (container-add window widget))) (widget-show window)))) (defun test-color-button () @@ -456,7 +456,15 @@ (iter (for i from 0 to 5) (for page = (make-instance 'label :label (format nil "Label for page ~A" i))) (for tab-label = (make-instance 'label :label (format nil "Tab ~A" i))) - (for tab-button = (make-instance 'button :use-stock t :label "gtk-close" :relief :none)) + (for tab-button = (make-instance 'button + :image (make-instance 'image :stock "gtk-close" :icon-size 1) + :relief :none)) + (g-signal-connect tab-button "clicked" + (let ((page page)) + (lambda (button) + (declare (ignore button)) + (format t "Removing page ~A~%" page) + (notebook-remove-page notebook page)))) (for tab-hbox = (make-instance 'h-box)) (box-pack-start tab-hbox tab-label) (box-pack-start tab-hbox tab-button) @@ -537,8 +545,9 @@ (defun demo-text-editor () (within-main-loop - (let* ((builder (aprog1 (make-instance 'builder) - (builder-add-from-file it (namestring (merge-pathnames "demo/text-editor.ui" *src-location*))))) + (let* ((builder (let ((builder (make-instance 'builder))) + (builder-add-from-file builder (namestring (merge-pathnames "demo/text-editor.ui" *src-location*))) + builder)) (window (builder-get-object builder "window1")) (text-view (builder-get-object builder "textview1")) (status-bar (builder-get-object builder "statusbar1"))