anchor.diff:    (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))
  +|#
  
positive.code:    (wrapped :initform nil
  	    :accessor text-record-wrapped)))
  
  (defun text-displayed-output-record-p (x)
    (typep x 'text-displayed-output-record))
  
  (defmethod print-object ((self text-displayed-output-record-mixin) stream)
    (print-unreadable-object (self stream :type t :identity t)
      (if (slot-boundp self 'start-x)
  	(with-slots (start-x start-y strings) self
  	  (format stream "~D,~D ~S" start-x start-y (mapcar #'third strings)))
        (format stream "empty"))))
  
  (defgeneric add-character-output-to-text-record
    (text-record character text-style width height baseline))
  (defgeneric add-string-output-to-text-record
    (text-record string start end text-style width height baseline))
  (defgeneric text-displayed-output-record-string (text-record))
  
  ;;; Methods
  (defmethod tree-recompute-extent
      ((text-record text-displayed-output-record-mixin))
    (with-slots (parent x y
                        x1 y1 x2 y2 width max-height) text-record
                (setq x1 (coordinate x)
                      y1 (coordinate y)
                      x2 (coordinate (+ x width))
                      y2 (coordinate (+ y max-height)))))
  
  (defmethod* (setf output-record-position) :before
      (nx ny (record text-displayed-output-record-mixin))
    (with-slots (x1 y1 x2 y2 x y start-x start-y end-x end-y) record
      (let ((dx (- nx x))
            (dy (- ny y)))
        (incf start-x dx)
        (incf start-y dy)
        (incf end-x dx)
        (incf end-y dy))))
  
  (defmethod add-character-output-to-text-record ((text-record text-displayed-output-record-mixin)
  						character text-style char-width height
  						new-baseline)
    (with-slots (strings baseline width max-height start-y end-x end-y) text-record
      (if (and strings (eq (second (first (last strings))) text-style))
  	(vector-push-extend character (third (first (last strings))))
        (setq strings (nconc strings (list (list end-x text-style (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 ((text-record text-displayed-output-record-mixin)
  					     string start end text-style string-width height
  					     new-baseline)
    (if end
        (setq end (min end (1- (length string))))
        (setq end (1- (length string))))
    (let ((length (max 0 (- (1+ end) start))))
      (cond
       ((= length 1)
        (add-character-output-to-text-record text-record (aref string start) text-style string-width height new-baseline))
       (t
        (setq string (make-array length :displaced-to string
  			       :displaced-index-offset start
  			       :element-type (array-element-type string)))
        (with-slots (strings baseline width max-height start-y end-x end-y) text-record
  	(setq baseline (max baseline new-baseline)
  	      strings (nconc strings
  			     (list (list end-x text-style
  					 (make-array (length string)
  						     :initial-contents string
  						     :element-type 'character
  						     :adjustable t
  						     :fill-pointer t))))
  	      end-x (+ end-x string-width)
  	      max-height (max max-height height)
  	      end-y (max end-y (+ start-y max-height))
  	      width (+ width string-width)))
        (tree-recompute-extent text-record)))))
  
  (defmethod replay-output-record ((record text-displayed-output-record-mixin)
  				 stream
  				 &optional region (x-offset 0) (y-offset 0))
    (declare (ignore region))
    (with-slots (strings baseline max-height start-x start-y wrapped
                 x y x1 y1 initial-x1 initial-y1) record
      (let ((old-medium (sheet-medium stream))
  	  (new-medium (make-medium (port stream) stream)))
        (unwind-protect
             (progn
               (setf (%sheet-medium stream) new-medium) ;is sheet a sheet-with-medium-mixin? --GB
               (setf (%medium-sheet new-medium) stream) ;is medium a basic medium?
               (setf (medium-transformation new-medium)
                     (make-translation-transformation
                      x-offset
                      y-offset))
  
               (setf (stream-cursor-position stream) (values start-x start-y))
               (letf (((slot-value stream 'baseline) baseline))
  
negative.code:    #'replay-output-record record region x-offset y-offset
     stream region x-offset y-offset))
  
  (defmethod output-record-hit-detection-rectangle* ((record output-record))
    ;; XXX DC
    (bounding-rectangle* record))
  
  (defmethod output-record-refined-position-test ((record basic-output-record)
  