anchor.diff:        (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)
  
positive.code: 	   (priority 0))
       arglist
       &body body)
    (labels ((make-translator-fun (args body)
  	     (multiple-value-bind (ll ignore)
  		 (make-translator-ll args)
  	       `(lambda ,ll
  		  ,@(and ignore (list ignore))
  		  ,@body)))
  	   (make-documentation-fun (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)))))
      (let* ((real-from-type (expand-presentation-type-abbreviation from-type))
  	   (real-to-type (expand-presentation-type-abbreviation to-type)))
        `(add-translator (presentation-translators (find-command-table
  						  ',command-table))
  		       (make-instance
  			'presentation-translator
  			:name ',name
  			:from-type ',real-from-type
  			:to-type ',real-to-type
  			:gesture ,(if (eq gesture t)
  				      t
  				      `(gethash ',gesture *gesture-names*))
  			:tester ,(if (symbolp tester)
  				     `',tester
  				     `#',(make-translator-fun (car tester)
  							      (cdr tester)))
  			:tester-definitive ',tester-definitive
  			:documentation #',(make-documentation-fun
  					   documentation)
  			,@(when pointer-documentation-p
  				`(:pointer-documentation
  				  #',(make-documentation-fun
  				      pointer-documentation)))
  			:menu ',menu
  			:priority ,priority
  			:translator-function #',(make-translator-fun arglist
  								     body))))))
  ;;; define-presentation-to-command-translator is in commands.lisp
  
  ;;; 23.7.2 Presentation Translator Functions
  
negative.code: 		     #'car
  		     (sort translator-vector #'translator-lessp))))))))
  
  (defgeneric call-presentation-translator
      (translator presentation context-type frame event window x y))
  
  (defmethod call-presentation-translator
      ((translator presentation-translator) presentation context-type
       frame event window x y)
    (multiple-value-bind (object ptype options)
        (funcall (translator-function translator)
  	       (presentation-object presentation)
  