anchor.diff:  (defun presentation-type-history (type)
     (funcall-presentation-generic-function presentation-type-history type))
   
  -(defclass presentation-history-ring (goatee::ring)
  -  ())
  +(defclass presentation-history ()
  +  ((stack :accessor presentation-history-array
  +          :initform (make-array 1 :fill-pointer 0
  +                                  :adjustable t)
  +          :documentation "The history, with the newest objects at
  +the end of the array. Should contain conses with the car being
  +the object and the cdr being the type.")
  +   (pointer :accessor presentation-history-pointer
  +            :initform nil
  +            :documentation "The index of the \"current\" object,
  +used when navigating the history. If NIL, means that no
  +navigation has yet been performed."))
  +  (:documentation "Class for objects that contain the history for
  +a specific type."))
   
   (define-default-presentation-method presentation-type-history (type)
     (if (and *application-frame*
  
positive.code: 		    (history-object (gethash name history-table)))
  	       (unless history-object
  		 (setf history-object
  		       (make-instance 'presentation-history-ring)
  		       (gethash name history-table)
  		       history-object))
  	       history-object))
  
negative.code:   (funcall-presentation-generic-function presentation-type-history type))
  
  (defun presentation-history-insert (history object ptype)
    "Unconditionally insert `object' as an input of presentation
  type `type' at the top of the presentation history `history', as
  the most recently added object."
    (vector-push-extend (cons object ptype)
                        (presentation-history-array history)))
  
  (defun presentation-history-top (history ptype)
    "Find the topmost (most recently added object) of `history'
  that is of the presentation type `ptype' or a subtype. Two values
  will be returned, the object and the presentation type of the
  object. If no applicable object can be found, these values will
  both be NIL."
    (loop
       with array = (presentation-history-array history)
       for index from (1- (fill-pointer array)) downto 0
       for (object . object-ptype) = (aref array index)
       do
       (when (presentation-subtypep object-ptype ptype)
         (return (aref array index)))
       finally (return (values nil nil))))
  
  (defun presentation-history-reset-pointer (history)
    "Set the pointer to point at the object most recently added
  object."
    (setf (presentation-history-pointer history) nil))
  
  (defun presentation-history-next (history ptype)
    "Go to the next input (forward in time) in `history' that is a
  presentation-subtype of `ptype', respective to the pointer in
  `history'. Returns two values: the found object and its
  presentation type, both of which will be NIL if no applicable
  object can be found."
    (with-accessors ((pointer presentation-history-pointer)
                     (array presentation-history-array)) history
      ;; If no navigation has been performed, we have no object to go
      ;; forwards to.
      (if (or (null pointer) (>= (1+ pointer) (length array)))
          (values nil nil)
          (progn
            (incf pointer)
            (destructuring-bind (object . object-ptype)
                (aref array pointer)
              (if object-ptype
                  (if (presentation-subtypep object-ptype ptype)
                      (values object object-ptype)
                      (presentation-history-next history ptype))
                  (values nil nil)))))))
  
  (defun presentation-history-previous (history ptype)
    "Go to the previous input (backward in time) in `history' that
  is a presentation-subtype of `ptype', respective to the pointer
  in `history'. Returns two values: the found object and its
  presentation type, both of which will be NIL if no applicable
  object can be found."
    (with-accessors ((pointer presentation-history-pointer)
                     (array presentation-history-array)) history
      (if (and (numberp pointer) (zerop pointer))
          (values nil nil)
          (progn
            (if pointer
                (decf pointer)
                (setf pointer (1- (fill-pointer array))))
            (destructuring-bind (object . object-ptype)
                (when (array-in-bounds-p array pointer)
                  (aref array pointer))
              (if object-ptype
                  (if (presentation-subtypep object-ptype ptype)
                      (values object object-ptype)
                      (progn (presentation-history-previous history ptype)))
                  (values nil nil)))))))
  
  (defmacro with-object-on-history ((history object ptype) &body body)
    "Evaluate `body' with `object' as `ptype' as the head (most
  recently added object) on `history', and remove it again after
  `body' has run. If `body' as `ptype' is already the head, the
  history will be unchanged."
    (with-gensyms (added)
      `(let ((,added (presentation-history-add ,history ,object ,ptype)))
         (unwind-protect (progn ,@body)
           (when ,added
             (decf (fill-pointer (presentation-history-array ,history))))))))
  
  (defun presentation-history-add (history object ptype)
    "Add OBJECT and PTYPE to the HISTORY unless they are already at the head of
   HISTORY"
    (multiple-value-bind (top-object top-ptype)
        (presentation-history-top history ptype)
      (unless (and top-ptype (eql object top-object) (equal ptype top-ptype))
        (presentation-history-insert history object ptype))))
  
  ;;; Context-dependent input
  