anchor.diff:  ;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-
   
  -;;;  (c) copyright 1998,1999,2000 by Michael McDonald (mikemac@mikemac.com)
  +;;;  (c) copyright 1998,1999,2000 by 
  +;;;  Michael McDonald (mikemac@mikemac.com), 
  +;;;  Robert Strandh (strandh@labri.u-bordeaux.fr), 
  +;;;  Iban Hatchondo (hatchond@emi.u-bordeaux.fr),
  +;;;  Julien Boninfante (boninfan@emi.u-bordeaux.fr).
   
   ;;; This library is free software; you can redistribute it and/or
   ;;; modify it under the terms of the GNU Library General Public
  
positive.code: ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
  ;;; Boston, MA  02111-1307  USA.
  
  (in-package :CLIM-INTERNALS)
  
  ;;; SHEET class
  
  (defclass sheet ()
    ((port :initform nil
  	 :initarg :port
  	 :accessor port)
     (graft :initform nil
  	  :initarg :graft
  	  :accessor graft)
     (enabled :initform t
  	    :accessor sheet-enabled-p)
     (region :initform (make-bounding-rectangle 0 0 100 100)
  	   :accessor sheet-region)
     ))
  
  (defun sheetp (x)
    (typep x 'sheet))
  
negative.code:   (remove sheet (sheet-children (sheet-parent sheet))))
  
  (defmethod sheet-enabled-children ((sheet sheet))
    (delete-if-not #'sheet-enabled-p (copy-list (sheet-children sheet))))
  
  (defmethod sheet-ancestor-p ((sheet sheet) (putative-ancestor sheet))
    (eq sheet putative-ancestor))
  
  (defmethod raise-sheet ((sheet sheet))
    (setf (sheet-children sheet) (cons sheet (remove sheet (sheet-children sheet))))
    sheet)
  
  (defmethod bury-sheet ((sheet sheet))
    (setf (sheet-children sheet) (nconc (remove sheet (sheet-children sheet)) (list sheet)))
    sheet)
  
  (define-condition sheet-ordering-underspecified (error) ())
  
  (defmethod reorder-sheets ((sheet sheet) new-ordering)
    (when (set-difference (sheet-children sheet) new-ordering)
      (error 'sheet-ordering-underspecified))
    (when (set-difference new-ordering (sheet-children sheet))
      (error 'sheet-is-not-child))
    (setf (sheet-children sheet) new-ordering)
    sheet)
  
  (defmethod sheet-viewable-p ((sheet sheet))
    (and (sheet-parent sheet)
         (sheet-viewable-p (sheet-parent sheet))
         (sheet-enabled-p sheet)))
  
  (defmethod sheet-occluding-sheets ((sheet sheet) (child sheet))
    (labels ((fun (l)
  		(cond ((eq (car l) child) '())
  		      ((region-intersects-region-p
  			(sheet-region (car l)) (sheet-region child))
  		       (cons (car l) (fun (cdr l))))
  		      (t (fun (cdr l))))))
      (fun (sheet-children sheet))))
  
  (defmethod sheet-transformation ((sheet sheet))
    (error "Attempting to get the TRANSFORMATION of a SHEET that doesn't contain one"))
  
  (defmethod (setf sheet-transformation) (transformation (sheet sheet))
    (declare (ignore transformation))
    (error "Attempting to set the TRANSFORMATION of a SHEET that doesn't contain one"))
  
  (defmethod map-sheet-position-to-parent ((sheet sheet) x y)
    (declare (ignore x y))
    (error "Sheet has no parent"))
  
  (defmethod map-sheet-position-to-child ((sheet sheet) x y)
    (declare (ignore x y))
    (error "Sheet has no parent"))
  
  (defmethod map-sheet-rectangle*-to-parent ((sheet sheet) x1 y1 x2 y2)
    (declare (ignore x1 y1 x2 y2))
    (error "Sheet has no parent"))
  
  (defmethod map-sheet-rectangle*-to-child ((sheet sheet) x1 y1 x2 y2)
    (declare (ignore x1 y1 x2 y2))
    (error "Sheet has no parent"))
  
  (defmethod child-containing-position ((sheet sheet) x y)
    (loop for child in (sheet-children sheet)
        do (multiple-value-bind (tx ty) (map-sheet-position-to-child child x y)
  	    (if (and (sheet-enabled-p child)
  		     (region-contains-position-p (sheet-region child) tx ty))
  		(return child)))))
  
  (defmethod children-overlapping-region ((sheet sheet) (region region))
    (loop for child in (sheet-children sheet)
        if (and (sheet-enabled-p child)
  	      (region-intersects-region-p 
  	       region 
  	       (transform-region (sheet-transformation child)
  				 (sheet-region child))))
        collect child))
  
  (defmethod children-overlapping-rectangle* ((sheet sheet) x1 y1 x2 y2)
    (children-overlapping-region sheet (make-rectangle* x1 y1 x2 y2)))
  
  (defmethod sheet-delta-transformation ((sheet sheet) (ancestor (eql nil)))
    (cond ((sheet-parent sheet)
  	 (compose-transformations (sheet-transformation sheet)
  				  (sheet-delta-transformation
  				   (sheet-parent sheet) ancestor)))
  	(t (sheet-transformation sheet))))
    
  (define-condition sheet-is-not-ancestor (error) ())
  
  