anchor.diff:  ;;; Statusbar
   
   (define-test-window create-statusbar "Statusbar"
  -  (let ((box1 (vbox-new nil 0)))
  -    (container-add window box1)
  -
  -    (let ((box2 (vbox-new nil 10))
  -	  (statusbar (statusbar-new))
  -	  (statusbar-counter 0))
  -      (setf (container-border-width box2) 10)
  -      (box-pack-start box1 box2 t t 0)
  -      (box-pack-end box1 statusbar t t 0)
  -      (signal-connect
  -       statusbar 'text-popped
  -       #'(lambda (context-id text)
  -	   (declare (ignore context-id))
  -	   (format nil "Popped: ~A~%" text)))
  -
  -      (make-button
  -       :label "push something"
  -       :visible t
  -       :parent box2
  -       :signal (list
  -		 'clicked
  -		 #'(lambda ()
  -		     (statusbar-push
  -		      statusbar
  -		      1
  -		      (format nil "something ~D" (incf statusbar-counter))))))
  -      
  -      (make-button
  -       :label "pop"
  -       :visible t
  -       :parent box2
  -       :signal (list
  -		'clicked
  -		#'(lambda ()
  -		    (statusbar-pop statusbar 1))
  -		:after t))
  -      
  -      (make-button
  -       :label "steal #4"
  -       :visible t
  -       :parent box2
  -       :signal (list
  -		'clicked
  -		#'(lambda ()
  -		    (statusbar-remove statusbar 1 4))
  -		:after t))
  -
  -      (make-button :label "test contexts"
  -		   :visible t
  -		   :parent box2
  -		   :signal (list 'clicked #'(lambda ()))))
  -
  -    (box-pack-start box1 (hseparator-new) nil t 0)
  -
  -    (let ((box2 (vbox-new nil 10)))
  -      (setf (container-border-width box2) 10)
  -      (box-pack-start box1 box2 nil t 0)
  -
  -      (let ((button (button-new "close")))
  -	(signal-connect button 'clicked #'(lambda () (widget-destroy window)))
  -	(box-pack-start box2 button t t 0)
  -	(setf (widget-can-default-p button) t)
  -	(widget-grab-default button)))))
  +  (let ((statusbar (make-instance 'statusbar))
  +	(statusbar-counter 0)
  +	(close-button
  +	 (create-button '("close" :can-default t) #'widget-destroy window)))
  +
  +    (signal-connect
  +     statusbar 'text-popped
  +     #'(lambda (context-id text)
  +	 (declare (ignore context-id))
  +	 (format nil "Popped: ~A~%" text)))
  +
  +    (make-instance 'vbox
  +     :parent window
  +     :children
  +     (list
  +      (make-instance 'vbox
  +       :border-width 10 :spacing 10
  +       :children
  +       (list
  +	(create-button
  +	 "push something"
  +	 #'(lambda ()
  +	     (statusbar-push
  +	      statusbar 1
  +	      (format nil "something ~D" (incf statusbar-counter)))))
  +	(create-button "pop" #'statusbar-pop statusbar 1)
  +	(create-button "steal #4" #'statusbar-remove statusbar 1 4)
  +	(create-button "dump stack")
  +	(create-button "test contexts")))
  +      (list (make-instance 'hseparator) :expand nil)
  +      (list
  +       (make-instance 'vbox
  +        :border-width 10
  +	:children (list (list close-button :expand nil)))
  +       :expand nil)
  +       statusbar))
  +    
  +    (widget-grab-default close-button)))
   
   
   
   ;;; Idle test
   
   (define-standard-dialog create-idle-test "Idle Test"
  -  (let ((label (label-new "count: 0"))
  -	(idle nil)
  -	(count 0))
  +  (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))))
    
  -    (setf (misc-xpad label) 10)
  -    (setf (misc-ypad label) 10)
  -    (box-pack-start main-box label t t 0)
  -
  -    (let* ((container (make-hbox :parent main-box :child label :visible t))
  -	   (frame (make-frame
  -		   :border-width 5
  -		   :label "Label Container"
  -		   :visible t
  -		   :parent main-box))
  -	   (box (make-vbox :visible t :parent frame)))
  -      (make-check-button
  -       :label "Resize-Parent"
  -       :visible t
  -       :parent box
  -       :signal
  -       (list
  -	'clicked
  -	#'(lambda ()
  -	    (setf (container-resize-mode container) :parent))))
  +    (make-instance 'frame
  +     :label "Label Container" :border-width 5 :parent main-box
  +     :child
  +     (make-instance 'vbox
  +      :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-check-button
  -       :label "Resize-Queue"
  -       :visible t
  -       :parent box
  -       :signal
  -       (list
  -	'clicked
  -	#'(lambda ()
  -	    (setf (container-resize-mode container) :queue))))
  -      
  -      (make-check-button
  -       :label "Resize-Immediate"
  -       :visible t
  -       :parent box
  -       :signal
  -       (list
  -	'clicked
  -	#'(lambda ()
  -	    (setf (container-resize-mode container) :immediate)))))
  -
  -    (let ((button (button-new "start")))
  -      (signal-connect
  -       button 'clicked
  +    (make-instance 'button
  +     :label "stop" :can-default t :parent action-area
  +     :signals
  +     (list
  +      (list
  +       'clicked
          #'(lambda ()
  -       (unless idle
  -	 (setq
  -	  idle
  -	  (idle-add
  -	   #'(lambda ()
  -	       (incf count)
  -	       (setf (label-text label) (format nil "count: ~D" count))
  -	       t))))))
  -      (setf (widget-can-default-p button) t)
  -      (box-pack-start action-area button t t 0)
  -      (widget-show button))
  -      
  -    (let ((button (button-new "stop")))
  -      (signal-connect
  -       button 'clicked
  -       #'(lambda ()
  -       (when idle
  -	 (idle-remove idle)
  -	 (setq idle nil))))
  -      (setf (widget-can-default-p button) t)
  -      (box-pack-start action-area button t t 0)
  -      (widget-show button))))
  +	   (when idle
  +	     (idle-remove idle)
  +	     (setq idle nil))))))))
       
   
   
   ;;; Timeout test
   
   (define-standard-dialog create-timeout-test "Timeout Test"
  -  (let ((label (label-new "count: 0"))
  +  (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))))
  -      
  -    (setf (misc-xpad label) 10)
  -    (setf (misc-ypad label) 10)
  -    (box-pack-start main-box label t t 0)
  -    (widget-show label)
  -      
  -    (let ((button (button-new "start")))
  -      (signal-connect
  -       button 'clicked
  +          
  +    (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-text label) (format nil "count: ~D" count))
  -	       t))))))
  -      (setf (widget-can-default-p button) t)
  -      (box-pack-start action-area button t t 0)
  -      (widget-show button))
  -      
  -    (let ((button (button-new "stop")))
  -      (signal-connect
  -       button 'clicked
  +	   (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))))
  -      (setf (widget-can-default-p button) t)
  -      (box-pack-start action-area button t t 0)
  -      (widget-show button))))
  +	   (when timer
  +	     (timeout-remove timer)
  +	     (setq timer nil))))))))
     
  -
  -
  -;;; Text
  -
  -(define-test-window create-text "Text"
  -  (setf (widget-name window) "text window")
  -  (setf (widget-width window) 500)
  -  (setf (widget-height window) 500)
  -  (setf (window-allow-grow-p window) t)
  -  (setf (window-allow-shrink-p window) t)
  -  (setf (window-auto-shrink-p window) nil)
  -  (let ((box1 (vbox-new nil 0)))
  -    (container-add window box1)
  -    
  -    (let ((box2 (vbox-new nil 10)))
  -      (setf (container-border-width box2) 10)
  -      (box-pack-start box1 box2 t t 0)
  -
  -      (let ((scrolled-window (scrolled-window-new))
  -	    (text (text-new)))
  -	(box-pack-start box2 scrolled-window t t 0)
  -	(setf (scrolled-window-hscrollbar-policy scrolled-window) :never)
  -	(setf (scrolled-window-vscrollbar-policy scrolled-window) :always)
  -	(setf (editable-editable-p text) t)
  -	(container-add scrolled-window text)
  -	(widget-grab-focus text)
  -	
  -	(text-freeze text)
  -	(let ((font
  -	       (gdk:font-load
  -		"-adobe-courier-medium-r-normal--*-120-*-*-*-*-*-*"))
  -	      (colors
  -	       (map 'list
  -		    #'(lambda (definition)
  -			(cons
  -			 (gdk:color-new-from-vector (first definition))
  -			 (second definition)))
  -		    '((#(#x0000 #x0000 #x0000) "black")
  -		      (#(#xFFFF #xFFFF #xFFFF) "white")
  -		      (#(#xFFFF #x0000 #x0000) "red")
  -		      (#(#x0000 #xFFFF #x0000) "green")
  -		      (#(#x0000 #x0000 #xFFFF) "blue")
  -		      (#(#x0000 #xFFFF #xFFFF) "cyan")
  -		      (#(#xFFFF #x0000 #xFFFF) "magneta")
  -		      (#(#xFFFF #xFFFF #x0000) "yellow")))))
  -	  (dolist (color1 colors)
  -	    (text-insert text (format nil "~A~,7T" (cdr color1)) :font font)
  -	    (dolist (color2 colors)
  -	      (text-insert
  -	       text "XYZ" :font font
  -	       :foreground (car color2) :background (car color1)))
  -	    (text-insert text (format nil "~%")))
  -	  (dolist (color colors)
  -	    (gdk:color-destroy (car color)))
  -	  (gdk:font-unref font))
  -			 
  -	(with-open-file (file "cl-gtk:src;testgtk.lisp")
  -	  (labels ((read-file ()
  -		     (let ((line (read-line file nil nil)))
  -		       (when line
  -			 (text-insert text (format nil "~A~%" line))
  -			 (read-file)))))
  -	    (read-file)))
  -
  -	(text-thaw text)
  -
  -	(let ((hbox (hbutton-box-new)))
  -	  (box-pack-start box2 hbox nil nil 0)
  -	  (let ((check-button (check-button-new "Editable")))
  -	    (box-pack-start hbox check-button nil nil 0)
  -	    (signal-connect
  -	     check-button 'toggled
  -	     #'(lambda ()
  -		 (setf
  -		  (editable-editable-p text)
  -		  (toggle-button-active-p check-button))))
  -	    (setf (toggle-button-active-p check-button) t))
  -
  -	  (let ((check-button (check-button-new "Wrap Words")))
  -	    (box-pack-start hbox check-button nil t 0)
  -	    (signal-connect
  -	     check-button 'toggled
  -	     #'(lambda ()
  -		 (setf
  -		  (text-word-wrap-p text)
  -		  (toggle-button-active-p check-button))))
  -	    (setf (toggle-button-active-p check-button) nil)))))
  -
  -    (box-pack-start box1 (hseparator-new) nil t 0)
  -
  -    (let ((box2 (vbox-new nil 10)))
  -      (setf (container-border-width box2) 10)
  -      (box-pack-start box1 box2 nil t 0)
  -      
  -      (let ((button (button-new "insert random")))
  -	(signal-connect button 'clicked #'(lambda () nil))
  -	(box-pack-start box2 button t t 0))
  -
  -      (let ((button (button-new "close")))
  -	(signal-connect
  -	 button 'clicked
  -	 #'(lambda ()
  -	     (widget-destroy window)
  -	     (setq window nil)))
  -	(box-pack-start box2 button t t 0)
  -	(setf (widget-can-default-p button) t)
  -	(widget-grab-default button)))))
  -      
  -
   
   ;;; Toggle buttons
   
   (define-standard-dialog create-toggle-buttons "Toggle Button"
     (setf (container-border-width main-box) 10)
     (setf (box-spacing main-box) 10)
  -  (box-pack main-box (toggle-button-new "button1"))
  -  (box-pack main-box (toggle-button-new "button2"))
  -  (box-pack main-box (toggle-button-new "button3")))
  +  (dotimes (n 3)
  +    (make-instance 'toggle-button
  +     :label (format nil "Button~D" (1+ n)) :parent main-box)))
   
   
   
  
positive.code: 
  ;;; Button box
  
  (defun create-bbox (class title spacing child-w child-h layout)
    (let* ((frame (make-instance 'frame :title title))
  	 (bbox (make-instance 'class
  	        :border-width 5
  		:layout layout
  		:spacing spacing
  		:childrent
  		(list
  		 (make-instance 'button :label "OK")
  		 (make-instance 'button :label "Cancel")
  		 (make-instance 'button :label "Help"))
  		:parent frame)))
      (setf (button-box-child-size bbox) (vector child-w child-h))
      frame))
  
  
  (define-test-window create-button-box "Button Boxes"
    (setf (container-border-width window) 10)
    (let ((main-box (vbox-new nil 0)))
      (let ((frame (frame-new "Horizontal Button Boxes"))
  	  (box (vbox-new nil 0)))
        (container-add window main-box)
        (box-pack-start main-box frame t t 10)
        (setf (container-border-width box) 10)
        (container-add frame box)
        (box-pack-start
         box (create-bbox #'hbutton-box-new "Spread" 40 85 20 :spread) t t 0)
        (box-pack-start
         box (create-bbox #'hbutton-box-new "Edge" 40 85 20 :edge) t t 0)
        (box-pack-start
         box (create-bbox #'hbutton-box-new "Start" 40 85 20 :start) t t 0)
        (box-pack-start
         box (create-bbox #'hbutton-box-new "End" 40 85 20 :end) t t 0))
  
      (let ((frame (frame-new "Vertical Button Boxes"))
  	  (box (hbox-new nil 0)))
        (box-pack-start main-box frame t t 10)
        (setf (container-border-width box) 10)
        (container-add frame box)
        (box-pack-start
         box (create-bbox #'vbutton-box-new "Spread" 30 85 20 :spread) t t 5)
        (box-pack-start
         box (create-bbox #'vbutton-box-new "Edge" 30 85 20 :edge) t t 5)
        (box-pack-start
         box (create-bbox #'vbutton-box-new "Start" 30 85 20 :start) t t 5)
        (box-pack-start
         box (create-bbox #'vbutton-box-new "End" 30 85 20 :end) t t 5))))
  
  
  
  (define-standard-dialog create-buttons "Buttons"
    (let ((table (table-new 3 3 nil))
  	(buttons `((,(button-new "button1") 0 1 0 1)
  		   (,(button-new "button2") 1 2 1 2)
  		   (,(button-new "button3") 2 3 2 3)
  		   (,(button-new "button4") 0 1 2 3)
  		   (,(button-new "button5") 2 3 0 1)
  		   (,(button-new "button6") 1 2 2 3)
  		   (,(button-new "button7") 1 2 0 1)
  		   (,(button-new "button8") 2 3 1 2)
  		   (,(button-new "button9") 0 1 1 2))))
      (setf (table-row-spacings table) 5)
      (setf (table-column-spacings table) 5)
      (setf (container-border-width table) 10)
      (box-pack-start main-box table t t 0)
      (do ((tmp buttons (rest tmp)))
  	((endp tmp))
        (let ((button (first tmp))
  	    (widget (or (first (second tmp))
  			(first (first buttons)))))
  	(signal-connect (first button) 'clicked
  	 #'(lambda ()
  	     (if (widget-visible-p widget)
  		 (widget-hide widget)
  	       (widget-show widget))))
  	(apply #'table-attach table button)))))
  
  
  ;; Calenadar
  
  (define-standard-dialog create-calendar "Calendar"
    (setf (container-border-width main-box) 10)
    (box-pack-start main-box (calendar-new) t t 0))
  
  
  
  ;;; Check buttons
  
  (define-standard-dialog create-check-buttons "GtkCheckButton"
    (setf (container-border-width main-box) 10)
    (setf (box-spacing main-box) 10)
    (box-pack-start main-box (check-button-new "button1") t t 0)
    (box-pack-start main-box (check-button-new "button2") t t 0)
    (box-pack-start main-box (check-button-new "button3") t t 0))
  
  
  
  ;;; CList
  
  (let ((style1 nil)
        (style2 nil)
        (style3 nil))
    (defun insert-row-clist (clist)
      (let* ((text '("This" "is" "an" "inserted" "row"
  		   "This" "is" "an" "inserted" "row"
  		   "This" "is" "an" "inserted" "row"
  		   "This" "is" "an" "inserted" "row"))
  	   (row 
  	    (if (clist-focus-row clist)
  		(clist-insert clist (clist-focus-row clist) text)
  	      (clist-prepend clist text))))
        
        (unless style1
  	(let ((color1 '#(0 56000 0))
  	      (color2 '#(32000 0 56000)))
  	  (setq style1 (style-copy (widget-style clist)))
  	  (setf
  	   (style-base style1 :normal) color1
  	   (style-base style1 :selected) color2)
  
  	  (setq style2 (style-copy (widget-style clist)))
   	  (setf
   	   (style-fg style2 :normal) color1
   	   (style-fg style2 :selected) color2)
  
  	  (setq style3 (style-copy (widget-style clist)))
   	  (setf
   	   (style-fg style3 :normal) color1
   	   (style-base style3 :normal) color2
   	   (style-font style3) "-*-courier-medium-*-*-*-*-120-*-*-*-*-*-*")))
  
        (setf (clist-cell-style clist row 3) style1)
        (setf (clist-cell-style clist row 4) style2)
        (setf (clist-cell-style clist row 0) style3))))
  
  
  (define-standard-dialog create-clist "clist"
    (let* ((titles '("auto resize" "not resizeable" "max width 100"
  		   "min width 50" "hide column" "Title 5" "Title 6"
  		   "Title 7" "Title 8"  "Title 9"  "Title 10"
  		   "Title 11" "Title 12" "Title 13" "Title 14"
  		   "Title 15" "Title 16" "Title 17" "Title 18"
  		   "Title 19"))
  	 (clist (clist-new titles))
  	 (scrolled-window (scrolled-window-new nil nil)))
  
      (setf (container-border-width scrolled-window) 5)
      (setf (scrolled-window-scrollbar-policy scrolled-window) :automatic)
      (container-add scrolled-window clist)
  
      (signal-connect
       clist 'click-column
       #'(lambda (column)
  	 (cond
  	  ((= column 4)
  	   (setf (clist-column-visible-p clist column) nil))
  	  ((= column (clist-sort-column clist))
  	   (if (eq (clist-sort-type clist) :ascending)
  	       (setf (clist-sort-type clist) :descending)
  	     (setf (clist-sort-type clist) :ascending)))
  	  (t
  	   (setf (clist-sort-column clist) column)))
  	 (clist-sort clist)))
  
      (let ((box2 (hbox-new nil 5)))
        (setf (container-border-width box2) 5)
        (box-pack-start main-box box2 nil nil 0)
        
        (let ((button (button-new "Insert Row")))
  	(box-pack-start box2 button t t 0)
  	(signal-connect
  	 button 'clicked #'insert-row-clist :object clist))
  
        (let ((button (button-new "Add 1,000 Rows With Pixmaps")))
  	(box-pack-start box2 button t t 0)
  	(signal-connect
  	 button 'clicked
  	 #'(lambda ()
  	     (multiple-value-bind (pixmap mask)
  		 (gdk:pixmap-create gtk-mini-xpm)
  	       (let ((texts (do ((i 4 (1+ i))
  				 (texts '(nil "Center" "Right")))
  				((= i (length titles)) (reverse texts))
  			      (push (format nil "Column ~D" i) texts))))
  		 (clist-freeze clist)
  		 (dotimes (i 1000)
  		   (let ((row
  			  (clist-append
  			   clist
  			   (cons (format nil "CListRow ~D" (random 1000))
  				 texts))))
  		     (clist-set-cell-pixtext
  		      clist row 3 "gtk+" 5 (list pixmap mask))))
  		 (clist-thaw clist))))))
  
        (let ((button (button-new "Add 10,000 Rows")))
  	(box-pack-start box2 button t t 0)
  	(signal-connect
  	 button 'clicked
  	 #'(lambda ()
  	     (let ((texts (do ((i 3 (1+ i))
  			       (texts '("Center" "Right")))
  			      ((= i (length titles)) (reverse texts))
  			    (push (format nil "Column ~D" i) texts))))
  	       (clist-freeze clist)
  	       (dotimes (i 10000)
  		 (clist-append
  		  clist (cons (format nil "CListRow ~D" (random 1000)) texts)))
  	       (clist-thaw clist))))))
      
  
      (let ((box2 (hbox-new nil 5)))
        (setf (container-border-width box2) 5)
        (box-pack-start main-box box2 nil nil 0)
      	    
        (let ((button (button-new "Clear List")))
  	(box-pack-start box2 button t t 0)
  	(signal-connect
  	 button 'clicked
  	 #'(lambda ()
  	     (clist-clear clist))))
      
        (let ((button (button-new "Remove Selection")))
  	(box-pack-start box2 button t t 0)
  	(signal-connect
  	 button 'clicked
  	 #'(lambda ()
  	     (clist-freeze clist)
  	     (let ((selection-mode (clist-selection-mode clist)))
  	       (labels ((remove-selection ()
  		          (let ((selection (clist-selection clist)))
  			    (when selection
  			      (clist-remove clist (first selection))
  			      (unless (eq selection-mode :browse)
  				(remove-selection))))))
  		 (remove-selection))
  	     
  	       (when (and
  		      (eq selection-mode :extended)
  		      (not (clist-selection clist))
  		      (clist-focus-row clist))
  		 (clist-select-row clist (clist-focus-row clist))))
  	     (clist-thaw clist))))
  
        (let ((button (button-new "Undo Selection")))
  	(box-pack-start box2 button t t 0)
  	(signal-connect
  	 button 'clicked #'clist-undo-selection :object clist))
  
        (let ((button (button-new "Warning Test")))
  	(box-pack-start box2 button t t 0)
  	(signal-connect button 'clicked #'(lambda ()))))
      
  
      (let ((box2 (hbox-new nil 5)))
        (setf (container-border-width box2) 5)
        (box-pack-start main-box box2 nil nil 0)
        
        (let ((button (check-button-new "Show Title Buttons")))
  	(box-pack-start box2 button t t 0)
  	(signal-connect
  	 button 'clicked
  	 #'(lambda ()
  	     (if (toggle-button-active-p button)
  		 (clist-column-titles-show clist)
  	       (clist-column-titles-hide clist))))
  	(setf (toggle-button-active-p button) t))
  
        (let ((button (check-button-new "Reorderable")))
  	(box-pack-start box2 button nil t 0)
  	(signal-connect
  	 button 'clicked
  	 #'(lambda ()
  	     (setf
  	      (clist-reorderable-p clist) (toggle-button-active-p button))))
  	(setf (toggle-button-active-p button) t))
  
        (box-pack-start box2 (label-new "Selection Mode : ") nil t 0)      
        (let ((option-menu
  	     (build-option-menu
  	      `(("Single"
  		 ,#'(lambda () (setf (clist-selection-mode clist) :single)))
  		("Browse"
  		 ,#'(lambda () (setf (clist-selection-mode clist) :browse)))
  		("Multiple"
  		 ,#'(lambda () (setf (clist-selection-mode clist) :multiple)))
  		("Extended"
  		 ,#'(lambda () (setf (clist-selection-mode clist) :extended))))
  	      3)))
  	(box-pack-start box2 option-menu nil t 0)))
  
      (box-pack-start main-box scrolled-window t t 0)
      (setf (clist-row-height clist) 18)
      (setf (widget-height clist) 300)
  
      (dotimes (i (length titles))
        (setf (clist-column-width clist i) 80))
  
      (setf (clist-column-auto-resize-p clist 0) t)
      (setf (clist-column-resizeable-p clist 1) nil)
      (setf (clist-column-max-width clist 2) 100)
      (setf (clist-column-min-width clist 3) 50)
      (setf (clist-selection-mode clist) :extended)
      (setf (clist-column-justification clist 1) :right)
      (setf (clist-column-justification clist 2) :center)
  
      (let ((style (style-new))
  	  (texts (do ((i 3 (1+ i))
  		      (texts '("Center" "Right")))
  		     ((= i (length titles)) (reverse texts))
  		     (push (format nil "Column ~D" i) texts))))
         (setf
          (style-font style) "-adobe-helvetica-bold-r-*-*-*-140-*-*-*-*-*-*"
  	(style-fg style :normal) '#(56000 0 0)
  	(style-base style :normal) '#(0 56000 32000))
        
        (dotimes (i 10)
          (clist-append clist (cons (format nil "CListRow ~D" i) texts))
  	(if (= (mod i 4) 2)
  	    (setf (clist-row-style clist i) style)
  	  (setf (clist-cell-style clist i (mod i 4)) style))))))
  
  
  
  
negative.code: 	   button 'clicked
  	   #'(lambda ()
  	       (setf
  		(label-label val-label)
  		(format nil
  			(format nil "~~,~DF" (spin-button-digits spinner1))
  			(spin-button-value spinner1)))))
  