anchor.diff:  ;;; Button box
   
   (defun create-bbox-in-frame (class frame-label spacing width height layout)
  -    (make-instance 'frame
  -     :label frame-label
  -     :child (make-instance class
  -	     :border-width 5 :layout layout :spacing spacing
  -	     :child-min-width width :child-min-height height
  -	     :children
  -	     (list
  -	      (button-new "OK")
  -	      (button-new "Cancel")
  -	      (button-new "Help")))))
  -
  -(define-test-window create-button-box "Button Boxes"
  -  (setf (container-border-width window) 10)
  -  (make-instance 'vbox
  -   :parent window
  -   :children
  -   (list
  -    (list
  -     (make-instance 'frame
  -      :label  "Horizontal Button Boxes"
  -      :child
  -      (make-instance 'vbox
  -       :border-width 10
  -       :children
  -       (mapcar
  -	#'(lambda (args)
  -	    (list (apply #'create-bbox-in-frame 'hbutton-box args) :padding 5))
  -	'(("Spread" 40 85 20 :spread) ("Edge" 40 85 20 :edge)
  -	  ("Start" 40 85 20 :start) ("End" 40 85 20 :end)))))
  -     :padding 10)
  -
  -    (list
  -     (make-instance 'frame
  -      :label "Vertical Button Boxes"
  -      :child
  -      (make-instance 'hbox
  -       :border-width 10
  -       :children
  -       (mapcar
  -	#'(lambda (args)
  -	    (list (apply #'create-bbox-in-frame 'vbutton-box args) :padding 5))
  -	'(("Spread" 30 85 20 :spread) ("Edge" 30 85 20 :edge)
  -	  ("Start" 30 85 20 :start) ("End" 30 85 20 :end)))))
  -     :padding 10))))
  +  (declare (ignore width height))
  +  (make-instance 'frame
  +   :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"))))
  +
  +(define-toplevel create-button-box (window "Button Boxes")
  +  (make-instance 'v-box
  +   :parent window :border-width 10 :spacing 10 :show-all t
  +   :child (make-instance 'frame
  +	   :label "Horizontal Button Boxes"
  +	   :child (make-instance 'v-box
  +		   :border-width 10 :spacing 10
  +		   :children (mapcar	
  +			      #'(lambda (args)
  +				  (apply #'create-bbox-in-frame 
  +				   'h-button-box args))
  +			      '(("Spread" 40 85 20 :spread) 
  +				("Edge" 40 85 20 :edge)
  +				("Start" 40 85 20 :start) 
  +				("End" 40 85 20 :end)))))
  +   :child (make-instance 'frame
  +	   :label "Vertical Button Boxes"
  +	   :child (make-instance 'h-box
  +		   :border-width 10 :spacing 10
  +		   :children (mapcar
  +			      #'(lambda (args)
  +				  (apply #'create-bbox-in-frame
  +				   'v-button-box args))
  +			      '(("Spread" 30 85 20 :spread) 
  +				("Edge" 30 85 20 :edge)
  +				("Start" 30 85 20 :start) 
  +				("End" 30 85 20 :end)))))))
   
   
   ;; Buttons
   
  -(define-standard-dialog create-buttons "Buttons" 
  +(define-simple-dialog create-buttons (dialog "Buttons")
     (let ((table (make-instance 'table
  -	        :rows 3 :columns 3 :homogeneous nil
  +	        :n-rows 3 :n-columns 3 :homogeneous nil
   		:row-spacing 5 :column-spacing 5 :border-width 10
  -		:parent main-box))
  -	(buttons (make-array 0 :adjustable t :fill-pointer t)))
  -    (dotimes (n 9)
  -      (vector-push-extend
  -       (button-new (format nil "button~D" (1+ n)))  buttons))
  +		:parent dialog))
  +	  (buttons (loop
  +		    for n from 1 to 10
  +		    collect (make-instance 'button 
  +			     :label (format nil "button~D" (1+ n))))))
  +
       (dotimes (column 3)
         (dotimes (row 3)
  -	(let ((button (aref buttons (+ (* 3 row) column)))
  -	      (button+1 (aref buttons (mod (+ (* 3 row) column 1) 9))))
  +	(let ((button (nth (+ (* 3 row) column) buttons))
  +	      (button+1 (nth (mod (+ (* 3 row) column 1) 9) buttons)))
   	  (signal-connect button 'clicked
   			  #'(lambda ()
   			      (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)))))
  +    (widget-show-all table)))
   
   
   ;; Calenadar
   
  -(define-standard-dialog create-calendar "Calendar"
  -  (setf (container-border-width main-box) 10)
  -  (make-instance 'calendar :parent main-box))
  +(define-simple-dialog create-calendar (dialog "Calendar")
  +  (make-instance 'v-box
  +   :parent dialog :border-width 10 :show-all t
  +   :child (make-instance 'calendar)))
   
   
   ;;; Check buttons
   
  -(define-standard-dialog create-check-buttons "Check Buttons"
  -  (setf (container-border-width main-box) 10)
  -  (setf (box-spacing main-box) 10)
  -  (dotimes (n 3)
  -    (make-instance 'check-button
  -     :label (format nil "Button~D" (1+ n))
  -     :parent main-box)))
  +(define-simple-dialog create-check-buttons (dialog "Check Buttons")
  +  (make-instance 'v-box
  +   :border-width 10 :spacing 10 :parent dialog :show-all t
  +   :children (loop
  +	      for n from 1 to 3
  +	      collect (make-instance 'check-button
  +		       :label (format nil "Button~D" n)))))
   
   
   
   ;;; Color selection
   
  -(let ((color-dialog nil))
  -  (defun create-color-selection ()
  -    (unless color-dialog
  -      (setq
  -       color-dialog
  -       (make-instance 'color-selection-dialog
  -	:title "Color selection dialog" :position :mouse
  -	:allow-grow nil :allow-shrink nil
  -	:signals
  -	(list (list 'destroy #'(lambda () (widget-destroyed color-dialog))))))
  -
  -      (with-slots (main-box colorsel) color-dialog
  -        (make-instance 'hbutton-box
  -	 :border-width 10 :layout :edge :visible t
  -	 :children
  -	 (list
  -	  (create-check-button
  -	   "Show Opacity" '(setf color-selection-use-opacity-p) nil colorsel)
  -	  (create-check-button
  -	   "Show Palette" '(setf color-selection-use-palette-p) nil colorsel))
  -	 :parent main-box)
  -	
  -	(signal-connect
  -	 (color-selection-dialog-ok-button color-dialog) 'clicked
  -	 #'(lambda ()
  -	     (let ((color (color-selection-color colorsel)))
  -	       (format t "Selected color: ~A~%" color)
  -	       (setf (color-selection-color colorsel) color))))
  -	(signal-connect
  -	 (color-selection-dialog-cancel-button color-dialog) 'clicked
  -	 #'widget-destroy :object color-dialog)))
  -       
  -    (if (not (widget-visible-p color-dialog))
  -	(widget-show color-dialog)
  -      (widget-destroy color-dialog))))
  -
  -
  +(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))))
  +
  +    (signal-connect dialog :ok
  +     #'(lambda ()
  +	 (let ((color (color-selection-current-color colorsel)))
  +	   (format t "Selected color: ~A~%" color)
  +	   (setf (color-selection-current-color colorsel) color)
  +	   (widget-hide dialog))))
  +
  +    (signal-connect dialog :cancel #'widget-destroy :object t)))
   
   
   ;;; Cursors
  
positive.code: 	(paned-pack2 paned child resize (not shrink))))))
  
  (defun create-pane-options (paned frame-label label1 label2)
    (let* ((frame (make-instance 'frame
  		 :label frame-label :border-width 4))
  	 (table (make-instance 'table
  		 :rows 3 :columns 2 :homogeneous t :parent frame)))
  
      (table-attach table (label-new label1) 0 1 0 1)
      (let ((check-button (check-button-new "Resize")))
        (table-attach table check-button 0 1 1 2)
        (signal-connect
         check-button 'toggled #'toggle-resize :object (paned-child1 paned)))
      (let ((check-button (check-button-new "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 (check-button-new "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 (check-button-new "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))
  
  (define-test-window create-panes "Panes"
    (let* ((hpaned (make-instance 'hpaned
  		  :child1 (make-instance 'frame
  			   :shadow-type :in :width 60 :height 60
  			   :child (button-new "Hi there"))
  		  :child2 (make-instance 'frame
  			   :shadow-type :in :width 80 :height 60)))
  	 (vpaned (make-instance 'vpaned
  		  :border-width 5
  		  :child1 hpaned
  		  :child2 (make-instance 'frame
  			   :shadow-type :in :width 80 :height 60))))
      
      (make-instance 'vbox
       :parent window
       :children
       (list
        vpaned
        (list
         (create-pane-options hpaned "Horizontal" "Left" "Right") :expand nil)
        (list
         (create-pane-options vpaned "Vertical" "Top" "Bottom") :expand nil)))))
    
  
  
  ;;; Pixmap
  
  (define-standard-dialog create-pixmap "Pixmap"
    (setf (container-border-width main-box) 10)
    (make-instance 'button
     :parent main-box
     :child (make-instance 'hbox
             :border-width 2
  	   :children
  	   (list
  	    (pixmap-new "clg:examples;test.xpm")
  	    (label-new "Pixmap test")))))
  
  
  
  ;;; Progress bar
  
       
  
negative.code: 
  ;;; Dialog
  
  (let ((dialog nil))
    (defun create-dialog ()
      (unless dialog
        (setq dialog (make-instance 'dialog 
  		    :title "Dialog" :default-width 200 
  		    :button "Toggle"
  		    :button (list "gtk-ok" #'widget-destroy :object t)
  		    :signal (list 'destroy 
  			     #'(lambda () 
  				 (setq dialog nil)))))
  
        (let ((label (make-instance 'label 
  		    :label "Dialog Test" :xpad 10 :ypad 10 :visible t
  		    :parent dialog)))
  	(signal-connect dialog "Toggle"
  	 #'(lambda ()
  	     (if (widget-visible-p label)
  		 (widget-hide label)
  	       (widget-show label))))))
  
      (if (widget-visible-p dialog)
  	(widget-hide dialog)
         (widget-show dialog))))
  
  
  ;; Entry
  
  (define-simple-dialog create-entry (dialog "Entry")
    (let ((main (make-instance 'v-box 
  	       :border-width 10 :spacing 10 :parent dialog)))
  
      (let ((entry (make-instance 'entry :text "hello world" :parent main)))
        (editable-select-region entry 0 5) ; this has no effect when 
  					 ; entry is editable
  ;;     (editable-insert-text entry "great " 6)
  ;;     (editable-delete-text entry 6 12)
        
        (let ((combo (make-instance 'combo 
  		    :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)))
  
        (flet ((create-check-button (label slot)
  	       (make-instance 'check-button
  	        :label label :active t :parent main
  		:signal (list 'toggled
  			      #'(lambda (button)
  				  (setf (slot-value entry slot)
  					(toggle-button-active-p button)))
  			      :object t))))
        
  	(create-check-button "Editable" 'editable)
  	(create-check-button "Visible" 'visibility)
  	(create-check-button "Sensitive" 'sensitive)))
      (widget-show-all main)))
  
  
  
  ;; File chooser dialog
  
  (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))
         (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"))))
  
  ;;; Image
  
  (define-toplevel create-image (window "Image")
    (make-instance 'image :file #p"clg:examples;gtk.png" :parent window))
  
  
  ;;; Labels
        
  (define-toplevel create-labels (window "Labels" :border-width 5 :resizable nil)
    (flet ((create-label-in-frame (frame-label label-text &rest args)
  	   (list 
  	    (make-instance 'frame
  	     :label frame-label
  	     :child (apply #'make-instance 'label :label label-text :xpad 5 :ypad 5 args))
  	    :fill nil :expand nil)))
      (make-instance 'h-box
       :spacing 5 :parent window
       :child-args '(:fill nil :expand nil)
       :child (make-instance 'v-box
               :spacing 5
  	     :child (create-label-in-frame "Normal Label" "This is a Normal label")
  	     :child (create-label-in-frame "Multi-line Label"
  "This is a Multi-line label.
  Second line
  Third line")
  	     :child (create-label-in-frame "Left Justified Label"
  "This is a Left-Justified
  Multi-line.
  Third line"
                        :justify :left)
  	     :child (create-label-in-frame "Right Justified Label"
  "This is a Right-Justified
  Multi-line.
  Third line"
                       :justify :right))
       :child (make-instance 'v-box
  	     :spacing 5
  	     :child (create-label-in-frame "Line wrapped label"
  "This is an example of a line-wrapped label.  It should not be taking up the entire             width allocated to it, but automatically wraps the words to fit.  The time has come, for all good men, to come to the aid of their party.  The sixth sheik's six sheep's sick.
       It supports multiple paragraphs correctly, and  correctly   adds many          extra  spaces. "
                        :wrap t)
  
  	     :child (create-label-in-frame "Filled, wrapped label"
  "This is an example of a line-wrapped, filled label.  It should be taking up the entire              width allocated to it.  Here is a seneance to prove my point.  Here is another sentence. Here comes the sun, do de do de do.
      This is a new paragraph.
      This is another newer, longer, better paragraph.  It is coming to an end, unfortunately."
                        :justify :fill :wrap t)
  
  	     :child (create-label-in-frame "Underlined label"
  "This label is underlined!
  This one is underlined (こんにちは) in quite a funky fashion"
                        :justify :left
  	              :pattern  "_________________________ _ _________ _ _____ _ __ __  ___ ____ _____")))))
  
  
  ;;; 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)
  
  
  (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)
  		 )))
  
      (with-slots (hadjustment vadjustment) layout
        (setf
         (adjustment-step-increment hadjustment) 10.0
         (adjustment-step-increment vadjustment) 10.0))
  
      (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))))))
  
      (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)))))))
  
  
  
  ;;; 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))
      
  ;;     (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)))))
  
  
  
  