anchor.diff:      (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 for child across (output-record-children record)
  -	do (apply function child function-args)))
  -
  -;;; This needs to work in "most recently added first" order, which I
  -;;; didn't know until recently :) -- moore
  +  (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))
  -  (with-slots (children) record
  -    (loop 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))))
  +  (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 for child across (output-record-children record)
  -        do (when (region-intersects-region-p region child)
  -             (apply function child function-args))))
  -
  -;;; If the child is the only child of record, the record's bounding rectangle
  -;;; is set to the child's.
  -(defmethod recompute-extent-for-new-child
  -    ((record standard-sequence-output-record) child)
  -  (with-bounding-rectangle* (old-x1 old-y1 old-x2 old-y2) record
  -    (with-slots (parent children x1 y1 x2 y2) record
  -      (if (eql 1 (length children))
  -	  (setf (values x1 y1 x2 y2) (bounding-rectangle* child))
  -	  (with-bounding-rectangle* (x1-child y1-child x2-child y2-child) child
  -	    (minf x1 x1-child)
  -	    (minf y1 y1-child)
  -	    (maxf x2 x2-child)
  -	    (maxf y2 y2-child)))
  -      (when parent
  -        (recompute-extent-for-changed-child parent record
  -					    old-x1 old-y1 old-x2 old-y2)))))
  -
  -(defmethod recompute-extent-for-changed-child :around
  -    ((record basic-output-record-mixin) child
  -     old-min-x old-min-y old-max-x old-max-y)
  -  (declare (ignore child old-min-x old-min-y old-max-x old-max-y))
  -  (let ((old-rectangle (multiple-value-call #'make-bounding-rectangle
  -                         (bounding-rectangle* record))))
  -    (call-next-method)
  -    (with-slots (parent x1 y1 x2 y2) record
  -      (when (and parent (not (region-equal old-rectangle record)))
  -      	(recompute-extent-for-changed-child parent record x1 y1 x2 y2)))))
  -
  -;; Internal helper function
  -(defmethod %tree-recompute-extent* ((record output-record))
  -  (let ((new-x1 0)
  -	(new-y1 0)
  -	(new-x2 0)
  -	(new-y2 0)
  -	(first-time t))
  -    (map-over-output-records
  -     #'(lambda (child)
  -	 (if first-time
  -	     (progn
  -	       (setf (values new-x1 new-y1 new-x2 new-y2)
  -		     (bounding-rectangle* child))
  -	       (setq first-time nil))
  -	     (with-bounding-rectangle* (cx1 cy1 cx2 cy2) child
  -	       (minf new-x1 cx1)
  -	       (minf new-y1 cy1)
  -	       (maxf new-x2 cx2)
  -	       (maxf new-y2 cy2))))
  -     record)
  -    ;; If we don't have any children, collapse the bbox to the min point.
  -    (if first-time
  -	(multiple-value-bind (x1 y1)
  -	    (output-record-position record)
  -	  (values x1 y1 x1 y1))
  -	(values new-x1 new-y1 new-x2 new-y2))))
  -
  -(defmethod recompute-extent-for-changed-child
  -    ((record output-record-mixin) changed-child
  -     old-min-x old-min-y old-max-x old-max-y)
  -  ;; If the child's old and new bbox lies entirely within the record's bbox
  -  ;; then no change need be made to the record's bbox.  Otherwise, if some part
  -  ;; of the child's bbox was on the record's bbox and is now inside, examine
  -  ;; all the children to determine the correct new bbox.
  -  (with-slots (x1 y1 x2 y2) record
  -    (with-bounding-rectangle* (child-x1 child-y1 child-x2 child-y2)
  -	changed-child
  -      (unless (and (> x1 old-min-x)
  -		   (> y1 old-min-y)
  -		   (< x2 old-max-x)
  -		   (< y2 old-max-y)
  -		   (> x1 child-x1)
  -		   (> y1 child-y1)
  -		   (< x2 child-x2)
  -		   (< y2 child-y2))
  -	;; Don't know if changed-child has been deleted or what, so go through
  -	;; all the children and construct the updated bbox.
  -	(setf (values x1 y1 x2 y2) (%tree-recompute-extent* record))
  -	nil))))
  -
  -(defmethod tree-recompute-extent ((record output-record-mixin))
  -  (with-slots (x1 y1 x2 y2) record
  -    (setf (values x1 y1 x2 y2) (%tree-recompute-extent* record))
  -    nil))
  -
  -
  -(defmethod tree-recompute-extent :around ((record output-record))
  -  (let ((old-rectangle (multiple-value-call #'make-bounding-rectangle
  -                         (bounding-rectangle* record))))
  -    (call-next-method)
  -    (with-slots (parent x1 y1 x2 y2) record
  -      (when (and parent (not (region-equal old-rectangle record)))
  -        (recompute-extent-for-changed-child parent record x1 y1 x2 y2)))))
  -
  --
  -;;; Graphics recording classes
  -
  -(defclass graphics-displayed-output-record (displayed-output-record)
  -  ())
  -
  -(defclass graphics-displayed-output-record-mixin
  -    (displayed-output-record-mixin graphics-displayed-output-record)
  +  (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)
  -   ))
  -
  -(defun graphics-displayed-output-record-p (x)
  -  (typep x 'graphics-displayed-output-record))
  -
  --
  -;;; stream-output-history-mixin class
  -
  -(defclass stream-output-history-mixin ()
  -  ())
  -
  -(defclass standard-sequence-output-history
  -    (standard-sequence-output-record stream-output-history-mixin)
  -  ())
  -
  -(defclass standard-tree-output-history
  -    (standard-tree-output-record stream-output-history-mixin)
  -  ())
  -
  --
  -;;; Output-Recording-Stream class
  -
  -(defclass output-recording-stream ()
  -  ())
  -
  -(defun output-recording-stream-p (x)
  -  (typep x 'output-recording-stream))
  -
  -(defclass standard-output-recording-stream (output-recording-stream)
  -  ((recording-p :initform t :reader stream-recording-p)
  -   (drawing-p :initform t :accessor stream-drawing-p)
  -   (output-history :initform (make-instance 'standard-tree-output-history)
  -                   :reader stream-output-history)
  -   (current-output-record :accessor stream-current-output-record)
  -   (current-text-output-record :initform nil
  -                               :accessor stream-current-text-output-record)
  -   (local-record-p :initform t
  -                   :documentation "This flag is used for dealing with streams outputting strings char-by-char.")))
  -
  -;;; 16.4.1 The Output Recording Stream Protocol
  -(defgeneric stream-recording-p (stream))
  -
  -(defgeneric (setf stream-recording-p) (recording-p stream))
  -
  -(defgeneric stream-drawing-p (stream))
  -
  -(defgeneric (setf stream-drawing-p) (drawing-p stream))
  -
  -(defgeneric stream-output-history (stream))
  -
  -(defgeneric stream-current-output-record (stream))
  -
  -(defgeneric (setf stream-current-output-record) (record stream))
  -
  -(defgeneric stream-add-output-record (stream record))
  -
  -(defgeneric stream-replay (stream &optional region))
  -
  -(defgeneric erase-output-record (record stream &optional (errorp t)))
  -
  -(defgeneric copy-textual-output-history (window stream &optional region record))
  -
  -(defmethod (setf stream-recording-p)
  -    (recording-p (stream standard-output-recording-stream))
  -  (let ((old-val (slot-value stream 'recording-p)))
  -    (setf (slot-value stream 'recording-p) recording-p)
  -    (when (not (eql old-val recording-p))
  -      (stream-close-text-output-record stream))
  -    recording-p))
  -
  -;;; 16.4.3 Text Output Recording
  -
  -(defgeneric stream-text-output-record (stream text-style))
  -
  -(defgeneric stream-close-text-output-record (stream))
  -
  -(defgeneric stream-add-character-output
  -  (stream character text-style width height baseline))
  -
  -(defgeneric stream-add-string-output
  -  (stream string start end text-style width height baseline))
  -
  -;;; Methods
  -(defmethod initialize-instance :after ((stream output-recording-stream) &rest args)
  -  (declare (ignore args))
  -  (setf (stream-current-output-record stream) (stream-output-history stream)))
  -
  -(defmethod stream-add-output-record ((stream output-recording-stream) record)
  -  (add-output-record record (stream-current-output-record stream)))
  -
  -(defmethod stream-replay ((stream output-recording-stream) &optional region)
  -  (replay (stream-output-history stream) stream region))
  -
  -(defmacro with-output-recording-options ((stream 
  -					  &key (record nil record-supplied-p)
  -					       (draw nil draw-supplied-p))
  -					 &body body)
  -  (declare (type symbol stream))
  -  (when (eq stream 't)
  -    (setq stream '*standard-output*))
  -  (let ((continuation-name (gensym "WITH-OUTPUT-RECORDING-OPTIONS")))
  -    `(flet ((,continuation-name  (,stream) ,@body))
  -       (declare (dynamic-extent #',continuation-name))
  -       (invoke-with-output-recording-options ,stream
  -                                             #',continuation-name
  -                                             ,(if record-supplied-p
  -						  record
  -						  `(stream-recording-p
  -						    ,stream))
  -					     ,(if draw-supplied-p
  -						  draw
  -						  `(stream-drawing-p
  -						    ,stream))))))
  -
  -
  -(defmethod invoke-with-output-recording-options
  -  ((stream output-recording-stream) continuation record draw)
  -  "Calls CONTINUATION on STREAM enabling or disabling recording and drawing
  -according to the flags RECORD and DRAW."
  -  (letf (((stream-recording-p stream) record)
  -	 ((stream-drawing-p stream) draw))
  -    (funcall continuation stream)))
  -
  -(defmacro with-new-output-record ((stream
  -                                   &optional
  -                                   (record-type 'standard-sequence-output-record)
  -                                   (record nil record-supplied-p)
  -                                   &rest initargs)
  -                                  &body body)
  -  "Creates a new output record of type RECORD-TYPE and then captures
  -the output of BODY into the new output record, and inserts the new
  -record into the current \"open\" output record assotiated with STREAM.
  -    If RECORD is supplied, it is the name of a variable that will be
  -lexically bound to the new output record inside the body. INITARGS are
  -CLOS initargs that are passed to MAKE-INSTANCE when the new output
  -record is created.
  -    It returns the created output record.
  -    The STREAM argument is a symbol that is bound to an output
  -recording stream. If it is T, *STANDARD-OUTPUT* is used."
  -  (declare (type symbol stream record))
  -  (when (eq stream 't)
  -    (setq stream '*standard-output*))
  -  (unless record-supplied-p
  -    (setq record (gensym)))
  -  `(invoke-with-new-output-record
  -    ,stream
  -    #'(lambda (,stream ,record)
  -        (declare (ignorable ,stream ,record))
  -        ,@body)
  -    ',record-type
  -    ,@initargs))
  -
  -(defmethod invoke-with-new-output-record ((stream output-recording-stream)
  -                                          continuation record-type
  -                                          &rest initargs
  -                                          &key parent
  -					  &allow-other-keys)
  -  (stream-close-text-output-record stream)
  -  (unless parent
  -    (setq parent (stream-current-output-record stream)))
  -  (let ((new-record (apply #'make-instance record-type :parent parent initargs)))
  -    (letf (((stream-current-output-record stream) new-record))
  -      ;; Should we switch on recording? -- APD
  -      (funcall continuation stream new-record)
  -      (finish-output stream))
  -    (stream-add-output-record stream new-record)
  -    new-record))
  -
  -(defmacro with-output-to-output-record
  -    ((stream
  -      &optional
  -      (record-type 'standard-sequence-output-record)
  -      (record nil record-supplied-p)
  -      &rest initargs)
  -     &body body)
  -  "Creates a new output record of type RECORD-TYPE and then captures
  -the output of BODY into the new output record. The cursor position of
  -STREAM is initially bound to (0,0)
  -    If RECORD is supplied, it is the name of a variable that will be
  -lexically bound to the new output record inside the body. INITARGS are
  -CLOS initargs that are passed to MAKE-INSTANCE when the new output
  -record is created.
  -    It returns the created output record.
  -    The STREAM argument is a symbol that is bound to an output
  -recording stream. If it is T, *STANDARD-OUTPUT* is used."
  -  (when (eq stream 't)
  -    (setq stream '*standard-output*))
  -  (check-type stream symbol)
  -  (unless record-supplied-p (setq record (gensym "RECORD")))
  -  `(invoke-with-output-to-output-record
  -    ,stream
  -    #'(lambda (,stream ,record)
  -        (declare (ignorable ,stream ,record))
  -        ,@body)
  -    ',record-type
  -    ,@initargs))
  -
  -(defmethod invoke-with-output-to-output-record
  -    ((stream output-recording-stream)
  -     continuation record-type
  -     &rest initargs
  -     &key parent
  -     &allow-other-keys)
  -  (stream-close-text-output-record stream)
  -  (unless parent (setq parent (stream-current-output-record stream)))
  -  (let ((new-record (apply #'make-instance record-type
  -                           :parent parent initargs)))
  -    (with-output-recording-options (stream :record t :draw nil)
  -      (multiple-value-bind (cx cy)
  -          (stream-cursor-position stream)
  -        (unwind-protect
  -             (letf (((stream-current-output-record stream) new-record))
  -               (setf (stream-cursor-position stream) (values 0 0))
  -               (funcall continuation stream new-record)
  -               (finish-output stream))
  -          (setf (stream-cursor-position stream) (values cx cy)))))
  -    new-record))
  -
  -(defmethod scroll-vertical :around ((stream output-recording-stream) dy)
  -  (declare (ignore dy))
  -  (with-output-recording-options (stream :record nil)
  -    (declare (ignore stream))
  -    (call-next-method)))
  -
  -(defmethod scroll-horizontal :around ((stream output-recording-stream) dx)
  -  (declare (ignore dx))
  -  (with-output-recording-options (stream :record nil)
  -    (declare (ignore stream))
  -    (call-next-method)))
  -
  -(defmethod handle-repaint ((stream output-recording-stream) region)
  -  (stream-replay stream region))
  -
  -#|
  -(defmethod handle-event :after ((stream output-recording-stream) (event pointer-button-press-event))
  -  (highlight-output-record (stream-current-output-record stream) stream :highlight))
  -
  -(defmethod handle-event :before ((stream output-recording-stream) (event pointer-button-release-event))
  -  (highlight-output-record (stream-current-output-record stream) stream :unhighlight))
  -|#
  -
  --
  -;;; Graphics and text recording classes
  -
  -(eval-when (:compile-toplevel :load-toplevel :execute)
  -
  -  (defun compute-class-vars (names)
  -    (cons (list 'stream :initarg :stream)
  -	  (loop for name in names
  -		collecting (list name :initarg (intern (symbol-name name)
  -                                                       :keyword)))))
  -
  -  (defun compute-arg-list (names)
  -    (loop for name in names
  -	  nconcing (list (intern (symbol-name name) :keyword) name)))
  -  )
  +   (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))
  +        (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 (graphics-displayed-output-record-mixin)
  -	 ,(compute-class-vars args))
  +       (defclass ,class-name (standard-graphics-displayed-output-record)
  +	 ,class-vars)
          (defmethod initialize-instance :after ((graphic ,class-name) &rest args)
   	 (declare (ignore args))
  -	 (with-slots (x y x1 y1 x2 y2 initial-x1 initial-y1
  +	 (with-slots (x1 y1 x2 y2 initial-x1 initial-y1
   		      stream ink clipping-region transform
   		      line-style text-style
   		      ,@args) graphic
  
positive.code:    #'replay-output-record record region x-offset y-offset
     stream region x-offset y-offset))
  
  ;;; XXX ? should this be defined on output-record at all?
  ;;; Probably not -- moore
  (defmethod erase-output-record ((record output-record) stream
                                  &optional (errorp t))
    (declare (ignore stream errorp))
    nil)
  
  (defmethod output-record-hit-detection-rectangle*
      ((record basic-output-record))
    (bounding-rectangle* record))
  
  (defmethod output-record-refined-position-test ((record basic-output-record)
  
negative.code:   (when (stream-recording-p stream)
      (setf (text-record-wrapped (stream-text-output-record stream nil)) ; FIXME!
            (stream-text-margin stream))))
  
  ;;; 16.4.4. Output Recording Utilities
  
  (defmacro with-output-recording-options ((stream
  					  &key (record nil record-supplied-p)
  					       (draw nil draw-supplied-p))
  					 &body body)
    (when (eq stream 't) (setq stream '*standard-output*))
    (check-type stream symbol)
    (with-gensyms (continuation)
      `(flet ((,continuation  (,stream) ,@body))
         (declare (dynamic-extent #',continuation))
         (invoke-with-output-recording-options
          ,stream #',continuation
          ,(if record-supplied-p record `(stream-recording-p ,stream))
          ,(if draw-supplied-p draw `(stream-drawing-p ,stream))))))
  
  (defmethod invoke-with-output-recording-options
    ((stream output-recording-stream) continuation record draw)
    "Calls CONTINUATION on STREAM enabling or disabling recording and drawing
  according to the flags RECORD and DRAW."
    (letf (((stream-recording-p stream) record)
  	 ((stream-drawing-p stream) draw))
      (funcall continuation stream)))
  
  (defmacro with-new-output-record ((stream
                                     &optional
                                     (record-type 'standard-sequence-output-record)
                                     (record nil record-supplied-p)
                                     &rest initargs)
                                    &body body)
    "Creates a new output record of type RECORD-TYPE and then captures
  the output of BODY into the new output record, and inserts the new
  record into the current \"open\" output record assotiated with STREAM.
      If RECORD is supplied, it is the name of a variable that will be
  lexically bound to the new output record inside the body. INITARGS are
  CLOS initargs that are passed to MAKE-INSTANCE when the new output
  record is created.
      It returns the created output record.
      The STREAM argument is a symbol that is bound to an output
  recording stream. If it is T, *STANDARD-OUTPUT* is used."
    (when (eq stream 't) (setq stream '*standard-output*))
    (check-type stream symbol)
    (unless record-supplied-p (setq record (gensym)))
    `(invoke-with-new-output-record ,stream
                                    #'(lambda (,stream ,record)
                                        (declare (ignorable ,stream ,record))
                                        ,@body)
                                    ',record-type
                                    ,@initargs))
  
  (defmethod invoke-with-new-output-record ((stream output-recording-stream)
                                            continuation record-type
                                            &rest initargs
                                            &key parent
  					  &allow-other-keys)
    (stream-close-text-output-record stream)
    (unless parent (setq parent (stream-current-output-record stream)))
    (let ((new-record (apply #'make-instance record-type :parent parent initargs)))
      (letf (((stream-current-output-record stream) new-record))
        ;; Should we switch on recording? -- APD
        (funcall continuation stream new-record)
        (finish-output stream))
      (stream-add-output-record stream new-record)
      new-record))
  
  (defmacro with-output-to-output-record
      ((stream
        &optional (record-type 'standard-sequence-output-record)
                  (record nil record-supplied-p)
        &rest initargs)
       &body body)
    "Creates a new output record of type RECORD-TYPE and then captures
  the output of BODY into the new output record. The cursor position of
  STREAM is initially bound to (0,0)
      If RECORD is supplied, it is the name of a variable that will be
  lexically bound to the new output record inside the body. INITARGS are
  CLOS initargs that are passed to MAKE-INSTANCE when the new output
  record is created.
      It returns the created output record.
      The STREAM argument is a symbol that is bound to an output
  recording stream. If it is T, *STANDARD-OUTPUT* is used."
    (when (eq stream 't) (setq stream '*standard-output*))
    (check-type stream symbol)
    (unless record-supplied-p (setq record (gensym "RECORD")))
    `(invoke-with-output-to-output-record
      ,stream
      #'(lambda (,stream ,record)
          (declare (ignorable ,stream ,record))
          ,@body)
      ',record-type
      ,@initargs))
  
  (defmethod invoke-with-output-to-output-record
      ((stream output-recording-stream) continuation record-type
       &rest initargs
       &key parent
       &allow-other-keys)
    (stream-close-text-output-record stream)
    (unless parent (setq parent (stream-current-output-record stream)))
    (let ((new-record (apply #'make-instance record-type
                             :parent parent initargs)))
      (with-output-recording-options (stream :record t :draw nil)
        (multiple-value-bind (cx cy)
            (stream-cursor-position stream)
          (unwind-protect
               (letf (((stream-current-output-record stream) new-record))
                 (setf (stream-cursor-position stream) (values 0 0))
                 (funcall continuation stream new-record)
                 (finish-output stream))
            (setf (stream-cursor-position stream) (values cx cy)))))
      new-record))
  
  (defmethod make-design-from-output-record (record)
    ;; FIXME
    (declare (ignore record))
    (error "Not implemented."))
  
  
  ;;; Additional methods
  (defmethod scroll-vertical :around ((stream output-recording-stream) dy)
    (declare (ignore dy))
    (with-output-recording-options (stream :record nil)
      (call-next-method)))
  
  (defmethod scroll-horizontal :around ((stream output-recording-stream) dx)
    (declare (ignore dx))
    (with-output-recording-options (stream :record nil)
      (call-next-method)))
  
  (defmethod handle-repaint ((stream output-recording-stream) region)
    (stream-replay stream region))
  
  #|
  (defmethod handle-event :after ((stream output-recording-stream) (event pointer-button-press-event))
    (highlight-output-record (stream-current-output-record stream) stream :highlight))
  
  (defmethod handle-event :before ((stream output-recording-stream) (event pointer-button-release-event))
    (highlight-output-record (stream-current-output-record stream) stream :unhighlight))
  |#
  