anchor.diff:  					  event
   					  window
   					  x y)
  -	  (funcall (cdr context) object ptype event options))))))
  +	  (when ptype
  +	    (funcall (cdr context) object ptype event options)))))))
  +
  
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:     (options ptype)))
  
  (defmacro with-presentation-type-parameters ((type-name type) &body body)
    (let ((ptype (get-ptype type-name)))
      (unless ptype
        (error "~S is not a presentation type name." type-name))
      (if (typep ptype 'presentation-type)
  	(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))))
  	`(let ()
  	   ,@body))))
  
  
  (defmacro with-presentation-type-options ((type-name type) &body body)
    (let ((ptype (get-ptype type-name)))
      (unless ptype
        (error "~S is not a presentation type name." type-name))
      (if (typep ptype 'presentation-type)
  	(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))))
  	`(let ()
  	   ,@body))))
  
  (eval-when (:compile-toplevel :load-toplevel :execute)
    (defvar *presentation-type-abbreviations* (make-hash-table :test #'eq)))
  