anchor.diff:      ((stream standard-output-recording-stream) &optional region)
     (replay (stream-output-history stream) stream region))
   
  +(defun output-record-ancestor-p (ancestor child)
  +  (loop for record = child then parent
  +     for parent = (output-record-parent record)
  +     when (eq parent nil) do (return nil)
  +     when (eq parent ancestor) do (return t)))
  +
   (defmethod erase-output-record (record (stream standard-output-recording-stream)
                                   &optional (errorp t))
     (letf (((stream-recording-p stream)  nil))
       (let ((region (bounding-rectangle record)))
         (with-bounding-rectangle* (x1 y1 x2 y2) region
  -        (delete-output-record record (stream-output-history stream) errorp)
  -        ;; FIXME: if RECORD is not a child of RECORD, the following
  -        ;; operations should not be done
  -        (draw-rectangle* stream x1 y1 x2 y2 :ink +background-ink+)
  -        (stream-replay stream region)))))
  +        (if (output-record-ancestor-p (stream-output-history stream) record)
  +            (progn
  +              (delete-output-record record (output-record-parent record))
  +              (draw-rectangle* stream x1 y1 x2 y2 :ink +background-ink+)
  +              (stream-replay stream region))
  +            (when errorp
  +              (error "~S is not contained in ~S." record stream)))))))
   
   (defun copy-textual-output-history (window stream &optional region record)
     ;; FIXME
  
positive.code:   (error "Not implemented."))
  
  ;;; 16.4.3. Text Output Recording
  (defclass stream-text-record (standard-text-displayed-output-record)
    ()) ; XXX Is it necessary? -- APD, 2002-06-13.
  
  (defmethod stream-text-output-record
      ((stream standard-output-recording-stream) text-style)
    (declare (ignore text-style))
    (let ((record (stream-current-text-output-record stream)))
      (unless record
        (setf (stream-current-text-output-record stream)
              (setq record (make-instance 'stream-text-record)))
        (with-slots (start-x start-y end-x end-y x1 y1 x2 y2 x y
                     initial-x1 initial-y1) record
  	  (multiple-value-bind (cx cy) (stream-cursor-position stream)
  	    (setq start-x cx
  		  start-y cy
  		  end-x start-x
  		  end-y start-y
  		  x1 (coordinate start-x)
  		  x2 (coordinate end-x)
  		  y1 (coordinate start-y)
  		  y2 (coordinate end-y)
                    initial-x1 x1
                    initial-y1 y1))))
      record))
  
  (defmethod stream-close-text-output-record
  
negative.code:     ((text-record standard-text-displayed-output-record))
    (with-slots (parent x1 y1 x2 y2 width max-height) text-record
                (setq x2 (coordinate (+ x1 width))
                      y2 (coordinate (+ y1 max-height))))
    text-record)
  
  (defmethod add-character-output-to-text-record ; XXX OAOO with ADD-STRING-...
      ((text-record standard-text-displayed-output-record)
       character text-style char-width height new-baseline)
    (destructuring-bind (ink clipping-region) *drawing-options* ; XXX TDO
      (with-slots (strings baseline width max-height start-y end-x end-y)
          text-record
        (if (and strings
                 (let ((string (last1 strings)))
                   (and (eq text-style (slot-value string 'text-style))
                        (eq ink (slot-value string 'ink))
                        (eq clipping-region
                            (slot-value string 'clipping-region)))))
            (vector-push-extend character (slot-value (last1 strings) 'string))
            (nconcf strings
                    (list (make-instance
                           'styled-string
                           :start-x end-x
                           :text-style text-style
                           :ink (first *drawing-options*) ; XXX TDO
                           :clipping-region (second *drawing-options*)
                           :string (make-array 1 :initial-element character
                                               :element-type 'character
                                               :adjustable t
                                               :fill-pointer t)))))
        (setq baseline (max baseline new-baseline)
              end-x (+ end-x char-width)
              max-height (max max-height height)
              end-y (max end-y (+ start-y max-height))
              width (+ width char-width))))
    (tree-recompute-extent text-record))
  
  (defmethod add-string-output-to-text-record
  