anchor.diff:  	(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)))
  +  (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 ((check-button (check-button-new "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 (check-button-new "Shrink")))
  +    (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 (check-button-new "Resize")))
  +    (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 (check-button-new "Shrink")))
  +    (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))
   
  -(define-test-window create-panes "Panes"
  -  (let* ((hpaned (make-instance 'hpaned
  +(define-toplevel create-panes (window "Panes")
  +  (let* ((hpaned (make-instance 'h-paned
   		  :child1 (make-instance 'frame
  -			   :shadow-type :in :width 60 :height 60
  +			   :width-request 60 :height-request 60
  +			   :shadow-type :in 
   			   :child (button-new "Hi there"))
  -		  :child2 (make-instance 'frame
  -			   :shadow-type :in :width 80 :height 60)))
  -	 (vpaned (make-instance 'vpaned
  +		  :child2 (make-instance 'frame			    
  +			   :width-request 80 :height-request 60
  +			   :shadow-type :in)))
  +	 (vpaned (make-instance 'v-paned
   		  :border-width 5
   		  :child1 hpaned
   		  :child2 (make-instance 'frame
  -			   :shadow-type :in :width 80 :height 60))))
  -    
  -    (make-instance 'vbox
  +			   :width-request 80 :height-request 60
  +			   :shadow-type :in))))
  +    
  +    (make-instance 'v-box
        :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)))))
  +     :child-args '(:expand nil)
  +     :child (list vpaned :expand t)
  +     :child (create-pane-options hpaned "Horizontal" "Left" "Right")
  +     :child (create-pane-options vpaned "Vertical" "Top" "Bottom"))))
     
   
  -
  -;;; 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
   
        
  
positive.code: 
  ;;; Dialog
  
  (define-test-dialog create-dialog "Dialog"
    (setf (widget-width window) 200)
    (setf (widget-height window) 110)
        
    (let ((button (button-new "OK")))
      (signal-connect button 'clicked #'(lambda () (widget-destroy window)))
      (setf (widget-can-default-p button) t)
      (box-pack-start action-area button t t 0)
      (widget-grab-default button)
      (widget-show button))
    
    (let ((button (button-new "Toggle"))
  	(label nil))
      (signal-connect
       button 'clicked
       #'(lambda ()
  	 (if (not label)
  	     (progn
  	       (setq label (label-new "Dialog Test"))
  	       (signal-connect label 'destroy #'widget-destroy :object label)
  	       (setf (misc-xpad label) 10)
  	       (setf (misc-ypad label) 10)
  	       (box-pack-start main-box label t t 0)
  	       (widget-show label))
  	   (progn
  	     (widget-destroy label)
  	     (setq label nil)))))
      (setf (widget-can-default-p button) t)
      (box-pack-start action-area button t t 0)
      (widget-grab-default button)
      (widget-show button)))
  
  
  
  ;; Entry
  
  (define-standard-dialog create-entry "Entry"
    (setf (container-border-width main-box) 10)
    (setf (box-spacing main-box) 10)
    (let ((entry (make-instance 'entry :text "hello world" :parent main-box)))
      (editable-select-region entry 0 5)
  
      (let ((combo (make-instance 'combo :parent main-box)))
        (setf
         (combo-popdown-strings combo)
         '("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"))
        (let ((entry (combo-entry combo)))
  	(setf (editable-text entry) "hello world")
  	(editable-select-region entry 0)))
  
      (flet ((create-check-button (label slot)
  	     (let ((button
  		    (make-instance 'check-button
  	             :label label :active t
  		     :parent (list main-box :expand nil))))
  	       (signal-connect button 'toggled
  		#'(lambda ()
  		    (setf
  		     (slot-value entry slot)
  		     (toggle-button-active-p button)))))))
        
        (create-check-button "Editable" 'editable)
        (create-check-button "Visible" 'visible)
        (create-check-button "Sensitive" 'sensitive))))
  
  
  
  ;; File selecetion dialog
  
  (let ((filesel nil))
    (defun create-file-selection ()
      (unless filesel
        (setq filesel (file-selection-new "file selection dialog"))
        (file-selection-hide-fileop-buttons filesel)
        (setf (window-position filesel) :mouse)
        (signal-connect
         filesel 'destroy #'(lambda () (widget-destroyed filesel)))
        (signal-connect
         (file-selection-ok-button filesel) 'clicked
         #'(lambda ()
  	   (format
  	    t "Selected file: ~A~%" (file-selection-filename filesel))
  	   (widget-destroy filesel)))
        (signal-connect
         (file-selection-cancel-button filesel) 'clicked
         #'widget-destroy :object filesel)
  
        (let ((button (button-new "Hide Fileops")))
  	(signal-connect
  	 button 'clicked
  	 #'file-selection-hide-fileop-buttons :object filesel)
  	(box-pack-start (file-selection-action-area filesel) button nil nil 0)
  	(widget-show button))
  
        (let ((button (button-new "Show Fileops")))
  	(signal-connect
  	 button 'clicked
  	 #'file-selection-show-fileop-buttons :object filesel)
  	(box-pack-start (file-selection-action-area filesel) button nil nil 0)
  	(widget-show button)))
  
      (if (not (widget-visible-p filesel))
  	(widget-show-all filesel)
        (widget-destroy filesel))))
  
  
  
  ;;; 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 ((vbox (vbox-new nil 0)))
      (container-add window vbox)
  
      (container-add vbox (label-new "Above"))
      (container-add vbox (hseparator-new))
  
      (let ((hbox (hbox-new nil 10)))
        (container-add vbox 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 vbox (hseparator-new))
      (container-add vbox (label-new "Below"))))
  
  
  
  ;;; Labels
        
  (define-test-window create-labels "Labels"
    (setf (container-border-width window) 5)
    (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 args))
  	    :fill nil :expand nil)))
      (make-instance 'hbox
       :spacing 5
       :parent window
       :children
       (list
        (list
         (make-instance 'vbox
          :spacing 5
  	:children
  	(list
  	 (create-label-in-frame "Normal Label" "This is a Normal label")
  	 (create-label-in-frame "Multi-line Label"
  "This is a Multi-line label.
  Second line
  Third line")
  	 (create-label-in-frame "Left Justified Label"
  "This is a Left-Justified
  Multi-line.
  Third line"
            :justify :left)
  	 (create-label-in-frame "Right Justified Label"
  "This is a Right-Justified
  Multi-line.
  Third line"
            :justify :right)))
         :fill nil :expand nil)
  
        (list
         (make-instance 'vbox
          :spacing 5
  	:children
  	(list      
  	 (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)
  	 (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)
  	 (create-label-in-frame "Underlined label"
  "This label is underlined!
  This one is underlined (こんにちは) in quite a funky fashion"
            :justify :left
  	  :pattern  "_________________________ _ _________ _ _____ _ __ __  ___ ____ _____")))
         :fill nil :expand nil)))))
  
  
  
  ;;; Layout
  
  (defun layout-expose-handler (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-test-window create-layout "Layout"
    (setf (widget-width window) 200)
    (setf (widget-height window) 200)
    (let ((layout (make-instance 'layout
  		 :parent (make-instance 'scrolled-window :parent window)
  		 :x-size 1600 :y-size 128000
  		 :events '(:exposure))))
  
      (with-slots (hadjustment vadjustment) layout
        (setf
         (adjustment-step-increment hadjustment) 10.0
         (adjustment-step-increment vadjustment) 10.0))
      (signal-connect layout 'expose-event #'layout-expose-handler :object t)
  
      (dotimes (i 16)
        (dotimes (j 16)
  	(let* ((text (format nil "Button ~D, ~D" i j))
  	       (button (if (not (zerop (mod (+ i j) 2)))
  			   (button-new text)
  			 (label-new text))))
  	  (layout-put layout button (* j 100) (* i 100)))))
  
      (do ((i 16 (1+ i)))
  	((= i 1280))
        (declare (fixnum i))
        (let* ((text (format nil "Button ~D, ~D" i 0))
  	     (button (if (not (zerop (mod i 2)))
  			 (button-new text)
  		       (label-new text))))
  	(layout-put layout button 0 (* 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)))))
  
  
  
  
negative.code: 
  ;;; Radio buttons
  
  (define-simple-dialog create-radio-buttons (dialog "Radio buttons")
    (make-instance 'v-box
     :parent dialog :border-width 10 :spacing 10 :show-all t
     :children (create-radio-button-group '("button1" "button2" "button3") 1)))
  
  
  ;;; Rangle controls
  
  (define-simple-dialog create-range-controls (dialog "Range controls")
    (let ((adjustment (adjustment-new 0.0 0.0 101.0 0.1 1.0 1.0)))
      (make-instance 'v-box
       :parent dialog :border-width 10 :spacing 10 :show-all t
       :child (make-instance 'h-scale
  	     :width-request 150 :adjustment adjustment :inverted t
  	     :update-policy :delayed :digits 1 :draw-value t)
       :child (make-instance 'h-scrollbar
               :adjustment adjustment :update-policy :continuous))))
  
  
  ;;; Reparent test
  
  (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")))
  
      (flet ((create-frame (title)
  	     (let* ((frame (make-instance 'frame :label title :parent main))
  		    (box (make-instance 'v-box 
                            :spacing 5 :border-width 5 :parent frame))
  		    (button (make-instance 'button 
  		             :label "switch" :parent (list box :expand nil))))
  	       (signal-connect button 'clicked
  	        #'(lambda ()
  		    (widget-reparent label box)))
  	       box)))
  
        (box-pack-start (create-frame "Frame 1") label nil t 0)
        (create-frame "Frame 2"))
      (widget-show-all main)))
  
  
  ;;; Rulers
  
  (define-toplevel create-rulers (window "Rulers" 
  				:default-width 300 :default-height 300
  ;;  				:events '(:pointer-motion-mask 
  ;;  					  :pointer-motion-hint-mask)
  				)
    (setf 
     (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
  		  :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
  	          :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)))))
  
  
  
  ;;; Scrolled window
  
  (define-simple-dialog create-scrolled-windows (dialog "Scrolled windows"
  						      :default-width 300
  						      :default-height 300)
    (let* ((scrolled-window
  	  (make-instance 'scrolled-window
  	   :parent dialog :border-width 10
  	   :vscrollbar-policy :automatic 
  	   :hscrollbar-policy :automatic))
  	 (table
  	  (make-instance 'table
  	   :n-rows 20 :n-columns 20 :row-spacing 10 :column-spacing 10
  	   :focus-vadjustment (scrolled-window-vadjustment scrolled-window)
  	   :focus-hadjustment (scrolled-window-hadjustment scrolled-window))))
  
  