Added new forms to be auto exported

[clg] / examples / testgtk.lisp

diff --git a/examples/testgtk.lisp b/examples/testgtk.lisp
index 9329230fb1119a41188ddf3feecd9f7e9a9721d7..7fe07868254bdd13a4eba21d9e38dd7af7a3a305 100644 (file)
--- a/examples/testgtk.lisp
+++ b/examples/testgtk.lisp
@@ -1,5 +1,5 @@
 ;; Common Lisp bindings for GTK+ v2.0
 ;; 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
 ;;
 ;; 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
 
 ;; 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.4 2004-11-06 16:36:34 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")
 
 
 ;(use-package "GTK")


@@ -55,8 +51,8 @@      (defun ,name ()
 
 (defmacro define-simple-dialog (name (dialog title &rest initargs) &body body)
   `(define-dialog ,name (,dialog ,title 'dialog ,@initargs)
 
 (defmacro define-simple-dialog (name (dialog title &rest initargs) &body body)
   `(define-dialog ,name (,dialog ,title 'dialog ,@initargs)

-    (dialog-add-button ,dialog "Close" #'widget-destroy :object t)
-    ,@body))
+    ,@body
+    (dialog-add-button ,dialog "gtk-close" #'widget-destroy :object t)))

 
 
 
 
 
 


@@ -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
    :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 "OK")
-          :child (make-instance 'button :label "Cancel")
-          :child (make-instance 'button :label "Help"))))
+          :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
 
 (define-toplevel create-button-box (window "Button Boxes")
   (make-instance 'v-box


@@ -238,7 +233,8 @@ (define-simple-dialog create-buttons (dialog "Buttons")
                              (if (widget-visible-p button+1)
                                  (widget-hide button+1)
                                (widget-show button+1))))
                              (if (widget-visible-p button+1)
                                  (widget-hide button+1)
                                (widget-show button+1))))

-         (table-attach table button column (1+ column) row (1+ row)))))
+         (table-attach table button column (1+ column) row (1+ row)
+                       :options '(:expand :fill)))))

     (widget-show-all table)))
 
 
     (widget-show-all table)))
 
 


@@ -302,91 +298,80 @@ (defun clamp (n min-val max-val)
   (declare (number n min-val max-val))
   (max (min n max-val) min-val))
 
   (declare (number n min-val max-val))
   (max (min n max-val) min-val))
 

-

 (defun set-cursor (spinner drawing-area label)
   (let ((cursor
         (glib:int-enum
          (logand (clamp (spin-button-value-as-int spinner) 0 152) #xFE)
 (defun set-cursor (spinner drawing-area label)
   (let ((cursor
         (glib:int-enum
          (logand (clamp (spin-button-value-as-int spinner) 0 152) #xFE)

-         'gdk:cursor-type)))   
-    (setf (label-text label) (string-downcase cursor))
+         'gdk:cursor-type)))
+    (setf (label-label label) (string-downcase cursor))

     (setf (widget-cursor drawing-area) cursor)))
     (setf (widget-cursor drawing-area) cursor)))

-    

 
 

-; (define-standard-dialog create-cursors "Cursors"
-;   (setf (container-border-width main-box) 10)
-;   (setf (box-spacing main-box) 5)
-;   (let* ((hbox (hbox-new nil 0))
-;       (label (label-new "Cursor Value : "))
-;       (adj (adjustment-new 0 0 152 2 10 0))
-;       (spinner (spin-button-new adj 0 0)))
-;     (setf (container-border-width hbox) 5)
-;     (box-pack-start main-box hbox nil t 0)
-;     (setf (misc-xalign label) 0)
-;     (setf (misc-yalign label) 0.5)
-;     (box-pack-start hbox label nil t 0)
-;     (box-pack-start hbox spinner t t 0)
-
-;     (let ((frame (make-frame
-;                :shadow-type :etched-in
-;                :label-xalign 0.5
-;                :label "Cursor Area"
-;                :border-width 10
-;                :parent main-box
-;                :visible t))
-;        (drawing-area (drawing-area-new)))
-;       (setf (widget-width drawing-area) 80)
-;       (setf (widget-height drawing-area) 80)
-;       (container-add frame drawing-area)
-;       (signal-connect
-;        drawing-area 'expose-event
-;        #'(lambda (event)
-;         (declare (ignore event))
-;         (multiple-value-bind (width height)
-;             (drawing-area-size drawing-area)
-;           (let* ((drawable (widget-window drawing-area))
-;                  (style (widget-style drawing-area))
-;                  (white-gc (style-get-gc style :white))
-;                  (gray-gc (style-get-gc style :background :normal))
-;                  (black-gc (style-get-gc style :black)))
-;             (gdk:draw-rectangle
-;              drawable white-gc t 0 0 width (floor height 2))
-;             (gdk:draw-rectangle
-;              drawable black-gc t 0 (floor height 2) width (floor height 2))
-;             (gdk:draw-rectangle
-;              drawable gray-gc t (floor width 3) (floor height 3)
-;              (floor width 3) (floor height 3))))
-;           t))
-;       (setf (widget-events drawing-area) '(:exposure :button-press))
-;       (signal-connect
-;        drawing-area 'button-press-event
-;        #'(lambda (event)
-;         (when (and
-;                (eq (gdk:event-type event) :button-press)
-;                (or
-;                 (= (gdk:event-button event) 1)
-;                 (= (gdk:event-button event) 3)))
-;           (spin-button-spin
-;            spinner
-;            (if (= (gdk:event-button event) 1)
-;                :step-forward
-;              :step-backward)
-;            0)
-;           t)))
-;       (widget-show drawing-area)
-
-;     (let ((label (make-label
-;                :visible t
-;                :label "XXX"
-;                :parent main-box)))
-;       (setf (box-child-expand-p #|main-box|# label) nil)
-;       (signal-connect
-;        spinner 'changed
-;        #'(lambda ()
-;         (set-cursor spinner drawing-area label)))
-
-;       (widget-realize drawing-area)
-;       (set-cursor spinner drawing-area label)))))
+(defun cursor-expose (drawing-area event)
+  (declare (ignore event))
+  (multiple-value-bind (width height)
+      (widget-get-size-allocation drawing-area)
+    (let* ((window (widget-window drawing-area))
+          (style (widget-style drawing-area))
+          (white-gc (style-white-gc style))
+          (gray-gc (style-bg-gc style :normal))
+          (black-gc (style-black-gc style)))
+      (gdk:draw-rectangle window white-gc t 0 0 width (floor height 2))
+      (gdk:draw-rectangle window black-gc t 0 (floor height 2) width 
+                         (floor height 2))
+      (gdk:draw-rectangle window gray-gc t (floor width 3) 
+                         (floor height 3) (floor width 3) 
+                         (floor height 3))))
+  t)
+
+(define-simple-dialog create-cursors (dialog "Cursors")
+  (let ((spinner (make-instance 'spin-button 
+                 :adjustment (adjustment-new 
+                              0 0 
+                              (1- (enum-int :last-cursor 'gdk:cursor-type))
+                              2 10 0)))
+       (drawing-area (make-instance 'drawing-area
+                      :width-request 80 :height-request 80
+                      :events '(:exposure-mask :button-press-mask)))
+       (label (make-instance 'label :label "XXX")))
+
+    (signal-connect drawing-area 'expose-event #'cursor-expose :object t)
+
+    (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)))
+        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)))
+        t))
+
+    (signal-connect spinner 'changed
+     #'(lambda ()
+        (set-cursor spinner drawing-area label)))

 
 

+    (make-instance 'v-box
+     :parent dialog :border-width 10 :spacing 5 :show-all t
+     :child (list
+            (make-instance 'h-box
+             :border-width 5
+             :child (list
+                     (make-instance 'label :label "Cursor Value : ")
+                     :expand nil)
+             :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))
+
+    (widget-realize drawing-area)
+    (set-cursor spinner drawing-area label)))

 
 
 ;;; Dialog
 
 
 ;;; Dialog


@@ -428,21 +413,21 @@ (define-simple-dialog create-entry (dialog "Entry")
 ;;     (editable-insert-text entry "great " 6)
 ;;     (editable-delete-text entry 6 12)
       
 ;;     (editable-insert-text entry "great " 6)
 ;;     (editable-delete-text entry 6 12)
       

-      (let ((combo (make-instance 'combo 
+      (let ((combo (make-instance 'combo-box-entry 

                    :parent main
                    :parent main

-                   :popdown-strings '("item0"
-                                      "item1 item1"
-                                      "item2 item2 item2"
-                                      "item3 item3 item3 item3"
-                                      "item4 item4 item4 item4 item4"
-                                      "item5 item5 item5 item5 item5 item5"
-                                      "item6 item6 item6 item6 item6"
-                                      "item7 item7 item7 item7"
-                                    "item8 item8 item8"
-                                      "item9 item9"))))
-       (with-slots (entry) combo 
-         (setf (editable-text entry) "hello world")
-         (editable-select-region entry 0)))
+                   :content '("item0"
+                              "item1 item1"
+                              "item2 item2 item2"
+                              "item3 item3 item3 item3"
+                              "item4 item4 item4 item4 item4"
+                              "item5 item5 item5 item5 item5 item5"
+                              "item6 item6 item6 item6 item6"
+                              "item7 item7 item7 item7"
+                              "item8 item8 item8"
+                              "item9 item9"))))
+       (with-slots (child) combo 
+         (setf (editable-text child) "hello world")
+         (editable-select-region child 0)))

 
       (flet ((create-check-button (label slot)
               (make-instance 'check-button
 
       (flet ((create-check-button (label slot)
               (make-instance 'check-button


@@ -459,6 +444,16 @@ (define-simple-dialog create-entry (dialog "Entry")
     (widget-show-all main)))
 
 
     (widget-show-all main)))
 
 

+;; Expander
+
+(define-simple-dialog create-expander (dialog "Expander" :resizable nil)
+  (make-instance 'v-box
+   :parent dialog :spacing 5 :border-width 5 :show-all t
+   :child (create-label "Expander demo. Click on the triangle for details.")
+   :child (make-instance 'expander
+          :label "Details"
+          :child (create-label "Details can be shown or hidden."))))
+

 
 ;; File chooser dialog
 
 
 ;; File chooser dialog
 


@@ -466,136 +461,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 ()
   (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
 
        (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 (label-new "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 (label-new "Foo!")))))
-    
-;;     (container-add v-box (hseparator-new))
-;;     (container-add v-box (label-new "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
 
 
 ;;; Image
 


@@ -654,38 +547,32 @@ (define-toplevel create-labels (window "Labels" :border-width 5 :resizable nil)
 
 ;;; Layout
 
 
 ;;; Layout
 

-;; (defun layout-expose (layout event)
-;;   (with-slots (window x-offset y-offset) layout
-;;     (with-slots (x y width height) event
-;;       (let ((imin (truncate (+ x-offset x) 10))
-;;         (imax (truncate (+ x-offset x width 9) 10))
-;;         (jmin (truncate (+ y-offset y) 10))
-;;         (jmax (truncate (+ y-offset y height 9) 10)))
-;;     (declare (fixnum imin imax jmin jmax))
-;;     (gdk:window-clear-area window x y width height)
-
-;;     (let ((window (layout-bin-window layout))
-;;           (gc (style-get-gc (widget-style layout) :black)))
-;;       (do ((i imin (1+ i)))
-;;           ((= i imax))
-;;         (declare (fixnum i))
-;;         (do ((j jmin (1+ j)))
-;;             ((= j jmax))
-;;           (declare (fixnum j))
-;;           (unless (zerop (mod (+ i j) 2))
-;;             (gdk:draw-rectangle
-;;              window gc t
-;;              (- (* 10 i) x-offset) (- (* 10 j) y-offset)
-;;              (1+ (mod i 10)) (1+ (mod j 10))))))))))
-;;   t)
-
+(defun layout-expose (layout event)
+  (when (eq (gdk:event-window event) (layout-bin-window layout))
+    (with-slots (gdk:x gdk:y gdk:width gdk:height) event
+      (let ((imin (truncate gdk:x 10))
+           (imax (truncate (+ gdk:x gdk:width 9) 10))
+           (jmin (truncate gdk:y 10))
+           (jmax (truncate (+ gdk:y gdk:height 9) 10)))
+
+       (let ((window (layout-bin-window layout))
+             (gc (style-black-gc (widget-style layout))))
+         (loop
+          for i from imin below imax
+          do (loop 
+              for j from jmin below jmax
+              unless (zerop (mod (+ i j) 2))
+              do (gdk:draw-rectangle
+                  window gc t (* 10 i) (* 10 j) 
+                  (1+ (mod i 10)) (1+ (mod j 10)))))))))
+  nil)

 
 (define-toplevel create-layout (window "Layout" :default-width 200
                                                :default-height 200)
   (let ((layout (make-instance 'layout
                 :parent (make-instance 'scrolled-window :parent window)
                 :width 1600 :height 128000 :events '(:exposure-mask)
 
 (define-toplevel create-layout (window "Layout" :default-width 200
                                                :default-height 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
                 )))
 
     (with-slots (hadjustment vadjustment) layout


@@ -713,100 +600,95 @@ (define-toplevel create-layout (window "Layout" :default-width 200
 
 ;;; List    
     
 
 ;;; List    
     

-;; (define-standard-dialog create-list "List"
-;;   (let ((scrolled-window (scrolled-window-new))
-;;         (list (list-new)))
-;;     (setf (container-border-width scrolled-window) 5)
-;;     (setf (scrolled-window-scrollbar-policy scrolled-window) :automatic)
-;;     (box-pack-start main-box scrolled-window t t 0)
-;;     (setf (widget-height scrolled-window) 300)
-
-;;     (setf (list-selection-mode list) :extended)
-;;     (scrolled-window-add-with-viewport scrolled-window list)
-;;     (setf
-;;      (container-focus-vadjustment list)
-;;      (scrolled-window-vadjustment scrolled-window))
-;;     (setf
-;;      (container-focus-hadjustment list)
-;;      (scrolled-window-hadjustment scrolled-window))
+(define-simple-dialog create-list (dialog "List" :default-height 400)
+  (let* ((store (make-instance 'list-store 
+                :column-types '(string int boolean)
+                :column-names '(:foo :bar :baz)
+                :initial-content '(#("First" 12321 nil)
+                                   (:foo "Yeah" :baz t))))
+        (tree (make-instance 'tree-view :model store)))
+
+    (loop
+     with iter = (make-instance 'tree-iter)
+     for i from 1 to 1000
+     do (list-store-append store (vector "Test" i (zerop (mod i 3))) iter))
+    
+    (let ((column (make-instance 'tree-view-column :title "Column 1"))
+         (cell (make-instance 'cell-renderer-text)))
+      (cell-layout-pack column cell :expand t)
+      (cell-layout-add-attribute column cell 'text (column-index store :foo))
+      (tree-view-append-column tree column))

     
     

-;;     (with-open-file (file "clg:examples;gtktypes.lisp")
-;;       (labels ((read-file ()
-;;              (let ((line (read-line file nil nil)))
-;;                (when line
-;;                  (container-add list (list-item-new line))
-;;                  (read-file)))))
-;;     (read-file)))
-
-;;     (let ((hbox (hbox-new t 5)))
-;;       (setf (container-border-width hbox) 5)
-;;       (box-pack-start main-box hbox nil t 0)
-
-;;       (let ((button (button-new "Insert Row"))
-;;         (i 0))
-;;     (box-pack-start hbox button t t 0)
-;;     (signal-connect
-;;      button 'clicked
-;;      #'(lambda ()
-;;          (let ((item
-;;                 (list-item-new (format nil "added item ~A" (incf i)))))
-;;            (widget-show item)
-;;            (container-add list item)))))
-       
-;;       (let ((button (button-new "Clear List")))
-;;     (box-pack-start hbox button t t 0)
-;;     (signal-connect
-;;      button 'clicked #'(lambda () (list-clear-items list 0 -1))))
-
-;;       (let ((button (button-new "Remove Selection")))
-;;     (box-pack-start hbox button t t 0)
-;;     (signal-connect
-;;      button 'clicked
-;;      #'(lambda ()
-;;          (let ((selection (list-selection list)))
-;;            (if (eq (list-selection-mode list) :extended)
-;;                (let ((item (or
-;;                             (container-focus-child list)
-;;                             (first selection))))
-;;                  (when item
-;;                    (let* ((children (container-children list))
-;;                           (sel-row
-;;                            (or
-;;                             (find-if
-;;                              #'(lambda (item)
-;;                                  (eq (widget-state item) :selected))
-;;                              (member item children))
-;;                             (find-if
-;;                              #'(lambda (item)
-;;                                  (eq (widget-state item) :selected))
-;;                              (member item (reverse children))))))
-;;                      (list-remove-items list selection)
-;;                      (when sel-row
-;;                        (list-select-child list sel-row)))))
-;;              (list-remove-items list selection)))))
-;;     (box-pack-start hbox button t t 0)))
-
-;;     (let ((cbox (hbox-new nil 0)))
-;;       (box-pack-start main-box cbox nil t 0)
-
-;;       (let ((hbox (hbox-new nil 5))
-;;         (option-menu
-;;          (create-option-menu
-;;           `(("Single"
-;;              ,#'(lambda () (setf (list-selection-mode list) :single)))
-;;             ("Browse"
-;;              ,#'(lambda () (setf (list-selection-mode list) :browse)))
-;;             ("Multiple"
-;;              ,#'(lambda () (setf (list-selection-mode list) :multiple)))
-;;             ("Extended"
-;;              ,#'(lambda () (setf (list-selection-mode list) :extended))))
-;;           3)))
-
-;;     (setf (container-border-width hbox) 5)
-;;     (box-pack-start cbox hbox t nil 0)
-;;     (box-pack-start hbox (label-new "Selection Mode :") nil t 0)
-;;     (box-pack-start hbox option-menu nil t 0)))))
+    (let ((column (make-instance 'tree-view-column :title "Column 2"))
+         (cell (make-instance 'cell-renderer-text :background "orange")))
+      (cell-layout-pack column cell :expand t)
+      (cell-layout-add-attribute column cell 'text (column-index store :bar))
+      (tree-view-append-column tree column))      
+    
+    (let ((column (make-instance 'tree-view-column :title "Column 3"))
+         (cell (make-instance 'cell-renderer-text)))
+      (cell-layout-pack column cell :expand t)
+      (cell-layout-add-attribute column cell 'text (column-index store :baz))
+      (tree-view-append-column tree column))      

 
 

+    (make-instance 'v-box
+     :parent dialog :border-width 10 :spacing 10 :show-all t
+     :child (list
+            (make-instance 'h-box
+              :spacing 10
+             :child (make-instance 'button
+                     :label "Remove Selection"
+                     :signal (list 'clicked
+                              #'(lambda ()
+                                  (let ((references
+                                         (mapcar
+                                          #'(lambda (path)
+                                              (make-instance 'tree-row-reference :model store :path path))                                       
+                                          (tree-selection-get-selected-rows
+                                           (tree-view-selection tree)))))
+                                    (mapc
+                                     #'(lambda (reference)
+                                         (list-store-remove store reference))
+                                     references))))))
+            :expand nil)
+     :child (list
+            (make-instance 'h-box
+              :spacing 10
+             :child (make-instance 'check-button 
+                     :label "Show Headers" :active t
+                     :signal (list 'toggled
+                              #'(lambda (button)
+                                  (setf
+                                   (tree-view-headers-visible-p tree)
+                                   (toggle-button-active-p button)))
+                              :object t))
+             :child (make-instance 'check-button 
+                     :label "Reorderable" :active nil
+                     :signal (list 'toggled
+                              #'(lambda (button)
+                                  (setf
+                                   (tree-view-reorderable-p tree)
+                                   (toggle-button-active-p button)))
+                              :object t))
+             :child (list 
+                     (make-instance 'h-box
+                       :child (make-instance 'label :label "Selection Mode: ")
+                      :child (make-instance 'combo-box
+                              :content '("Single" "Browse" "Multiple") 
+                              :active 0
+                              :signal (list 'changed
+                                       #'(lambda (combo-box)
+                                           (setf 
+                                            (tree-selection-mode 
+                                             (tree-view-selection tree))
+                                            (svref 
+                                             #(:single :browse :multiple)
+                                             (combo-box-active combo-box))))
+                                       :object t)))
+                     :expand nil))
+            :expand nil)
+     :child (make-instance 'scrolled-window 
+           :child tree :hscrollbar-policy :automatic))))

 
 
 ;; Menus
 
 
 ;; Menus


@@ -823,14 +705,16 @@ (defun create-menu (depth tearoff)
                 (make-instance 'radio-menu-item
                  :label (format nil "item ~2D - ~D" depth (1+ i)))))
            (if group
                 (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))
              (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)))
 
 
       menu)))
 
 


@@ -838,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))))
   (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"))))
 
     (let ((menu-item (make-instance 'menu-item 
                      :label (format nil "test~%line2"))))


@@ -854,43 +738,20 @@ (define-simple-dialog create-menus (dialog "Menus" :default-width 200)
       (setf (menu-item-right-justified-p menu-item) t)
       (menu-shell-append menubar menu-item))
 
       (setf (menu-item-right-justified-p menu-item) t)
       (menu-shell-append menubar menu-item))
 

-    (let ((box2 (make-instance 'v-box 
-                :spacing 10 :border-width 10 :parent main))
-         (menu (create-menu 1 nil)))
-      
-;      (setf (menu-accel-group menu) accel-group)
-
-      (let ((menu-item (make-instance 'check-menu-item
-                       :label "Accelerate Me")))
-       (menu-shell-append menu menu-item)
-;;         (widget-add-accelerator
-;;          menu-item 'activate accel-group "F1" '() '(:visible :signal-visible))
-       )
-    
-      (let ((menu-item (make-instance 'check-menu-item
-                       :label "Accelerator Locked")))
-       (menu-shell-append menu menu-item)
-;;         (widget-add-accelerator
-;;          menu-item 'activate accel-group "F2" '() '(:visible :locked))
-       )
-    
-      (let ((menu-item (make-instance 'check-menu-item
-                       :label "Accelerator Frozen")))
-       (menu-shell-append menu menu-item)
-;;         (widget-add-accelerator
-;;          menu-item 'activate accel-group "F2" '() '(:visible))
-;;         (widget-add-accelerator
-;;          menu-item 'activate accel-group "F3" '() '(:visible))
-;;         (widget-lock-accelerators menuitem)
-       )
+    (make-instance 'v-box 
+     :spacing 10 :border-width 10 :parent main
+     :child (make-instance 'combo-box 
+            :active 3
+            :content (loop
+                      for i from 1 to 5
+                      collect (format nil "Item ~D" i))))

       
       

-    (make-instance 'option-menu :parent box2 :menu menu :history 3)
-    (widget-show-all main))))
+    (widget-show-all main)))

 
 
 ;;; Notebook
 
 
 
 ;;; 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 
   (let* ((title (format nil "Page ~D" page-num))
         (page (make-instance 'frame :label title :border-width 10))
         (v-box (make-instance 'v-box 


@@ -932,12 +793,12 @@ (defun create-notebook-page (notebook page-num)
     (let ((label-box (make-instance 'h-box 
                      :show-all t
                      :child-args '(:expand nil)
     (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 '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)
                     :child (make-instance 'label :label title))))
 
       (widget-show-all page)


@@ -946,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)))
 
 (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)))
                     :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))
        (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)))
               (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))
        
 
       (make-instance 'h-separator :parent (list main :expand nil :padding 10))
        


@@ -994,35 +856,33 @@ (define-simple-dialog create-notebook (dialog "Notebook")
        :child-args '(:expand nil)
        :child (make-instance 'label :label "Notebook Style: ")
        :child (let ((scrollable-p nil)) 
        :child-args '(:expand nil)
        :child (make-instance 'label :label "Notebook Style: ")
        :child (let ((scrollable-p nil)) 

-               (create-option-menu
-                `(("Standard"
-                   ,#'(lambda (menu-item)                      
-                        (declare (ignore menu-item))
-                        (setf (notebook-show-tabs-p notebook) t)
-                        (when scrollable-p
-                          (setq scrollable-p nil)
-                          (setf (notebook-scrollable-p notebook) nil)
-                          (loop repeat 10 
-                           do (notebook-remove-page notebook 5)))))
-                  ("No tabs"
-                   ,#'(lambda (menu-item)                      
-                        (declare (ignore menu-item))
-                        (setf (notebook-show-tabs-p notebook) nil)
-                        (when scrollable-p
-                          (setq scrollable-p nil)
-                          (setf (notebook-scrollable-p notebook) nil)  
-                          (loop repeat 10 
-                           do (notebook-remove-page notebook 5)))))
-                  ("Scrollable"
-                   ,#'(lambda (menu-item)                      
-                        (declare (ignore menu-item))
-                        (unless scrollable-p
-                          (setq scrollable-p t)
-                          (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))))))
-                0))
+               (make-instance 'combo-box
+                :content '("Standard" "No tabs" "Scrollable") :active 0
+                :signal (list 'changed
+                         #'(lambda (combo-box)
+                             (case (combo-box-active combo-box)
+                               (0 
+                                (setf (notebook-show-tabs-p notebook) t)
+                                (when scrollable-p
+                                  (setq scrollable-p nil)
+                                  (setf (notebook-scrollable-p notebook) nil)
+                                  (loop repeat 10 
+                                   do (notebook-remove-page notebook 5))))
+                               (1
+                                (setf (notebook-show-tabs-p notebook) nil)
+                                (when scrollable-p
+                                  (setq scrollable-p nil)
+                                  (setf (notebook-scrollable-p notebook) nil)
+                                  (loop repeat 10 
+                                    do (notebook-remove-page notebook 5))))
+                               (2
+                                (unless scrollable-p
+                                  (setq scrollable-p t)
+                                  (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 book-closed))))))
+                         :object t)))

        :child (make-instance 'button
               :label "Show all Pages"
               :signal (list 'clicked
        :child (make-instance 'button
               :label "Show all Pages"
               :signal (list 'clicked


@@ -1053,64 +913,40 @@ (define-simple-dialog create-notebook (dialog "Notebook")
 ;;; Panes
 
 (defun toggle-resize (child)
 ;;; 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)
 
 (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)
 
 (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)))
-
-    (table-attach table (label-new label1) 0 1 0 1)
+  (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")))
     (let ((check-button (make-instance 'check-button :label "Resize")))

-      (table-attach table check-button 0 1 1 2)
-      (signal-connect
-       check-button 'toggled #'toggle-resize :object (paned-child1 paned)))
-    (let ((check-button (make-instance 'check-button :label "Shrink")))
-      (table-attach table check-button 0 1 2 3)
-      (setf (toggle-button-active-p check-button) t)
-      (signal-connect
-       check-button 'toggled #'toggle-shrink :object (paned-child1 paned)))
-
-    (table-attach table (label-new label2) 1 2 0 1)
-    (let ((check-button (make-instance 'check-button :label "Resize")))
-      (table-attach table check-button 1 2 1 2)
-      (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")))
-      (table-attach table check-button 1 2 2 3)
-      (setf (toggle-button-active-p check-button) t)
-      (signal-connect
-       check-button 'toggled #'toggle-shrink :object (paned-child2 paned)))
-    frame))
+      (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" :active t)))
+      (table-attach table check-button 0 1 2 3 :options '(:expand :fill))
+      (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" :active t)))
+      (table-attach table check-button 1 2 1 2 :options '(:expand :fill))
+      (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))
+      (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 
 
 (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 (button-new "Hi there"))
+                          :child (make-instance 'button :label "Hi there"))

                  :child2 (make-instance 'frame                     
                           :width-request 80 :height-request 60
                           :shadow-type :in)))
                  :child2 (make-instance 'frame                     
                           :width-request 80 :height-request 60
                           :shadow-type :in)))


@@ -1131,7 +967,29 @@ (define-toplevel create-panes (window "Panes")
 
 ;;; Progress bar
 
 
 ;;; 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
 
 
 ;;; Radio buttons


@@ -1139,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
 (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
 
 
 ;;; Rangle controls


@@ -1160,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))
 (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))
 
     (flet ((create-frame (title)
             (let* ((frame (make-instance 'frame :label title :parent main))


@@ -1189,18 +1049,19 @@ (define-toplevel create-rulers (window "Rulers"
    (widget-events window) 
    '(:pointer-motion-mask :pointer-motion-hint-mask))
 
    (widget-events window) 
    '(:pointer-motion-mask :pointer-motion-hint-mask))
 

-  (let ((table (make-instance 'table :n-rows 2 :n-columns 2 :parent window)))
-    (let ((ruler (make-instance 'h-ruler
+  (let ((table (make-instance 'table :n-rows 2 :n-columns 2 :parent window))
+       (h-ruler (make-instance 'h-ruler

                  :metric :centimeters :lower 100.0d0 :upper 0.0d0
                  :metric :centimeters :lower 100.0d0 :upper 0.0d0

-                 :position 0.0d0 :max-size 20.0d0)))
-      (signal-connect window 'motion-notify-event #'widget-event :object ruler)
-      (table-attach table ruler 1 2 0 1 :y-options '(:fill)))
-    (let ((ruler (make-instance 'v-ruler
+                 :position 0.0d0 :max-size 20.0d0))
+       (v-ruler (make-instance 'v-ruler

                  :lower 5.0d0 :upper 15.0d0 
                  :position 0.0d0 :max-size 20.0d0)))
                  :lower 5.0d0 :upper 15.0d0 
                  :position 0.0d0 :max-size 20.0d0)))

-      (signal-connect window 'motion-notify-event #'widget-event :object ruler)
-      (table-attach table ruler 0 1 1 2 :x-options '(:fill)))))
-
+    (signal-connect window 'motion-notify-event
+     #'(lambda (event)
+        (widget-event h-ruler event)
+        (widget-event v-ruler event)))
+    (table-attach table h-ruler 1 2 0 1 :options :fill :x-options :expand)
+    (table-attach table v-ruler 0 1 1 2 :options :fill :y-options :expand)))

 
 
 ;;; Scrolled window
 
 
 ;;; Scrolled window


@@ -1229,6 +1090,42 @@ (define-simple-dialog create-scrolled-windows (dialog "Scrolled windows"
       (widget-show-all scrolled-window)))
 
 
       (widget-show-all scrolled-window)))
 
 

+;;; Size group
+
+(define-simple-dialog create-size-group (dialog "Size Group" :resizable nil)
+  (let ((size-group (make-instance 'size-group)))
+    (flet ((create-frame (label rows)
+            (let ((table (make-instance 'table 
+                          :n-rows (length rows) :n-columns 2 :homogeneous nil
+                          :row-spacing 5 :column-spacing 10 :border-width 5)))
+              (loop
+               for row in rows
+               for i from 0
+               do (table-attach table 
+                   (create-label (first row) :xalign 0 :yalign 1)
+                   0 1 i (1+ i) :x-options '(:expand :fill))
+                  (let ((combo (make-instance 'combo-box 
+                                :content (rest row) :active 0)))
+                    (size-group-add-widget size-group combo)
+                    (table-attach table combo 1 2 i (1+ i))))
+              (make-instance 'frame :label label :child table))))
+
+      (make-instance 'v-box
+       :parent dialog :border-width 5 :spacing 5 :show-all t
+       :child (create-frame "Color Options"
+              '(("Foreground" "Red" "Green" "Blue")
+                ("Background" "Red" "Green" "Blue")))
+       :child (create-frame "Line Options"
+              '(("Dashing" "Solid" "Dashed" "Dotted")
+                ("Line ends" "Square" "Round" "Arrow")))
+       :child (create-check-button "Enable grouping"
+              #'(lambda (active)
+                  (setf 
+                   (size-group-mode size-group) 
+                   (if active :horizontal :none)))
+              t)))))
+
+

 ;;; Shapes
 
 ;; (defun shape-create-icon (xpm-file x y px py type root-window destroy)
 ;;; Shapes
 
 ;; (defun shape-create-icon (xpm-file x y px py type root-window destroy)


@@ -1454,96 +1351,157 @@ (define-toplevel create-statusbar (window "Statusbar")
 
 ;;; Idle test
 
 
 ;;; Idle test
 

-;; (define-standard-dialog create-idle-test "Idle Test"
-;;   (let* ((container (make-instance 'hbox :parent main-box))
-;;      (label (make-instance 'label
-;;              :label "count: 0" :xpad 10 :ypad 10 :parent container))
-;;      (idle nil)
-;;      (count 0))
-;;     (declare (fixnum count))
-;;     (signal-connect
-;;      window 'destroy #'(lambda () (when idle (idle-remove idle))))
+(define-simple-dialog create-idle-test (dialog "Idle Test")
+  (let ((label (make-instance 'label
+               :label "count: 0" :xpad 10 :ypad 10))
+       (idle nil)
+       (count 0))
+    (signal-connect dialog 'destroy 
+     #'(lambda () (when idle (idle-remove idle))))

  
  

-;;     (make-instance 'frame
-;;      :label "Label Container" :border-width 5 :parent main-box
-;;      :child
-;;      (make-instance 'v-box
-;;       :children
-;;       (create-radio-button-group
-;;        '(("Resize-Parent" :parent)
-;;      ("Resize-Queue" :queue)
-;;      ("Resize-Immediate" :immediate))
-;;        0
-;;        '(setf container-resize-mode) container)))
-
-;;     (make-instance 'button
-;;      :label "start" :can-default t :parent action-area
-;;      :signals
-;;      (list
-;;       (list
-;;        'clicked
-;;        #'(lambda ()
-;;        (unless idle
-;;          (setq
-;;           idle
-;;           (idle-add
-;;            #'(lambda ()
-;;                (incf count)
-;;                (setf (label-label label) (format nil "count: ~D" count))
-;;                t))))))))
+    (make-instance 'v-box
+     :parent dialog :border-width 10 :spacing 10 :show-all t
+     :child label
+     :child (make-instance 'frame
+            :label "Label Container" :border-width 5
+            :child(make-instance 'v-box
+                  :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))))))
+
+    (dialog-add-button dialog "Start"
+     #'(lambda ()
+        (unless idle
+          (setq idle
+           (idle-add
+            #'(lambda ()
+                (incf count)
+                (setf (label-label label) (format nil "count: ~D" count))
+                t))))))

       
       

-;;     (make-instance 'button
-;;      :label "stop" :can-default t :parent action-area
-;;      :signals
-;;      (list
-;;       (list
-;;        'clicked
-;;        #'(lambda ()
-;;        (when idle
-;;          (idle-remove idle)
-;;          (setq idle nil))))))))
+    (dialog-add-button dialog "Stop"
+     #'(lambda ()
+        (when idle
+          (idle-remove idle)
+          (setq idle nil))))))

     
 
 
 ;;; Timeout test
 
     
 
 
 ;;; Timeout test
 

-;; (define-standard-dialog create-timeout-test "Timeout Test"
-;;   (let ((label (make-instance 'label
-;;             :label "count: 0" :xpad 10 :ypad 10 :parent main-box))
-;;     (timer nil)
-;;     (count 0))
-;;     (declare (fixnum count))
-;;     (signal-connect
-;;      window 'destroy #'(lambda () (when timer (timeout-remove timer))))
-          
-;;     (make-instance 'button
-;;      :label "start" :can-default t :parent action-area
-;;      :signals
-;;      (list
-;;       (list
-;;        'clicked
-;;        #'(lambda ()
-;;        (unless timer
-;;          (setq
-;;           timer
-;;           (timeout-add
-;;            100
-;;            #'(lambda ()
-;;                (incf count)
-;;                (setf (label-label label) (format nil "count: ~D" count))
-;;                t))))))))
-
-;;     (make-instance 'button
-;;      :label "stop" :can-default t :parent action-area
-;;      :signals
-;;      (list
-;;       (list
-;;        'clicked
-;;        #'(lambda ()
-;;        (when timer
-;;          (timeout-remove timer)
-;;          (setq timer nil))))))))
-  
+(define-simple-dialog create-timeout-test (dialog "Timeout Test")
+  (let ((label (make-instance 'label
+               :label "count: 0" :xpad 10 :ypad 10 :parent dialog :visible t))
+       (timer nil)
+       (count 0))
+    (signal-connect dialog 'destroy 
+     #'(lambda () (when timer (timeout-remove timer))))
+
+    (dialog-add-button dialog "Start"
+     #'(lambda ()
+        (unless timer
+          (setq timer
+           (timeout-add 100
+            #'(lambda ()
+                (incf count)
+                (setf (label-label label) (format nil "count: ~D" count))
+                t))))))
+
+    (dialog-add-button dialog "Stop"
+     #'(lambda ()
+        (when timer
+          (timeout-remove timer)
+          (setq timer nil))))))
+
+
+;;; Text
+
+(define-simple-dialog create-text (dialog "Text" :default-width 400
+                                                :default-height 400)
+  (let* ((text-view (make-instance 'text-view 
+                    :border-width 10 :visible t :wrap-mode :word))
+        (buffer (text-view-buffer text-view))
+        (active-tags ()))
+
+    (text-buffer-create-tag buffer "Bold" :weight :bold)
+    (text-buffer-create-tag buffer "Italic" :style :italic)
+    (text-buffer-create-tag buffer "Underline" :underline :single)
+    
+    (flet ((create-toggle-callback (tag-name)
+            (let ((tag (text-tag-table-lookup 
+                        (text-buffer-tag-table buffer) tag-name)))
+              #'(lambda (active)
+                  (unless (eq (and (find tag active-tags) t) active)
+                    ;; user activated
+                    (if active 
+                        (push tag active-tags)
+                      (setq active-tags (delete tag active-tags)))
+                    (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))))))))
+
+      (let* ((actions 
+             (make-instance 'action-group 
+              :action (create-toggle-action 
+                       "Bold" "gtk-bold" "Bold" "<control>B" "Bold" nil
+                       (create-toggle-callback "Bold"))
+              :action (create-toggle-action 
+                       "Italic" "gtk-italic" "Italic" "<control>I" "Italic" nil
+                       (create-toggle-callback "Italic"))
+              :action (create-toggle-action 
+                       "Underline" "gtk-underline" "Underline" "<control>U" "Underline" nil
+                       (create-toggle-callback "Underline"))))
+            (ui (make-instance 'ui-manager)))
+      
+       (ui-manager-insert-action-group ui actions)
+       (ui-manager-add-ui ui 
+        '((:toolbar "ToolBar"
+           (:toolitem "Bold")
+           (:toolitem "Italic")
+           (:toolitem "Underline"))))
+
+       ;; Callback to activate/deactivate toolbar buttons when cursor
+       ;; is moved
+       (signal-connect buffer 'mark-set
+        #'(lambda (location mark)
+            (declare (ignore mark))
+            (text-tag-table-foreach (text-buffer-tag-table buffer)
+             #'(lambda (tag)
+                 (let ((active
+                        (or 
+                         (and
+                          (text-iter-has-tag-p location tag)
+                          (not (text-iter-begins-tag-p location tag)))
+                         (text-iter-ends-tag-p location tag))))
+                   (unless (eq active (and (find tag active-tags) t))
+                     (if active 
+                         (push tag active-tags)
+                       (setq active-tags (delete tag active-tags)))
+                     (setf 
+                      (toggle-action-active-p
+                       (action-group-get-action actions (text-tag-name tag)))
+                      active)))))))
+
+       ;; Callback to apply active tags when a character is inserted
+       (signal-connect buffer 'insert-text
+         #'(lambda (iter &rest args)
+            (declare (ignore args))
+            (let ((before (text-buffer-get-iter-at-offset buffer 
+                           (1- (text-iter-offset iter)))))
+              (loop
+               for tag in active-tags
+               do (text-buffer-apply-tag buffer tag before iter))))
+        :after t)
+       
+       (container-add dialog (ui-manager-get-widget ui "/ToolBar") :expand nil)
+       (container-add dialog text-view)))))
+

 
 ;;; Toggle buttons
 
 
 ;;; Toggle buttons
 


@@ -1559,175 +1517,185 @@ (define-simple-dialog create-toggle-buttons (dialog "Toggle Button")
 
 ;;; Toolbar test
 
 
 ;;; 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)))

 
 
 
 ;;; Tooltips test
 
 
 
 
 ;;; Tooltips test
 

-;; (define-standard-dialog create-tooltips "Tooltips"
-;;   (setf
-;;    (window-allow-grow-p window) t
-;;    (window-allow-shrink-p window) nil
-;;    (window-auto-shrink-p window) t
-;;    (widget-width window) 200
-;;    (container-border-width main-box) 10
-;;    (box-spacing main-box) 10)
-
-;;   (let ((tooltips (tooltips-new)))
-;;     (flet ((create-button (label tip-text tip-private)
-;;          (let ((button (make-instance 'toggle-button
-;;                 :label label :parent main-box)))
-;;            (tooltips-set-tip tooltips button tip-text tip-private)
-;;            button)))
-;;       (create-button "button1" "This is button 1" "ContextHelp/button/1")
-;;       (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")
-
-;;       (let* ((toggle (create-button "Override TipSQuery Label"
-;;                                 "Toggle TipsQuery view" "Hi msw! ;)"))
-;;          (box (make-instance 'v-box
-;;                :homogeneous nil :spacing 5 :border-width 5
-;;                :parent (make-instance 'frame
-;;                         :label "ToolTips Inspector"
-;;                         :label-xalign 0.5 :border-width 0
-;;                         :parent main-box)))
-;;          (button (make-instance 'button :label "[?]" :parent box))
-;;          (tips-query (make-instance 'tips-query
-;;                       :caller button :parent box)))
-
-;;     (signal-connect
-;;      button 'clicked #'tips-query-start-query :object tips-query)
-       
-;;     (signal-connect
-;;      tips-query 'widget-entered
-;;      #'(lambda (widget tip-text tip-private)
-;;          (declare (ignore widget tip-private))
-;;          (when (toggle-button-active-p toggle)
-;;            (setf
-;;             (label-label tips-query)
-;;             (if tip-text
-;;                 "There is a Tip!"
-;;               "There is no Tip!"))
-;;            (signal-emit-stop tips-query 'widget-entered))))
-       
-;;     (signal-connect
-;;      tips-query 'widget-selected
-;;      #'(lambda (widget tip-text tip-private event)
-;;          (declare (ignore tip-text event))
-;;          (when widget
-;;            (format
-;;             t "Help ~S requested for ~S~%"
-;;             (or tip-private "None") (type-of widget)))
-;;          t))
+(define-simple-dialog create-tooltips (dialog "Tooltips" :default-width 200)
+  (let ((tooltips (make-instance 'tooltips)))
+    (flet ((create-button (label tip-text tip-private)
+            (let ((button (make-instance 'toggle-button :label label)))
+              (tooltips-set-tip tooltips button tip-text tip-private)
+              button)))
+      (make-instance 'v-box
+       :parent dialog :border-width 10 :spacing 10 :show-all t
+       :child (create-button "button1" "This is button 1" "ContextHelp/button/1")
+       :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
+
+(defvar *ui-description*
+  '((:menubar "MenuBar"
+     (:menu "FileMenu"
+      (:menuitem "New")
+      (:menuitem "Open")
+      (:menuitem "Save")
+      (:menuitem "SaveAs")
+      :separator
+      (:menuitem "Quit"))
+     (:menu "PreferencesMenu"
+       (:menu "ColorMenu"
+       (:menuitem "Red")
+       (:menuitem "Green")
+       (:menuitem "Blue"))
+       (:menu "ShapeMenu"
+        (:menuitem "Square")
+        (:menuitem "Rectangle")
+        (:menuitem "Oval"))
+       (:menuitem "Bold"))
+     (:menu "HelpMenu"
+      (:menuitem "About")))
+    (:toolbar "ToolBar"
+     (:toolitem "Open")
+     (:toolitem "Quit")
+     (:separator "Sep1")
+     (:toolitem "Logo"))))
+
+(define-toplevel create-ui-manager (window "UI Manager")
+  (let ((actions 
+        (make-instance 'action-group 
+         :name "Actions"
+         :action (create-action "FileMenu" nil "_File")
+         :action (create-action "PreferencesMenu" nil "_Preferences")
+         :action (create-action "ColorMenu" nil "_Color")
+         :action (create-action "ShapeMenu" nil "_Shape")
+         :action (create-action "HelpMenu" nil "_Help")
+         :action (create-action "New" "gtk-new" "_New" "<control>N" "Create a new file")
+         :action (create-action "Open" "gtk-open" "_Open" "<control>O" "Open a file" #'create-file-chooser)
+         :action (create-action "Save" "gtk-save" "_Save" "<control>S" "Save current file")
+         :action (create-action "SaveAs" "gtk-save" "Save _As..." "" "Save to a file")
+         :action (create-action "Quit" "gtk-quit" "_Quit" "<control>Q" "Quit" (list #'widget-destroy :object window))
+         :action (create-action "About" nil "_About" "<control>A" "About")
+         :action (create-action "Logo" "demo-gtk-logo" "" nil "GTK+")
+         :action (create-toggle-action "Bold" "gtk-bold" "_Bold" "<control>B" "Bold" t)
+         :actions (create-radio-actions
+                   '(("Red" nil "_Red" "<control>R" "Blood")
+                     ("Green" nil "_Green" "<control>G" "Grass")
+                     ("Blue" nil "_Blue" "<control>B" "Sky"))
+                   "Green")
+         :actions (create-radio-actions
+                   '(("Square" nil "_Square" "<control>S" "Square")
+                     ("Rectangle" nil "_Rectangle" "<control>R" "Rectangle")
+                     ("Oval" nil "_Oval" "<control>O" "Egg")))))
+       (ui (make-instance 'ui-manager)))
+  
+    (ui-manager-insert-action-group ui actions)
+    (ui-manager-add-ui ui *ui-description*)

 
 

-;;     (tooltips-set-tip
-;;      tooltips button "Start the Tooltip Inspector" "ContextHelp/buttons/?")
-;;     (tooltips-set-tip
-;;      tooltips close-button "Push this button to close window"
-;;      "ContextHelp/buttons/Close")))))
+    (window-add-accel-group window (ui-manager-accel-group ui))
+    
+    (make-instance 'v-box 
+     :parent window :show-all t
+     :child (list 
+            (ui-manager-get-widget ui "/MenuBar")
+            :expand nil :fill nil)
+     :child (list 
+            (ui-manager-get-widget ui "/ToolBar")
+            :expand nil :fill nil)
+     :child (make-instance 'label
+            :label "Type <alt> to start" 
+            :xalign 0.5 :yalign 0.5
+            :width-request 200 :height-request 200))))

                  
 
 
                  
 
 


@@ -1742,29 +1710,25 @@ (defun create-main-window ()
            ("buttons" create-buttons)
            ("calendar" create-calendar)
            ("check buttons" create-check-buttons)
            ("buttons" create-buttons)
            ("calendar" create-calendar)
            ("check buttons" create-check-buttons)

-;;         ("clist" #|create-clist|#)

            ("color selection" create-color-selection)
            ("color selection" create-color-selection)

-;;         ("ctree" #|create-ctree|#)
-;;         ("cursors" #|create-cursors|#)
+           ("cursors" create-cursors)

            ("dialog" create-dialog)
 ;; ;       ("dnd")
            ("entry" create-entry)
 ;;         ("event watcher")
            ("dialog" create-dialog)
 ;; ;       ("dnd")
            ("entry" create-entry)
 ;;         ("event watcher")

+           ("enxpander" create-expander)

            ("file chooser" create-file-chooser)
 ;;         ("font selection")
            ("file chooser" create-file-chooser)
 ;;         ("font selection")

-;;         ("handle box" create-handle-box)
+           ("handle box" create-handle-box)

            ("image" create-image)
            ("image" create-image)

-;;         ("item factory")

            ("labels" create-labels)
            ("layout" create-layout)
            ("labels" create-labels)
            ("layout" create-layout)

-;;         ("list" create-list)
+           ("list" create-list)

            ("menus" create-menus)
 ;;         ("modal window")
            ("notebook" create-notebook)
            ("panes" create-panes)
            ("menus" create-menus)
 ;;         ("modal window")
            ("notebook" create-notebook)
            ("panes" create-panes)

-;;         ("preview color")
-;;         ("preview gray")
-;;         ("progress bar" #|create-progress-bar|#)
+           ("progress bar" create-progress-bar)

            ("radio buttons" create-radio-buttons)
            ("range controls" create-range-controls)
 ;;         ("rc file")
            ("radio buttons" create-radio-buttons)
            ("range controls" create-range-controls)
 ;;         ("rc file")


@@ -1772,19 +1736,21 @@ (defun create-main-window ()
            ("rulers" create-rulers)
 ;;         ("saved position")
            ("scrolled windows" create-scrolled-windows)
            ("rulers" create-rulers)
 ;;         ("saved position")
            ("scrolled windows" create-scrolled-windows)

+           ("size group" create-size-group)

 ;;         ("shapes" create-shapes)
            ("spinbutton" create-spins)
            ("statusbar" create-statusbar)
 ;;         ("shapes" create-shapes)
            ("spinbutton" create-spins)
            ("statusbar" create-statusbar)

-;;         ("test idle" create-idle-test)
+           ("test idle" create-idle-test)

 ;;         ("test mainloop")
 ;;         ("test scrolling")
 ;;         ("test selection")
 ;;         ("test mainloop")
 ;;         ("test scrolling")
 ;;         ("test selection")

-;;         ("test timeout" create-timeout-test)
-;;         ("text" #|create-text|#)
+           ("test timeout" create-timeout-test)
+           ("text" create-text)

            ("toggle buttons" create-toggle-buttons)
            ("toggle buttons" create-toggle-buttons)

-           ("toolbar" create-toolbar)
-;;         ("tooltips" create-tooltips)
+           ("toolbar" create-toolbar-window)
+           ("tooltips" create-tooltips)

 ;;         ("tree" #|create-tree|#)
 ;;         ("tree" #|create-tree|#)

+           ("UI manager" create-ui-manager)

 ))
        (main-window (make-instance 'window
                      :title "testgtk.lisp" :name "main_window"
 ))
        (main-window (make-instance 'window
                      :title "testgtk.lisp" :name "main_window"


@@ -1799,6 +1765,11 @@ (defun create-main-window ()
                       :signal (list 'clicked #'widget-destroy 
                                     :object 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
     ;; Main box
     (make-instance 'v-box
      :parent main-window