X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/812dd86980f727e274589dee4238f7a2a75a0147..3cfa455c49f16f4548b9f7fc20009f3252fa0c3f:/examples/testgtk.lisp

diff --git a/examples/testgtk.lisp b/examples/testgtk.lisp
index 357debb..7fe0786 100644
--- a/examples/testgtk.lisp
+++ b/examples/testgtk.lisp
@@ -1,5 +1,5 @@
 ;; Common Lisp bindings for GTK+ v2.0
-;; Copyright (C) 1999-2000 Espen S. Johnsen <espejohn@online.no>
+;; Copyright (C) 1999-2005 Espen S. Johnsen <espen@users.sf.net>
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -15,11 +15,7 @@
 ;; License along with this library; if not, write to the Free Software
 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
-;; $Id: testgtk.lisp,v 1.13 2004-12-26 12:01:10 espen Exp $
-
-
-;;; Some of the code in this file are really outdatet, but it is
-;;; still the most complete example of how to use the library
+;; $Id: testgtk.lisp,v 1.16 2005-01-12 14:03:04 espen Exp $
 
 
 ;(use-package "GTK")
@@ -183,10 +179,9 @@ (defun create-bbox-in-frame (class frame-label spacing width height layout)
    :label frame-label
    :child (make-instance class
 	   :border-width 5 :layout-style layout :spacing spacing
-;	   :child-min-width width :child-min-height height
-	   :child (make-instance 'button :label "gtk-ok" :use-stock t)
-	   :child (make-instance 'button :label "gtk-cancel" :use-stock t)
-	   :child (make-instance 'button :label "gtk-help" :use-stock t))))
+	   :child (make-instance 'button :stock "gtk-ok")
+	   :child (make-instance 'button :stock "gtk-cancel")
+	   :child (make-instance 'button :stock "gtk-help"))))
 
 (define-toplevel create-button-box (window "Button Boxes")
   (make-instance 'v-box
@@ -314,7 +309,7 @@ (defun set-cursor (spinner drawing-area label)
 (defun cursor-expose (drawing-area event)
   (declare (ignore event))
   (multiple-value-bind (width height)
-      (drawing-area-get-size drawing-area)
+      (widget-get-size-allocation drawing-area)
     (let* ((window (widget-window drawing-area))
 	   (style (widget-style drawing-area))
 	   (white-gc (style-white-gc style))
@@ -466,7 +461,7 @@ (define-dialog create-file-chooser (dialog "File Chooser" 'file-chooser-dialog)
   (dialog-add-button dialog "gtk-cancel" #'widget-destroy :object t)
   (dialog-add-button dialog "gtk-ok" 
    #'(lambda ()
-       (if (slot-boundp dialog 'filename)
+       (if (slot-boundp dialog 'filename)	   
 	   (format t "Selected file: ~A~%" (file-chooser-filename dialog))
 	 (write-line "No files selected"))
        (widget-destroy dialog))))
@@ -475,129 +470,25 @@ (define-dialog create-file-chooser (dialog "File Chooser" 'file-chooser-dialog)
 
 ;;; Handle box
 
-;; (defun create-handle-box-toolbar ()
-;;   (let ((toolbar (toolbar-new :horizontal :both)))
-;;     (toolbar-append-item
-;;      toolbar "Horizontal" (pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Horizontal toolbar layout"
-;;      :callback #'(lambda () (setf (toolbar-orientation toolbar) :horizontal)))
-
-;;     (toolbar-append-item
-;;      toolbar "Vertical" (pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Vertical toolbar layout"
-;;      :callback #'(lambda () (setf (toolbar-orientation toolbar) :vertical)))
-
-;;     (toolbar-append-space toolbar)
-    
-;;     (toolbar-append-item
-;;      toolbar "Icons" (pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Only show toolbar icons"
-;;      :callback #'(lambda () (setf (toolbar-style toolbar) :icons)))
-    
-;;     (toolbar-append-item
-;;      toolbar "Text" (pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Only show toolbar text"
-;;      :callback #'(lambda () (setf (toolbar-style toolbar) :text)))
-  
-;;     (toolbar-append-item
-;;      toolbar "Both" (pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Show toolbar icons and text"
-;;      :callback #'(lambda () (setf (toolbar-style toolbar) :both)))
-
-;;     (toolbar-append-space toolbar)
-
-;;     (toolbar-append-item
-;;      toolbar "Small" (pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Use small spaces"
-;;      :callback #'(lambda () (setf (toolbar-space-size toolbar) 5)))
-    
-;;     (toolbar-append-item
-;;      toolbar "Big" (pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Use big spaces"
-;;      :callback #'(lambda () (setf (toolbar-space-size toolbar) 10)))
-    
-;;     (toolbar-append-space toolbar)
-
-;;     (toolbar-append-item
-;;      toolbar "Enable" (pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Enable tooltips"
-;;      :callback #'(lambda () (toolbar-enable-tooltips toolbar)))
-
-;;     (toolbar-append-item
-;;      toolbar "Disable" (pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Disable tooltips"
-;;      :callback #'(lambda () (toolbar-disable-tooltips toolbar)))
-
-;;     (toolbar-append-space toolbar)
-
-;;     (toolbar-append-item
-;;      toolbar "Borders" (pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Show borders"
-;;      :callback #'(lambda () (setf (toolbar-relief toolbar) :normal)))
-    
-;;     (toolbar-append-item
-;;      toolbar "Borderless" (pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Hide borders"
-;;      :callback #'(lambda () (setf (toolbar-relief toolbar) :none)))
-
-;;     toolbar))
-
-
-;; (defun handle-box-child-signal (handle-box child action)
-;;   (format t "~S: child ~S ~A~%" handle-box child action))
-
-
-;; (define-test-window create-handle-box "Handle Box Test"
-;;   (setf (window-allow-grow-p window) t)
-;;   (setf (window-allow-shrink-p window) t)
-;;   (setf (window-auto-shrink-p window) nil)
-;;   (setf (container-border-width window) 20)
-;;   (let ((v-box (v-box-new nil 0)))
-;;     (container-add window v-box)
-
-;;     (container-add v-box (create-label "Above"))
-;;     (container-add v-box (hseparator-new))
-
-;;     (let ((hbox (hbox-new nil 10)))
-;;       (container-add v-box hbox)
-      
-;;       (let ((handle-box (handle-box-new)))
-;; 	(box-pack-start hbox handle-box nil nil 0)
-;; 	(signal-connect
-;; 	 handle-box 'child-attached
-;; 	 #'(lambda (child)
-;; 	     (handle-box-child-signal handle-box child "attached")))
-;; 	(signal-connect
-;; 	 handle-box 'child-detached
-;; 	 #'(lambda (child)
-;; 	     (handle-box-child-signal handle-box child "detached")))
-;; 	(container-add handle-box (create-handle-box-toolbar)))
-
-;;       (let ((handle-box (handle-box-new)))
-;; 	(box-pack-start hbox handle-box nil nil 0)
-;; 	(signal-connect
-;; 	 handle-box 'child-attached
-;; 	 #'(lambda (child)
-;; 	     (handle-box-child-signal handle-box child "attached")))
-;; 	(signal-connect
-;; 	 handle-box 'child-detached
-;; 	 #'(lambda (child)
-;; 	     (handle-box-child-signal handle-box child "detached")))
-
-;; 	(let ((handle-box2 (handle-box-new)))
-;; 	  (container-add handle-box handle-box2)
-;; 	  (signal-connect
-;; 	   handle-box2 'child-attached
-;; 	   #'(lambda (child)
-;; 	       (handle-box-child-signal handle-box child "attached")))
-;; 	  (signal-connect
-;; 	   handle-box2 'child-detached
-;; 	   #'(lambda (child)
-;; 	       (handle-box-child-signal handle-box child "detached")))
-;; 	  (container-add handle-box2 (create-label "Foo!")))))
-    
-;;     (container-add v-box (hseparator-new))
-;;     (container-add v-box (create-label "Below"))))
+(define-toplevel create-handle-box (window "Handle Box Test" :border-width 20)
+  (make-instance 'v-box 
+   :parent window
+   :child (create-label "Above")
+   :child (make-instance 'h-separator)
+   :child (make-instance 'h-box 
+	   :spacing 10
+	   :child (list
+		   (make-instance 'handle-box
+		    :child (create-toolbar window)
+		    :signal (list 'child-attached
+			     #'(lambda (child)
+				 (format t "~A attached~%" child)))
+		    :signal (list 'child-detached
+			     #'(lambda (child)
+				 (format t "~A detached~%" child))))
+		   :expand nil :fill :nil))
+   :child (make-instance 'h-separator)
+   :child (create-label "Below")))
 
 ;;; Image
 
@@ -814,14 +705,16 @@ (defun create-menu (depth tearoff)
 		 (make-instance 'radio-menu-item
 		  :label (format nil "item ~2D - ~D" depth (1+ i)))))
  	    (if group
- 		(radio-menu-item-add-to-group menu-item group)
+ 		(add-to-radio-group menu-item group)
  	      (setq group menu-item))
 	    (unless (zerop (mod depth 2))
 	      (setf (check-menu-item-active-p menu-item) t))
 	    (menu-shell-append menu menu-item)
 	    (when (= i 3)
 	      (setf (widget-sensitive-p menu-item) nil))
-	    (setf (menu-item-submenu menu-item) (create-menu (1- depth) t)))))
+	    (let ((submenu (create-menu (1- depth) t)))
+	      (when submenu
+		(setf (menu-item-submenu menu-item) submenu))))))
       menu)))
 
 
@@ -829,7 +722,7 @@ (define-simple-dialog create-menus (dialog "Menus" :default-width 200)
   (let* ((main (make-instance 'v-box :parent dialog))
 ;	 (accel-group (make-instance 'accel-group))
 	 (menubar (make-instance 'menu-bar :parent (list main :expand nil))))
-;    (accel-group-attach accel-group window)
+;    (window-add-accel-group dialog accel-group)
 
     (let ((menu-item (make-instance 'menu-item 
 		      :label (format nil "test~%line2"))))
@@ -858,7 +751,7 @@ (define-simple-dialog create-menus (dialog "Menus" :default-width 200)
 
 ;;; Notebook
 
-(defun create-notebook-page (notebook page-num)
+(defun create-notebook-page (notebook page-num book-closed)
   (let* ((title (format nil "Page ~D" page-num))
 	 (page (make-instance 'frame :label title :border-width 10))
  	 (v-box (make-instance 'v-box 
@@ -900,12 +793,12 @@ (defun create-notebook-page (notebook page-num)
     (let ((label-box (make-instance 'h-box 
 		      :show-all t
 		      :child-args '(:expand nil)
-		      :child (make-instance 'image :pixmap book-closed-xpm)
+		      :child (make-instance 'image :pixbuf book-closed)
 		      :child (make-instance 'label :label title)))
 	  (menu-box (make-instance 'h-box 
 		     :show-all t
 		     :child-args '(:expand nil)
-		     :child (make-instance 'image :pixmap book-closed-xpm)
+		     :child (make-instance 'image :pixbuf book-closed)
 		     :child (make-instance 'label :label title))))
 
       (widget-show-all page)
@@ -914,24 +807,25 @@ (defun create-notebook-page (notebook page-num)
 
 (define-simple-dialog create-notebook (dialog "Notebook")
   (let ((main (make-instance 'v-box :parent dialog)))
-    (let ((notebook (make-instance 'notebook 
+    (let ((book-open (gdk:pixbuf-new-from-xpm-data book-open-xpm))
+	  (book-closed (gdk:pixbuf-new-from-xpm-data book-closed-xpm))
+	  (notebook (make-instance 'notebook 
 		     :border-width 10 :tab-pos :top :parent main)))
-      (flet ((set-image (page func xpm)
-	       (image-set-from-pixmap-data 
-		(first (container-children (funcall func notebook page)))
-		xpm)))	     
+      (flet ((set-image (page func pixbuf)
+	       (setf
+		(image-pixbuf 
+		 (first (container-children (funcall func notebook page))))
+		pixbuf)))
 	(signal-connect notebook 'switch-page
 	 #'(lambda (pointer page)
 	     (declare (ignore pointer))
-	     (unless (eq page (notebook-current-page-num notebook))
-	       (set-image page #'notebook-menu-label book-open-xpm)
-	       (set-image page #'notebook-tab-label book-open-xpm)
-	     
+	     (set-image page #'notebook-menu-label book-open)
+	     (set-image page #'notebook-tab-label book-open)
+	     (when (slot-boundp notebook 'current-page)
 	       (let ((curpage (notebook-current-page notebook)))
-		 (when curpage
-		   (set-image curpage #'notebook-menu-label book-closed-xpm)
-		   (set-image curpage #'notebook-tab-label book-closed-xpm)))))))	  
-      (loop for i from 1 to 5 do (create-notebook-page notebook i))
+		 (set-image curpage #'notebook-menu-label book-closed)
+		 (set-image curpage #'notebook-tab-label book-closed))))))
+      (loop for i from 1 to 5 do (create-notebook-page notebook i book-closed))
 
       (make-instance 'h-separator :parent (list main :expand nil :padding 10))
 	
@@ -962,7 +856,6 @@ (define-simple-dialog create-notebook (dialog "Notebook")
        :child-args '(:expand nil)
        :child (make-instance 'label :label "Notebook Style: ")
        :child (let ((scrollable-p nil)) 
-		;; option menu is deprecated, we should use combo-box
 		(make-instance 'combo-box
 		 :content '("Standard" "No tabs" "Scrollable") :active 0
 		 :signal (list 'changed
@@ -988,7 +881,7 @@ (define-simple-dialog create-notebook (dialog "Notebook")
 				   (setf (notebook-show-tabs-p notebook) t)
 				   (setf (notebook-scrollable-p notebook) t)
 				   (loop for i from 6 to 15 
-				    do (create-notebook-page notebook i))))))
+				    do (create-notebook-page notebook i book-closed))))))
 			  :object t)))
        :child (make-instance 'button
 	       :label "Show all Pages"
@@ -1074,7 +967,29 @@ (define-toplevel create-panes (window "Panes")
 
 ;;; Progress bar
 
- 
+(define-simple-dialog create-progress-bar (dialog "Progress Bar")
+  (let* ((progress (make-instance 'progress-bar :pulse-step 0.05))
+	 (activity-mode-button (make-instance 'check-button 
+				:label "Activity mode"))
+	 (timer (timeout-add 100
+		 #'(lambda ()
+		     (if (toggle-button-active-p activity-mode-button)
+			 (progress-bar-pulse progress)
+		       (let ((fract (+ (progress-bar-fraction progress) 0.01)))
+			 (setf		      
+			  (progress-bar-fraction progress)
+			  (if (> fract 1.0)
+			      0.0
+			    fract))))
+		     t))))
+
+    (make-instance 'v-box
+     :parent dialog :border-width 10 :spacing 10 :show-all t
+     :child progress
+     :child activity-mode-button)
+
+    (signal-connect dialog 'destroy 
+     #'(lambda () (when timer (timeout-remove timer))))))
 
 
 ;;; Radio buttons
@@ -1082,7 +997,9 @@ (define-toplevel create-panes (window "Panes")
 (define-simple-dialog create-radio-buttons (dialog "Radio buttons")
   (make-instance 'v-box
    :parent dialog :border-width 10 :spacing 10 :show-all t
-   :children (create-radio-button-group '("button1" "button2" "button3") 1)))
+   :children (make-radio-group 'radio-button
+	      '((:label "button1") (:label "button2") (:label "button3"))
+	      nil)))
 
 
 ;;; Rangle controls
@@ -1103,7 +1020,7 @@ (define-simple-dialog create-range-controls (dialog "Range controls")
 (define-simple-dialog create-reparent (dialog "Reparent")
   (let ((main (make-instance 'h-box 
 	       :homogeneous t :spacing 10 :border-width 10 :parent dialog))
-	(label (make-instance 'label :label "Hellow World")))
+	(label (make-instance 'label :label "Hello World")))
 
     (flet ((create-frame (title)
 	     (let* ((frame (make-instance 'frame :label title :parent main))
@@ -1448,11 +1365,10 @@ (define-simple-dialog create-idle-test (dialog "Idle Test")
      :child (make-instance 'frame
 	     :label "Label Container" :border-width 5
 	     :child(make-instance 'v-box
-		   :children (create-radio-button-group
-			      '(("Resize-Parent" :parent)
-				("Resize-Queue" :queue)
-				("Resize-Immediate" :immediate))
-			      0
+		   :children (make-radio-group 'radio-button
+			      '((:label "Resize-Parent" :value :parent :active t)
+				(:label "Resize-Queue" :value :queue)
+				(:label "Resize-Immediate" :value :immediate))
 			      #'(lambda (mode)
  				  (setf 
  				   (container-resize-mode (dialog-action-area dialog)) mode))))))
@@ -1524,8 +1440,8 @@ (define-simple-dialog create-text (dialog "Text" :default-width 400
 		     (if active 
 			 (push tag active-tags)
 		       (setq active-tags (delete tag active-tags)))
-		     (multiple-value-bind (start end)
-			 (text-buffer-get-selection-bounds buffer)
+ 		     (multiple-value-bind (non-zero-p start end)
+ 			 (text-buffer-get-selection-bounds buffer)
 		       (if active 
 			   (text-buffer-apply-tag buffer tag start end)
 			 (text-buffer-remove-tag buffer tag start end))))))))
@@ -1601,108 +1517,94 @@ (define-simple-dialog create-toggle-buttons (dialog "Toggle Button")
 
 ;;; Toolbar test
 
-(define-toplevel create-toolbar (window "Toolbar test" :resizable nil)
-  (let ((toolbar (make-instance 'toolbar :parent window)))
-
-    ;; Insert a stock item
-    (toolbar-append toolbar "gtk-quit"
-     :tooltip-text "Destroy toolbar"
-     :tooltip-private-text "Toolbar/Quit"
-     :callback #'(lambda () (widget-destroy window)))
-
-    ;; Image widge as icon
-    (toolbar-append toolbar "Horizontal"
-     :icon (make-instance 'image :file #p"clg:examples;test.xpm")
-     :tooltip-text "Horizontal toolbar layout"
-     :tooltip-private-text "Toolbar/Horizontal"
-     :callback #'(lambda () (setf (toolbar-orientation toolbar) :horizontal)))
-
-    ;; Icon from file
-    (toolbar-append toolbar "Vertical"
-     :icon #p"clg:examples;test.xpm"
-     :tooltip-text "Vertical toolbar layout"
-     :tooltip-private-text "Toolbar/Vertical"
-     :callback #'(lambda () (setf (toolbar-orientation toolbar) :vertical)))
-
-    (toolbar-append toolbar :space)
-    
-    ;; Stock icon
-    (toolbar-append toolbar "Icons"
-     :icon "gtk-execute"
-     :tooltip-text "Only show toolbar icons"
-     :tooltip-private-text "Toolbar/IconsOnly"
-     :callback #'(lambda () (setf (toolbar-style toolbar) :icons)))
-    
-    ;; Icon from pixmap data
-    (toolbar-append toolbar "Text" 
-     :icon gtk-mini-xpm
-     :tooltip-text "Only show toolbar text"
-     :tooltip-private-text "Toolbar/TextOnly"
-     :callback #'(lambda () (setf (toolbar-style toolbar) :text)))
-  
-    (toolbar-append toolbar "Both"
-     :tooltip-text "Show toolbar icons and text"
-     :tooltip-private-text "Toolbar/Both"
-     :callback #'(lambda () (setf (toolbar-style toolbar) :both)))
-
-    (toolbar-append toolbar :space)
-
-    (toolbar-append toolbar (make-instance 'entry)
-     :tooltip-text "This is an unusable GtkEntry"
-     :tooltip-private-text "Hey don't click me!")
-
-    (toolbar-append toolbar :space)
-    
-;;     (toolbar-append-item
-;;      toolbar "Small" ;(pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Use small spaces"
-;;      :tooltip-private-text "Toolbar/Small"
-;;      :callback #'(lambda () (setf (toolbar-space-size toolbar) 5)))
-    
-;;     (toolbar-append-item
-;;      toolbar "Big" ;(pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Use big spaces"
-;;      :tooltip-private-text "Toolbar/Big"
-;;      :callback #'(lambda () (setf (toolbar-space-size toolbar) 10)))
-    
-;;     (toolbar-append toolbar :space)
-
-    (toolbar-append
-     toolbar "Enable"
-     :tooltip-text "Enable tooltips"
-     :callback #'(lambda () (toolbar-enable-tooltips toolbar)))
-
-    (toolbar-append
-     toolbar "Disable"
-     :tooltip-text "Disable tooltips"
-     :callback #'(lambda () (toolbar-disable-tooltips toolbar)))
-
-    (toolbar-append toolbar :space)
-
-;;     (toolbar-append-item
-;;      toolbar "Borders" (pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Show borders"
-;;      :callback #'(lambda () (setf (toolbar-relief toolbar) :normal)))
-    
-;;     (toolbar-append-item
-;;      toolbar
-;;      "Borderless" (pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Hide borders"
-;;      :callback #'(lambda () (setf (toolbar-relief toolbar) :none)))
-
-;;     (toolbar-append toolbar :space)
-
-;;     (toolbar-append-item
-;;      toolbar "Empty" (pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Empty spaces"
-;;      :callback #'(lambda () (setf (toolbar-space-style toolbar) :empty)))
-
-;;     (toolbar-append-item
-;;      toolbar "Lines" (pixmap-new "clg:examples;test.xpm")
-;;      :tooltip-text "Lines in spaces"
-;;      :callback #'(lambda () (setf (toolbar-space-style toolbar) :line)))
-    
-    ))
+(defun create-toolbar (window)
+  (make-instance 'toolbar 
+   :show-tooltips t :show-arrow nil
+
+   ;; Insert a stock item
+   :child (make-instance 'tool-button 
+	   :stock  "gtk-quit"
+	   :tip-text "Destroy toolbar"
+	   :tip-private "Toolbar/Quit"
+	   :signal (list 'clicked #'(lambda () (widget-destroy window))))
+
+   :child (make-instance 'separator-tool-item)
+
+   :child (make-instance 'tool-button
+	   :label "Horizontal" :stock "gtk-go-forward"
+	   :tip-text "Horizontal toolbar layout"
+	   :tip-private "Toolbar/Horizontal"
+	   :signal (list 'clicked 
+		    #'(lambda (toolbar) 
+			(setf (toolbar-orientation toolbar) :horizontal))
+		    :object :parent))
+
+   :child (make-instance 'tool-button
+	   :label "Vertical" :stock "gtk-go-down"
+	   :tip-text "Vertical toolbar layout"
+	   :tip-private "Toolbar/Vertical"
+	   :signal (list 'clicked 
+		    #'(lambda (toolbar) 
+			(setf (toolbar-orientation toolbar) :vertical))
+		    :object :parent))
+
+   :child (make-instance 'separator-tool-item)
+
+   :children (make-radio-group 'radio-tool-button
+	      '((:label "Icons" :stock "gtk-justify-left"
+		 :tip-text "Only show toolbar icons"
+	         :tip-private "Toolbar/IconsOnly"
+		 :value :icons)
+		(:label "Both" :stock "gtk-justify-center"
+		 :tip-text "Show toolbar icons and text"
+		 :tip-private "Toolbar/Both"
+		 :value :both :active t)
+		(:label "Text" :stock "gtk-justify-right"
+	         :tip-text "Show toolbar text"
+	         :tip-private "Toolbar/TextOnly"
+		 :value :text))
+	      (list
+	       #'(lambda (toolbar style) 
+		   (setf (toolbar-style toolbar) style))
+	       :object :parent))
+
+   :child (make-instance 'separator-tool-item)
+
+   :child (make-instance 'tool-item
+	   :child (make-instance 'entry)
+	   :tip-text "This is an unusable GtkEntry"
+	   :tip-private "Hey don't click me!")
+
+   :child (make-instance 'separator-tool-item)
+
+   :child (make-instance 'tool-button
+	   :label "Enable" :stock "gtk-add"
+	   :tip-text "Enable tooltips"
+	   :tip-private "Toolbar/EnableTooltips"
+	   :signal (list 'clicked 
+		    #'(lambda (toolbar) 
+			(setf (toolbar-show-tooltips-p toolbar) t))
+		    :object :parent))
+
+   :child (make-instance 'tool-button
+	   :label "Disable" :stock "gtk-remove"
+	   :tip-text "Disable tooltips"
+	   :tip-private "Toolbar/DisableTooltips"
+	   :signal (list 'clicked 
+		    #'(lambda (toolbar) 
+			(setf (toolbar-show-tooltips-p toolbar) nil))
+		    :object :parent))
+
+;;    :child (make-instance 'separator-tool-item)
+
+;;    :child (make-instance 'tool-button
+;; 	   :label "GTK" :icon #p"clg:examples;gtk.png"
+;; 	   :tip-text "GTK+ Logo"
+;; 	   :tip-private "Toolbar/GTK+")
+   ))
+
+(define-toplevel create-toolbar-window (window "Toolbar test" :resizable nil)
+  (container-add window (create-toolbar window)))
 
 
 
@@ -1817,7 +1719,7 @@ (defun create-main-window ()
  	    ("enxpander" create-expander)
  	    ("file chooser" create-file-chooser)
 ;; 	    ("font selection")
-;; 	    ("handle box" create-handle-box)
+ 	    ("handle box" create-handle-box)
  	    ("image" create-image)
  	    ("labels" create-labels)
  	    ("layout" create-layout)
@@ -1826,7 +1728,7 @@ (defun create-main-window ()
 ;; 	    ("modal window")
  	    ("notebook" create-notebook)
  	    ("panes" create-panes)
-;; 	    ("progress bar" #|create-progress-bar|#)
+ 	    ("progress bar" create-progress-bar)
  	    ("radio buttons" create-radio-buttons)
  	    ("range controls" create-range-controls)
 ;; 	    ("rc file")
@@ -1845,7 +1747,7 @@ (defun create-main-window ()
  	    ("test timeout" create-timeout-test)
  	    ("text" create-text)
  	    ("toggle buttons" create-toggle-buttons)
- 	    ("toolbar" create-toolbar)
+ 	    ("toolbar" create-toolbar-window)
  	    ("tooltips" create-tooltips)
 ;; 	    ("tree" #|create-tree|#)
 	    ("UI manager" create-ui-manager)
@@ -1863,7 +1765,10 @@ (defun create-main-window ()
 		       :signal (list 'clicked #'widget-destroy 
 				     :object main-window)))) 
 
-    (setf (window-icon main-window) #p"clg:examples;gtk.png")
+    (let ((icon (gdk:pixbuf-load #p"clg:examples;gtk.png")))
+      (setf 
+       (window-icon main-window) 
+       (gdk:pixbuf-add-alpha icon t 254 254 252)))
 
     ;; Main box
     (make-instance 'v-box