X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/aa9ceddc987ea92cb20b319ff7b1a51bc176b6e8..510fbcc122c6b84b75f21c70992011fe86c53826:/examples/testgtk.lisp

diff --git a/examples/testgtk.lisp b/examples/testgtk.lisp
index db0cd4d..6393fde 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.12 2004-12-20 00:56:11 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.18 2005-02-25 23:58:56 espen Exp $
 
 
 ;(use-package "GTK")
@@ -29,12 +25,12 @@ (defmacro define-toplevel (name (window title &rest initargs) &body body)
   `(let ((,window nil))
      (defun ,name ()
        (unless ,window
-	 (setq ,window (apply #'make-instance 'window :title ,title ',initargs))
+	 (setq ,window (make-instance 'window :title ,title ,@initargs :show-children t))
 	 (signal-connect ,window 'destroy #'(lambda () (setq ,window nil)))
 	 ,@body)
        
        (if (not (widget-visible-p ,window))
-	   (widget-show-all ,window)
+	   (widget-show ,window)
 	 (widget-hide ,window)))))
 
 
@@ -44,7 +40,7 @@ (defmacro define-dialog (name (dialog title &optional (class 'dialog)
   `(let ((,dialog nil))
      (defun ,name ()
        (unless ,dialog
-	 (setq ,dialog (apply #'make-instance ,class :title ,title ',initargs))
+	 (setq ,dialog (make-instance ,class :title ,title ,@initargs :show-children t))
 	 (signal-connect ,dialog 'destroy #'(lambda () (setq ,dialog nil)))
 	 ,@body)
        
@@ -183,14 +179,13 @@ (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
-   :parent window :border-width 10 :spacing 10 :show-all t
+   :parent window :border-width 10 :spacing 10
    :child (make-instance 'frame
 	   :label "Horizontal Button Boxes"
 	   :child (make-instance 'v-box
@@ -239,15 +234,14 @@ (define-simple-dialog create-buttons (dialog "Buttons")
 				  (widget-hide button+1)
 				(widget-show button+1))))
 	  (table-attach table button column (1+ column) row (1+ row)
-			:options '(:expand :fill)))))
-    (widget-show-all table)))
+			:options '(:expand :fill)))))))
 
 
 ;; Calenadar
 
 (define-simple-dialog create-calendar (dialog "Calendar")
   (make-instance 'v-box
-   :parent dialog :border-width 10 :show-all t
+   :parent dialog :border-width 10
    :child (make-instance 'calendar)))
 
 
@@ -255,7 +249,7 @@ (define-simple-dialog create-calendar (dialog "Calendar")
 
 (define-simple-dialog create-check-buttons (dialog "Check Buttons")
   (make-instance 'v-box
-   :border-width 10 :spacing 10 :parent dialog :show-all t
+   :border-width 10 :spacing 10 :parent dialog
    :children (loop
 	      for n from 1 to 3
 	      collect (make-instance 'check-button
@@ -267,25 +261,22 @@ (define-simple-dialog create-check-buttons (dialog "Check Buttons")
 
 (define-dialog create-color-selection (dialog "Color selection dialog" 
 				       'color-selection-dialog
-				       :allow-grow nil :allow-shrink nil)
-  (with-slots (action-area colorsel) dialog
-;;     This seg faults for some unknown reason
-;;     (let ((button (make-instance 'check-button :label "Show Palette")))
-;;       (dialog-add-action-widget dialog button
-;;        #'(lambda () 
-;;  	  (setf 
-;;  	   (color-selection-has-palette-p colorsel)
-;;  	   (toggle-button-active-p button)))))
-
-    (container-add action-area 
-     (create-check-button "Show Opacity" 
-      #'(lambda (state)
-	  (setf (color-selection-has-opacity-control-p colorsel) state))))
-
-    (container-add action-area
-     (create-check-button "Show Palette" 
-      #'(lambda (state) 
-	  (setf (color-selection-has-palette-p colorsel) state))))
+				       :allow-grow nil :allow-shrink nil
+				       :show-children nil)
+  (with-slots (colorsel) dialog
+    (let ((button (make-instance 'check-button :label "Show Opacity")))
+      (dialog-add-action-widget dialog button
+       #'(lambda () 
+ 	  (setf 
+ 	   (color-selection-has-opacity-control-p colorsel)
+ 	   (toggle-button-active-p button)))))
+
+    (let ((button (make-instance 'check-button :label "Show Palette")))
+      (dialog-add-action-widget dialog button
+       #'(lambda () 
+ 	  (setf 
+ 	   (color-selection-has-palette-p colorsel)
+ 	   (toggle-button-active-p button)))))
 
     (signal-connect dialog :ok
      #'(lambda ()
@@ -314,7 +305,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))
@@ -344,15 +335,15 @@ (define-simple-dialog create-cursors (dialog "Cursors")
     (signal-connect drawing-area 'button-press-event
      #'(lambda (event)
 	 (case (gdk:event-button event)
-	   (1 (spin-button-spin spinner :step-forward 0.0))
-	   (3 (spin-button-spin spinner :step-backward 0.0)))
+	   (1 (spin-button-spin spinner :step-forward))
+	   (3 (spin-button-spin spinner :step-backward)))
 	 t))
 
     (signal-connect drawing-area 'scroll-event
      #'(lambda (event)
 	 (case (gdk:event-direction event)
-	   (:up (spin-button-spin spinner :step-forward 0.0))
-	   (:down (spin-button-spin spinner :step-backward 0.0)))
+	   (:up (spin-button-spin spinner :step-forward))
+	   (:down (spin-button-spin spinner :step-backward)))
 	 t))
 
     (signal-connect spinner 'changed
@@ -360,7 +351,7 @@ (define-simple-dialog create-cursors (dialog "Cursors")
 	 (set-cursor spinner drawing-area label)))
 
     (make-instance 'v-box
-     :parent dialog :border-width 10 :spacing 5 :show-all t
+     :parent dialog :border-width 10 :spacing 5
      :child (list
 	     (make-instance 'h-box
 	      :border-width 5
@@ -370,7 +361,6 @@ (define-simple-dialog create-cursors (dialog "Cursors")
 	      :child spinner)
 	     :expand nil)
      :child (make-instance 'frame
-;	     :shadow-type :etched-in
 	     :label "Cursor Area" :label-xalign 0.5 :border-width 10
 	     :child drawing-area)
      :child (list label :expand nil))
@@ -445,15 +435,14 @@ (define-simple-dialog create-entry (dialog "Entry")
       
 	(create-check-button "Editable" 'editable)
 	(create-check-button "Visible" 'visibility)
-	(create-check-button "Sensitive" 'sensitive)))
-    (widget-show-all main)))
+	(create-check-button "Sensitive" 'sensitive)))))
 
 
 ;; Expander
 
 (define-simple-dialog create-expander (dialog "Expander" :resizable nil)
   (make-instance 'v-box
-   :parent dialog :spacing 5 :border-width 5 :show-all t
+   :parent dialog :spacing 5 :border-width 5
    :child (create-label "Expander demo. Click on the triangle for details.")
    :child (make-instance 'expander
 	   :label "Details"
@@ -466,136 +455,34 @@ (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 ()
-       (format t "Selected file: ~A~%" (file-chooser-filename dialog))
+       (if (slot-boundp dialog 'filename)	   
+	   (format t "Selected file: ~A~%" (file-chooser-filename dialog))
+	 (write-line "No files selected"))
        (widget-destroy 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
 
@@ -679,8 +566,7 @@ (define-toplevel create-layout (window "Layout" :default-width 200
   (let ((layout (make-instance 'layout
 		 :parent (make-instance 'scrolled-window :parent window)
 		 :width 1600 :height 128000 :events '(:exposure-mask)
- 		 :signal (list 'expose-event #'layout-expose :object t)
-		 )))
+ 		 :signal (list 'expose-event #'layout-expose :object t))))
 
     (with-slots (hadjustment vadjustment) layout
       (setf
@@ -690,18 +576,22 @@ (define-toplevel create-layout (window "Layout" :default-width 200
     (dotimes (i 16)
       (dotimes (j 16)
 	(let ((text (format nil "Button ~D, ~D" i j)))
-	  (make-instance (if (not (zerop (mod (+ i j) 2)))
-			     'button
-			   'label)
-	   :label text :parent (list layout :x (* j 100) :y (* i 100))))))
+	  (layout-put layout
+	   (make-instance (if (not (zerop (mod (+ i j) 2)))
+			      'button
+			    'label)
+			  :label text :visible t)
+	   (* j 100) (* i 100)))))
 
     (loop
      for i from 16 below 1280
      do (let ((text (format nil "Button ~D, ~D" i 0)))
-	  (make-instance (if (not (zerop (mod i 2)))
-			     'button
-			   'label)
-	   :label text :parent (list layout :x 0 :y (* i 100)))))))
+	  (layout-put layout
+	   (make-instance (if (not (zerop (mod i 2)))
+			      'button
+			    'label)
+			  :label text :visible t)
+	   0 (* i 100))))))
 
 
 
@@ -739,7 +629,7 @@ (define-simple-dialog create-list (dialog "List" :default-height 400)
       (tree-view-append-column tree column))      
 
     (make-instance 'v-box
-     :parent dialog :border-width 10 :spacing 10 :show-all t
+     :parent dialog :border-width 10 :spacing 10
      :child (list
 	     (make-instance 'h-box
               :spacing 10
@@ -812,14 +702,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)))
 
 
@@ -827,7 +719,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"))))
@@ -856,7 +748,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 
@@ -896,14 +788,14 @@ (defun create-notebook-page (notebook page-num)
 	     :signal (list 'clicked #'(lambda () (widget-hide page)))))
 
     (let ((label-box (make-instance 'h-box 
-		      :show-all t
+		      :show-children 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
+		     :show-children 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)
@@ -912,24 +804,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))
 	
@@ -960,7 +853,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
@@ -986,7 +878,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"
@@ -1018,64 +910,40 @@ (define-simple-dialog create-notebook (dialog "Notebook")
 ;;; Panes
 
 (defun toggle-resize (child)
-  (let* ((paned (widget-parent child))
-	 (is-child1-p (eq child (paned-child1 paned))))
-    (multiple-value-bind (child resize shrink)
-	(if is-child1-p
-	    (paned-child1 paned)
-	  (paned-child2 paned))
-      (container-remove paned child)
-      (if is-child1-p
-	  (paned-pack1 paned child (not resize) shrink)
-	(paned-pack2 paned child (not resize) shrink)))))
+  (setf (paned-child-resize-p child) (not (paned-child-resize-p child))))
 
 (defun toggle-shrink (child)
-  (let* ((paned (widget-parent child))
-	 (is-child1-p (eq child (paned-child1 paned))))
-    (multiple-value-bind (child resize shrink)
-	(if is-child1-p
-	    (paned-child1 paned)
-	  (paned-child2 paned))
-      (container-remove paned child)
-      (if is-child1-p
-	  (paned-pack1 paned child resize (not shrink))
-	(paned-pack2 paned child resize (not shrink))))))
+  (setf (paned-child-shrink-p child) (not (paned-child-shrink-p child))))
 
 (defun create-pane-options (paned frame-label label1 label2)
-  (let* ((frame (make-instance 'frame :label frame-label :border-width 4))
-	 (table (make-instance 'table :n-rows 3 :n-columns 2 :homogeneous t 
-			              :parent frame)))
-
+  (let* ((table (make-instance 'table :n-rows 3 :n-columns 2 :homogeneous t)))
     (table-attach table (create-label label1) 0 1 0 1 :options '(:expand :fill))
     (let ((check-button (make-instance 'check-button :label "Resize")))
       (table-attach table check-button 0 1 1 2 :options '(:expand :fill))
-      (signal-connect
-       check-button 'toggled #'toggle-resize :object (paned-child1 paned)))
-    (let ((check-button (make-instance 'check-button :label "Shrink")))
+      (signal-connect check-button 'toggled 
+       #'toggle-resize :object (paned-child1 paned)))
+    (let ((check-button (make-instance 'check-button :label "Shrink" :active t)))
       (table-attach table check-button 0 1 2 3 :options '(:expand :fill))
-      (setf (toggle-button-active-p check-button) t)
-      (signal-connect
-       check-button 'toggled #'toggle-shrink :object (paned-child1 paned)))
+      (signal-connect check-button 'toggled 
+       #'toggle-shrink :object (paned-child1 paned)))
 
     (table-attach table (create-label label2) 1 2 0 1 :options '(:expand :fill))
-    (let ((check-button (make-instance 'check-button :label "Resize")))
+    (let ((check-button (make-instance 'check-button :label "Resize" :active t)))
       (table-attach table check-button 1 2 1 2 :options '(:expand :fill))
-      (setf (toggle-button-active-p check-button) t)
-      (signal-connect
-       check-button 'toggled #'toggle-resize :object (paned-child2 paned)))
-    (let ((check-button (make-instance 'check-button :label "Shrink")))
+      (signal-connect check-button 'toggled 
+       #'toggle-resize :object (paned-child2 paned)))
+    (let ((check-button (make-instance 'check-button :label "Shrink" :active t)))
       (table-attach table check-button 1 2 2 3 :options '(:expand :fill))
-      (setf (toggle-button-active-p check-button) t)
-      (signal-connect
-       check-button 'toggled #'toggle-shrink :object (paned-child2 paned)))
-    frame))
+      (signal-connect check-button 'toggled
+       #'toggle-shrink :object (paned-child2 paned)))
+    (make-instance 'frame :label frame-label :border-width 4 :child table)))
 
 (define-toplevel create-panes (window "Panes")
   (let* ((hpaned (make-instance 'h-paned
 		  :child1 (make-instance 'frame
 			   :width-request 60 :height-request 60
 			   :shadow-type :in 
-			   :child (make-instance 'buttun :label "Hi there"))
+			   :child (make-instance 'button :label "Hi there"))
 		  :child2 (make-instance 'frame			    
 			   :width-request 80 :height-request 60
 			   :shadow-type :in)))
@@ -1096,15 +964,39 @@ (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
+     :child progress
+     :child activity-mode-button)
+
+    (signal-connect dialog 'destroy 
+     #'(lambda () (when timer (timeout-remove timer))))))
 
 
 ;;; Radio buttons
 
 (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)))
+   :parent dialog :border-width 10 :spacing 10
+   :children (make-radio-group 'radio-button
+	      '((:label "button1") (:label "button2") (:label "button3"))
+	      nil)))
 
 
 ;;; Rangle controls
@@ -1112,7 +1004,7 @@ (define-simple-dialog create-radio-buttons (dialog "Radio buttons")
 (define-simple-dialog create-range-controls (dialog "Range controls")
   (let ((adjustment (adjustment-new 0.0 0.0 101.0 0.1 1.0 1.0)))
     (make-instance 'v-box
-     :parent dialog :border-width 10 :spacing 10 :show-all t
+     :parent dialog :border-width 10 :spacing 10
      :child (make-instance 'h-scale
 	     :width-request 150 :adjustment adjustment :inverted t
 	     :update-policy :delayed :digits 1 :draw-value t)
@@ -1125,7 +1017,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))
@@ -1216,7 +1108,7 @@ (define-simple-dialog create-size-group (dialog "Size Group" :resizable nil)
 	       (make-instance 'frame :label label :child table))))
 
       (make-instance 'v-box
-       :parent dialog :border-width 5 :spacing 5 :show-all t
+       :parent dialog :border-width 5 :spacing 5
        :child (create-frame "Color Options"
 	       '(("Foreground" "Red" "Green" "Blue")
 		 ("Background" "Red" "Green" "Blue")))
@@ -1465,16 +1357,15 @@ (define-simple-dialog create-idle-test (dialog "Idle Test")
      #'(lambda () (when idle (idle-remove idle))))
  
     (make-instance 'v-box
-     :parent dialog :border-width 10 :spacing 10 :show-all t
+     :parent dialog :border-width 10 :spacing 10
      :child label
      :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))))))
@@ -1546,8 +1437,9 @@ (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)
+		       (declare (ignore non-zero-p))
 		       (if active 
 			   (text-buffer-apply-tag buffer tag start end)
 			 (text-buffer-remove-tag buffer tag start end))))))))
@@ -1613,7 +1505,7 @@ (define-simple-dialog create-text (dialog "Text" :default-width 400
 
 (define-simple-dialog create-toggle-buttons (dialog "Toggle Button")
   (make-instance 'v-box
-   :border-width 10 :spacing 10 :parent dialog :show-all t
+   :border-width 10 :spacing 10 :parent dialog
       :children (loop
 	      for n from 1 to 3
 	      collect (make-instance 'toggle-button
@@ -1623,110 +1515,94 @@ (define-simple-dialog create-toggle-buttons (dialog "Toggle Button")
 
 ;;; Toolbar test
 
-;; TODO: style properties
-(define-toplevel create-toolbar (window "Toolbar test" :resizable nil)
-  (let ((toolbar (make-instance 'toolbar :parent window)))
-;    (setf (toolbar-relief toolbar) :none)
-
-    ;; 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)))
 
 
 
@@ -1739,9 +1615,9 @@ (define-simple-dialog create-tooltips (dialog "Tooltips" :default-width 200)
 	       (tooltips-set-tip tooltips button tip-text tip-private)
 	       button)))
       (make-instance 'v-box
-       :parent dialog :border-width 10 :spacing 10 :show-all t
+       :parent dialog :border-width 10 :spacing 10
        :child (create-button "button1" "This is button 1" "ContextHelp/button/1")
-       :child (create-button "button2" "This is button 2. This is also a really long tooltip which probably won't fit on a single line and will therefore need to be wrapped. Hopefully the wrapping will work correctly." "ContextHelp/button/2")))))
+       :child (create-button "button2" "This is button 2. This is also has a really long tooltip which probably won't fit on a single line and will therefore need to be wrapped. Hopefully the wrapping will work correctly." "ContextHelp/button/2")))))
 
 
 ;;; UI Manager
@@ -1807,7 +1683,7 @@ (define-toplevel create-ui-manager (window "UI Manager")
     (window-add-accel-group window (ui-manager-accel-group ui))
     
     (make-instance 'v-box 
-     :parent window :show-all t
+     :parent window
      :child (list 
 	     (ui-manager-get-widget ui "/MenuBar")
 	     :expand nil :fill nil)
@@ -1841,9 +1717,8 @@ (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)
-;; 	    ("item factory")
  	    ("labels" create-labels)
  	    ("layout" create-layout)
  	    ("list" create-list)
@@ -1851,7 +1726,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")
@@ -1870,7 +1745,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)
@@ -1888,6 +1763,11 @@ (defun create-main-window ()
 		       :signal (list 'clicked #'widget-destroy 
 				     :object main-window)))) 
 
+    (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
      :parent main-window