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: 
  (defun create-menu (depth tearoff)
    (unless (zerop depth)
      (let ((menu (menu-new)))
        (when tearoff
  	(let ((menuitem (tearoff-menu-item-new)))
  	  (menu-shell-append menu menuitem)
  	  (widget-show menuitem)
  	  ))
        (let ((group nil))
  	(dotimes (i 5)
  	  (let ((menuitem
  		 (radio-menu-item-new
  		  (format nil "item ~2D - ~D" depth (1+ i)) group)))
  	    (setq group menuitem)
  	    (unless (zerop (mod depth 2))
  	      (setf (check-menu-item-toggle-indicator-p menuitem) t))
  	    (menu-shell-append menu menuitem)
  	    (widget-show menuitem)
  	    (when (= i 3)
  	      (setf (widget-sensitive-p menuitem) nil))
  	    (setf (menu-item-submenu menuitem) (create-menu (1- depth) t)))))
        menu)))
  
  
  (define-standard-dialog create-menus "Menus"
    (setf (box-spacing main-box) 0)
    (setf (container-border-width main-box) 0)
    (widget-show main-box)
    (let ((accel-group (accel-group-new))
  	(menubar (menu-bar-new)))
      (accel-group-attach accel-group window)
      (box-pack-start main-box menubar nil t 0)
      (widget-show menubar)
  
      (let ((menuitem (menu-item-new (format nil "test~%line2"))))
        (setf (menu-item-submenu menuitem) (create-menu 2 t))
        (menu-shell-append menubar menuitem)
        (widget-show menuitem))
  
      (let ((menuitem (menu-item-new "foo")))
        (setf (menu-item-submenu menuitem) (create-menu 3 t))
        (menu-shell-append menubar menuitem)
        (widget-show menuitem))
  
      (let ((menuitem (menu-item-new "bar")))
        (setf (menu-item-submenu menuitem) (create-menu 4 t))
        (menu-item-right-justify menuitem)
        (menu-shell-append menubar menuitem)
        (widget-show menuitem))
  
      (let ((box2 (vbox-new nil 10))
  	  (menu (create-menu 1 nil)))
        (setf (container-border-width box2) 10)
        (box-pack-start main-box box2 t t 0)
        (widget-show box2)
        
        (setf (menu-accel-group menu) accel-group)
  
        (let ((menuitem (check-menu-item-new "Accelerate Me")))
  	(menu-shell-append menu menuitem)
  	(widget-show menuitem)
          (widget-add-accelerator
           menuitem 'activate accel-group "F1" '() '(:visible :signal-visible)))
      
        (let ((menuitem (check-menu-item-new "Accelerator Locked")))
  	(menu-shell-append menu menuitem)
  	(widget-show menuitem)
          (widget-add-accelerator
           menuitem 'activate accel-group "F2" '() '(:visible :locked)))
      
        (let ((menuitem (check-menu-item-new "Accelerator Frozen")))
  	(menu-shell-append menu menuitem)
  	(widget-show menuitem)
          (widget-add-accelerator
           menuitem 'activate accel-group "F2" '() '(:visible))
          (widget-add-accelerator
           menuitem 'activate accel-group "F3" '() '(:visible))
          (widget-lock-accelerators menuitem))
        
        (let ((optionmenu (option-menu-new)))
  	(setf (option-menu-menu optionmenu) menu)
  	(setf (option-menu-history optionmenu) 3)
  	(box-pack-start box2 optionmenu t t 0)
   	(widget-show optionmenu)))))
  
  
  ;;; Notebook
  
  (define-standard-dialog create-notebook "Notebook"
    (multiple-value-bind (book-open book-open-mask)
        (gdk:pixmap-create book-open-xpm)
      (multiple-value-bind (book-closed book-closed-mask)
  	(gdk:pixmap-create book-closed-xpm)
  
        (labels
  	  ((create-pages (notebook i end)
  	     (when (<= i end)
  	       (let* ((title (format nil "Page ~D" i))
  		      (child (frame-new title))
  		      (vbox (vbox-new t 0))
  		      (hbox (hbox-new t 0)))
  		 (setf (container-border-width child) 10)
  		 (setf (container-border-width vbox) 10)
  		 (container-add child vbox)
  		 (box-pack-start vbox hbox nil t 5)
  		 
  		 (let ((button (check-button-new "Fill Tab")))
  		   (box-pack-start hbox button t t 5)
  		   (setf (toggle-button-active-p button) t)
  		   (signal-connect
  		    button 'toggled
  		    #'(lambda ()
  			(multiple-value-bind (expand fill pack-type)
  			    (notebook-query-tab-label-packing notebook child)
  			  (declare (ignore fill))
  			  (notebook-set-tab-label-packing
  			   notebook child expand
  			   (toggle-button-active-p button) pack-type)))))
  		 
  		 (let ((button (check-button-new "Expand Tab")))
  		   (box-pack-start hbox button t t 5)
  		   (signal-connect
  		    button 'toggled
  		    #'(lambda ()
  			(multiple-value-bind (expand fill pack-type)
  			    (notebook-query-tab-label-packing notebook child)
  			  (declare (ignore expand))
  			  (notebook-set-tab-label-packing
  			   notebook child (toggle-button-active-p button)
  			   fill pack-type)))))
  		 
  		 (let ((button (check-button-new "Pack end")))
  		   (box-pack-start hbox button t t 5)
  		   (signal-connect
  		    button 'toggled
  		    #'(lambda ()
  			(multiple-value-bind (expand fill pack-type)
  			    (notebook-query-tab-label-packing notebook child)
  			  (declare (ignore pack-type))
  			  (notebook-set-tab-label-packing
  			   notebook child expand fill
  			   (if (toggle-button-active-p button)
  			       :end
  			     :start))))))
  
  		 (let ((button (button-new "Hide Page")))
  		   (box-pack-start vbox button nil nil 5)
  		   (signal-connect
  		    button 'clicked #'(lambda () (widget-hide child))))
  
  		 (widget-show-all child)
  		 
  		 (let ((label-box (hbox-new nil 0))
  		       (menu-box (hbox-new nil 0)))
  		   (box-pack-start
  		    label-box (pixmap-new book-closed book-closed-mask)
  		    nil t 0)
  		   (box-pack-start label-box (label-new title) nil t 0)
  		   (widget-show-all label-box)
  		   (box-pack-start
  		    menu-box (pixmap-new book-closed book-closed-mask)
  		    nil t 0)
  		   (box-pack-start menu-box (label-new title) nil t 0)
  		   (widget-show-all menu-box)
  		   (notebook-append-page notebook child label-box menu-box)))
  	       
  	       (create-pages notebook (1+ i) end))))
  
  	
  	(setf (container-border-width main-box) 0)
  	(setf (box-spacing main-box) 0)
  	
  	(let ((notebook (notebook-new)))
  	  (signal-connect
  	   notebook 'switch-page
  	   #'(lambda (pointer page)
  	       (declare (ignore pointer))
  	       (let ((old-page (notebook-page-child notebook)))
  		 (unless (eq page old-page)
  		   (pixmap-set
  		    (first
  		     (container-children
  		      (notebook-tab-label notebook page)))
  		    book-open book-open-mask)
  		   (pixmap-set
  		    (first
  		     (container-children
  		      (notebook-menu-label notebook page)))
  		    book-open book-open-mask)
  		   
  		   (when old-page
  		     (pixmap-set
  		       (first
  			(container-children
  			 (notebook-tab-label notebook old-page)))
  		       book-closed book-closed-mask)
  		     (pixmap-set
  		      (first
  		       (container-children
  			(notebook-menu-label notebook old-page)))
  		      book-closed book-closed-mask))
  		   ))))
  	  
  	  (setf (notebook-tab-pos notebook) :top)
  	  (box-pack-start main-box notebook t t 0)
  	  (setf (container-border-width notebook) 10)
  	  
  	  (widget-realize notebook)
  	  (create-pages notebook 1 5)
  	
  	  (box-pack-start main-box (hseparator-new) nil t 10)
  	
  	  (let ((box2 (hbox-new nil 5)))
  	    (setf (container-border-width box2) 10)
  	    (box-pack-start main-box box2 nil t 0)
  	  
  	    (let ((button (check-button-new "popup menu")))
  	      (box-pack-start box2 button t nil 0)
  	      (signal-connect
  	       button 'clicked
  	       #'(lambda ()
  		   (if (toggle-button-active-p button)
  		       (notebook-popup-enable notebook)
  		     (notebook-popup-disable notebook)))))
        
  	    (let ((button (check-button-new "homogeneous tabs")))
  	      (box-pack-start box2 button t nil 0)
  	      (signal-connect
  	       button 'clicked
  	       #'(lambda ()
  		   (setf
  		    (notebook-homogeneous-p notebook)
  		    (toggle-button-active-p button))))))
  	
  	  (let ((box2 (hbox-new nil 5)))
  	    (setf (container-border-width box2) 10)
  	    (box-pack-start main-box box2 nil t 0)
  	  
  	    (box-pack-start box2 (label-new "Notebook Style : ") nil t 0)
  	  
  	    (let* ((scrollable-p nil)
  		   (option-menu
  		    (create-option-menu
  		     `(("Standard"
  			,#'(lambda ()
  			     (setf (notebook-show-tabs-p notebook) t)
  			     (when scrollable-p
  			       (setq scrollable-p nil)
  			       (setf (notebook-scrollable-p notebook) nil)
  			       (dotimes (n 10)
  				 (notebook-remove-page notebook 5)))))
  		       ("No tabs"
  		       ,#'(lambda ()
  			    (setf (notebook-show-tabs-p notebook) nil)
  			    (when scrollable-p
  			      (setq scrollable-p nil)
  			      (setf (notebook-scrollable-p notebook) nil)
  			      (dotimes (n 10)
  				(notebook-remove-page notebook 5)))))
  		       ("Scrollable"
  		       ,#'(lambda ()
  			    (unless scrollable-p
  			      (setq scrollable-p t)
  			      (setf (notebook-show-tabs-p notebook) t)
  			      (setf (notebook-scrollable-p notebook) t)
  			      (create-pages notebook 6 15)))))
  		     0)))
  	      (box-pack-start box2 option-menu nil t 0))
  
  	    (let ((button (button-new "Show all Pages")))
  	      (box-pack-start box2 button nil t 0)
  	      (signal-connect
  	       button 'clicked
  	       #'(lambda ()
  		   (map-container nil #'widget-show notebook)))))
  
  	  (let ((box2 (hbox-new nil 5)))
  	    (setf (container-border-width box2) 10)
  	    (box-pack-start main-box box2 nil t 0)
  	    
  	    (let ((button (button-new "prev")))
  	      (box-pack-start box2 button t t 0)
  	      (signal-connect
  	       button 'clicked
  	       #'(lambda ()
  		   (notebook-prev-page notebook))))
        
  	    (let ((button (button-new "next")))
  	      (box-pack-start box2 button t t 0)
  	      (signal-connect
  	       button 'clicked
  	       #'(lambda ()
  		   (notebook-next-page notebook))))
  
  	    (let ((button (button-new "rotate"))
  		  (tab-pos 0))
  	      (box-pack-start box2 button t t 0)
  	      (signal-connect
  	       button 'clicked
  	       #'(lambda ()
  		   (setq tab-pos (mod (1+ tab-pos) 4))
  		   (setf
  		    (notebook-tab-pos notebook)
  		    (svref #(:top :bottom :right :left) tab-pos)))))))))))
  
  
  
  ;;; Panes
  
negative.code: ;; 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.3 2004-10-31 12:10:54 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
  
  
  ;(use-package "GTK")
  (in-package "GTK")
  
  (defmacro define-toplevel (name (window title &rest initargs) &body body)
    `(let ((,window nil))
       (defun ,name ()
         (unless ,window
  	 (setq ,window (apply #'make-instance 'window :title ,title ',initargs))
  	 (signal-connect ,window 'destroy #'(lambda () (setq ,window nil)))
  	 ,@body)
         
         (if (not (widget-visible-p ,window))
  	   (widget-show-all ,window)
  	 (widget-hide ,window)))))
  
  
  (defmacro define-dialog (name (dialog title &optional (class 'dialog)
  			       &rest initargs)
  			 &body body)
    `(let ((,dialog nil))
       (defun ,name ()
         (unless ,dialog
  	 (setq ,dialog (apply #'make-instance ,class :title ,title ',initargs))
  	 (signal-connect ,dialog 'destroy #'(lambda () (setq ,dialog nil)))
  	 ,@body)
         
         (if (not (widget-visible-p ,dialog))
  	   (widget-show ,dialog)
  	 (widget-hide ,dialog)))))
  
  
  (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))
  
  
  
  