anchor.diff:  ;;;   compound records
   ;;; - How to deal with mixing of positioning/modifying?
   ;;; - When DRAWING-P is NIL, should stream cursor move?
  -;;; - OUTPUT-RECORD is a protocol class, it should not have any slots/methods.
  -;;; - TEXT-DISPLAYED-OUTPUT-RECORD-MIXIN does not store current ink.
  -;;; - There are glitches with O-R-POSITION.
  +;;; - STANDARD-TEXT-DISPLAYED-OUTPUT-RECORD does not store current
  +;;;   ink, clipping region.
  +
  +;;; There is a problem. Some GFs are defined to have "a default method
  +;;; on CGLIM's standard output record class". What does it mean? What
  +;;; is "CLIM's standard output record class"? Is it OUTPUT-RECORD or
  +;;; BASIC-OUTPUT-RECORD? Now they are defined on OUTPUT-RECORD and
  +;;; marked with "XXX DC".
   
   (in-package :CLIM-INTERNALS)
   
  -;;; Should we blow off standard-bounding-rectangle and implement the
  -;;; bounding rectangle protocol ourselves?  Or use x1,y1 from
  -;;; standard-bounding-rectangle as our position?
  -
  -(defclass basic-output-record (bounding-rectangle)
  -  ()
  -  (:documentation "Internal protocol class for common elements of output-record
  - and displayed-output-record"))
  -
  -(defclass basic-output-record-mixin (standard-bounding-rectangle
  -				     basic-output-record)
  -  ((x :initarg :x-position
  -      :initform 0
  -      :type rational)
  -   (y :initarg :y-position
  -      :initform 0
  -      :type rational)
  -   (parent :initarg :parent
  -	   :initform nil
  -           :reader output-record-parent))
  -  (:documentation "Implementation class for the Basic Output Record Protocol"))
  -
  -(defmethod initialize-instance :after ((record basic-output-record-mixin)
  -				       &rest args)
  -  (declare (ignore args))
  -  (with-slots (x y x1 y1 x2 y2) record
  -    (setq x1 x
  -	  y1 y
  -	  x2 x
  -	  y2 y)))
  -
  -(defclass output-record (basic-output-record)
  +(define-protocol-class output-record (bounding-rectangle)
     ())
   
  -(defun output-record-p (x)
  -  (typep x 'output-record))
  -
  -(defclass output-record-mixin (basic-output-record-mixin output-record)
  -  ()
  -  (:documentation "Implementation class for output records i.e., those records
  - that have children."))
  -
  -(defclass displayed-output-record (basic-output-record)
  +(define-protocol-class displayed-output-record (output-record)
     ())
   
  -(defclass displayed-output-record-mixin (basic-output-record-mixin
  -					 displayed-output-record)
  -  ((ink :initarg :ink :reader displayed-output-record-ink)
  -   (initial-x1 :initarg :initial-x1)
  -   (initial-y1 :initarg :initial-y1))
  -  (:documentation "Implementation class for displayed-output-record."))
  -
  -(defun displayed-output-record-p (x)
  -  (typep x 'displayed-output-record))
  -
  -; 16.2.1. The Basic Output Record Protocol
  +;;; 16.2.1. The Basic Output Record Protocol
   #+:cmu(declaim (ftype (function (output-record) (values rational rational))
   		      output-record-position))
   (defgeneric output-record-position (record)
  
positive.code: 
  (defgeneric tree-recompute-extent (record))
  
  ;;; Methods
  
  (defmethod output-record-position ((record basic-output-record-mixin))
    (with-slots (x y) record
      (values x y)))
  
  (defvar *suppress-notify-parent* nil
    "When t, don't notify the parent of a change in an output record's
     bounding rectangle.")
  
  (defmethod* (setf output-record-position)
      (nx ny (record basic-output-record-mixin))
    (with-slots (x y x1 y1 x2 y2) record
      (let ((dx (- nx x))
            (dy (- ny y)))
        (incf x1 dx) (incf y1 dy)
        (incf x2 dx) (incf y2 dy))
      (setq x nx
            y ny)))
  
  (defmethod* (setf output-record-position) :before
      (nx ny (record output-record))
    (let ((*suppress-notify-parent* t))
      (multiple-value-bind (old-x old-y) (output-record-position record)
        (let ((dx (- nx old-x))
  	    (dy (- ny old-y)))
  	(map-over-output-records
  	 #'(lambda (child)
  	     (multiple-value-bind (x y) (output-record-position child)
  	       (setf (output-record-position child)
  		     (values (+ x dx) (+ y dy)))))
  	 record)))))
  
  (defmethod* (setf output-record-position) :around
      (nx ny (record basic-output-record))
    (declare (ignore nx ny))
    (if *suppress-notify-parent*
        (call-next-method)
        (with-bounding-rectangle* (min-x min-y max-x max-y) record
  	(call-next-method)
  	(let ((parent (output-record-parent record)))
  	  (when parent
  	    (recompute-extent-for-changed-child parent record
  						min-x min-y max-x max-y))))))
  
  
  (defmethod output-record-start-cursor-position ((record basic-output-record))
    (values nil nil))
  
negative.code:     (function (record standard-sequence-output-record)
       &optional (x-offset 0) (y-offset 0)
       &rest function-args)
    "Applies FUNCTION to all children in the order they were added."
    (declare (ignore x-offset y-offset))
    (loop with children = (output-record-children record)
       for child across children
       do (apply function child function-args)))
  
  (defmethod map-over-output-records-containing-position
      (function (record standard-sequence-output-record) x y
       &optional (x-offset 0) (y-offset 0)
       &rest function-args)
    "Applies FUNCTION to children, containing (X,Y), in the reversed
  order they were added."
    (declare (ignore x-offset y-offset))
    (loop with children = (output-record-children record)
       for i from (1- (length children)) downto 0
       for child = (aref children i)
       when (and (multiple-value-bind (min-x min-y max-x max-y)
                     (output-record-hit-detection-rectangle* child)
                   (and (<= min-x x max-x) (<= min-y y max-y)))
                 (output-record-refined-position-test child x y))
       do (apply function child function-args)))
  
  (defmethod map-over-output-records-overlapping-region
      (function (record standard-sequence-output-record) region
       &optional (x-offset 0) (y-offset 0)
       &rest function-args)
    "Applies FUNCTION to children, overlapping REGION, in the order they
  were added."
    (declare (ignore x-offset y-offset))
    (loop with children = (output-record-children record)
       for child across children
       when (region-intersects-region-p region child)
       do (apply function child function-args)))
  
  ;;; XXX bogus for now.
  (defclass standard-tree-output-record (standard-sequence-output-record)
    (
     ))
  
  ;;; 16.3.2. Graphics Displayed Output Records
  (defclass standard-displayed-output-record (basic-output-record
                                              displayed-output-record)
    ((ink :initarg :ink :reader displayed-output-record-ink)
     (initial-x1 :initarg :initial-x1)
     (initial-y1 :initarg :initial-y1))
    (:documentation "Implementation class for DISPLAYED-OUTPUT-RECORD."))
  
  (defclass standard-graphics-displayed-output-record
      (standard-displayed-output-record graphics-displayed-output-record)
    ((clip :initarg :clipping-region
           :documentation "Clipping region in user coordinates.")
     (transform :initarg :transformation)
     (line-style :initarg :line-style)
     (text-style :initarg :text-style)))
  
  (defmacro def-grecording (name (&rest args) &body body)
    (let ((method-name (intern (format nil "MEDIUM-~A*" name)))
  	(class-name (intern (format nil "~A-OUTPUT-RECORD" name)))
  	(medium (gensym "MEDIUM"))
          (border 'border)
          (class-vars `((stream :initarg :stream)
                        ,@(loop for arg in args
                             collect `(,arg
                                       :initarg ,(intern (symbol-name arg)
                                                         :keyword)))))
          (arg-list (loop for arg in args
                       nconc `(,(intern (symbol-name arg) :keyword) ,arg))))
      `(progn
         (defclass ,class-name (standard-graphics-displayed-output-record)
  	 ,class-vars)
         (defmethod initialize-instance :after ((graphic ,class-name) &rest args)
  	 (declare (ignore args))
  	 (with-slots (x1 y1 x2 y2 initial-x1 initial-y1
  		      stream ink clipping-region transform
  		      line-style text-style
  		      ,@args) graphic
  