anchor.diff:  
   (defmethod print-object ((obj presentation-translator) stream)
     (print-unreadable-object (obj stream :identity t)
  -    (format stream "Translator from ~S to ~S" (from-type obj) (to-type obj))))
  +    (format stream "Translator ~S from ~S to ~S"
  +	    (name obj) (from-type obj) (to-type obj))))
  +
  +(defclass presentation-action (presentation-translator)
  +  ())
  +
  +(defmethod initialize-instance :after ((obj presentation-action)
  +				       &key &allow-other-keys)
  +  (setf (slot-value obj 'tester-definitive) t))
  +
  +(defmethod print-object ((obj presentation-action) stream)
  +  (print-unreadable-object (obj stream :identity t)
  +    (format stream "Action from ~S to ~S" (from-type obj) (to-type obj))))
   
   ;;; This lives in a command table
   
  
positive.code:     (options ptype)))
  
  (defmacro with-presentation-type-parameters ((type-name type) &body body)
    (let ((ptype (gethash type-name *presentation-type-table*)))
      (unless ptype
        (error "~S is not a presentation type name." type-name))
      (let* ((params-ll (parameters-lambda-list ptype))
  	   (params (gensym "PARAMS"))
  	   (type-var (gensym "TYPE-VAR"))
  	   (ignorable-vars (get-all-params params-ll)))
        `(let ((,type-var ,type))
  	 (unless (eq ',type-name (presentation-type-name ,type-var))
  	   (error "Presentation type specifier ~S does not match the name ~S"
  		  ,type-var
  		  ',type-name))
  	 (let ((,params (decode-parameters ,type-var)))
  	   (declare (ignorable ,params))
  	   (destructuring-bind ,params-ll ,params
  	     (declare (ignorable ,@ignorable-vars))
  	     ,@body))))))
  
  (defmacro with-presentation-type-options ((type-name type) &body body)
    (let ((ptype (gethash type-name *presentation-type-table*)))
      (unless ptype
        (error "~S is not a presentation type name." type-name))
      (let* ((options-ll (options-lambda-list ptype))
  	   (options (gensym "OPTIONS"))
  	   (type-var (gensym "TYPE-VAR"))
  	   (ignorable-vars (get-all-params options-ll)))
        `(let ((,type-var ,type))
  	 (unless (eq ',type-name (presentation-type-name ,type-var))
  	   (error "Presentation type specifier ~S does not match the name ~S"
  		  ,type-var
  		  ',type-name))
  	 (let ((,options (decode-options ,type-var)))
  	   (declare (ignorable ,options))
  	   (destructuring-bind ,options-ll ,options
  	     (declare (ignorable ,@ignorable-vars))
  	     ,@body))))))
  
  (eval-when (:compile-toplevel :load-toplevel :execute)
    (defvar *presentation-type-abbreviations* (make-hash-table :test #'eq)))
  
negative.code:       (push translator
  	    (gethash (from-type translator) simple-type-translators)))))
  
  (defun make-translator-fun (args body)
    (multiple-value-bind (ll ignore)
        (make-translator-ll args)
      `(lambda ,ll
         ,@(and ignore (list ignore))
         ,@body)))
  
  (defun make-documentation-fun (from-type doc-arg)
    (cond ((and doc-arg (symbolp doc-arg))
  	 doc-arg)
  	((consp doc-arg)
  	 (make-translator-fun (car doc-arg) (cdr doc-arg)))
  	((stringp doc-arg)
  	 `(lambda (object &key stream &allow-other-keys)
  	   (declare (ignore object))
  	   (write-string ,doc-arg stream)))
  	((null doc-arg)
  	 `(lambda (object &key stream &allow-other-keys)
  	   (present object ',from-type
  	    :stream stream :sensitive nil)))
  	(t (error "Can't handle doc-arg ~S" doc-arg))))
  
  (defmacro define-presentation-translator
      (name (from-type to-type command-table &key
  	   (gesture :select)
  