Function: ad-map-arglists

ad-map-arglists is a byte-compiled function defined in advice.el.gz.

Signature

(ad-map-arglists SOURCE-ARGLIST TARGET-ARGLIST)

Documentation

Make funcall/apply form to map SOURCE-ARGLIST to TARGET-ARGLIST.

The arguments supplied to TARGET-ARGLIST will be taken from SOURCE-ARGLIST just as if they had been supplied to a function with TARGET-ARGLIST directly. Excess source arguments will be neglected, missing source arguments will be supplied as nil. Returns a funcall or apply form with the second element being function which has to be replaced by an actual function argument. Example:
   (ad-map-arglists '(a &rest args) '(w x y z)) will return
   (funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args)).

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/advice.el.gz
;; @@@ Mapping argument lists:
;; ===========================
;; Here is the problem:
;; Suppose function foo was called with (foo 1 2 3 4 5), and foo has the
;; argument list (x y &rest z), and we want to call the function bar which
;; has argument list (a &rest b) with a combination of x, y and z so that
;; the effect is just as if we had called (bar 1 2 3 4 5) directly.
;; The mapping should work for any two argument lists.

(defun ad-map-arglists (source-arglist target-arglist)
  "Make `funcall/apply' form to map SOURCE-ARGLIST to TARGET-ARGLIST.
The arguments supplied to TARGET-ARGLIST will be taken from SOURCE-ARGLIST just
as if they had been supplied to a function with TARGET-ARGLIST directly.
Excess source arguments will be neglected, missing source arguments will be
supplied as nil.  Returns a `funcall' or `apply' form with the second element
being `function' which has to be replaced by an actual function argument.
Example:
   (ad-map-arglists \\='(a &rest args) \\='(w x y z)) will return
   (funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))."
  (let* ((parsed-source-arglist (ad-parse-arglist source-arglist))
	 (source-reqopt-args (append (nth 0 parsed-source-arglist)
				     (nth 1 parsed-source-arglist)))
	 (source-rest-arg (nth 2 parsed-source-arglist))
	 (parsed-target-arglist (ad-parse-arglist target-arglist))
	 (target-reqopt-args (append (nth 0 parsed-target-arglist)
				     (nth 1 parsed-target-arglist)))
	 (target-rest-arg (nth 2 parsed-target-arglist))
	 (need-apply (and source-rest-arg target-rest-arg))
	 (target-arg-index -1))
    ;; This produces ``error-proof'' target function calls with the exception
    ;; of a case like (&rest a) mapped onto (x &rest y) where the actual args
    ;; supplied to A might not be enough to supply the required target arg X
    (append (list (if need-apply 'apply 'funcall) 'ad--addoit-function)
	    (cond (need-apply
		   ;; `apply' can take care of that directly:
		   (append source-reqopt-args (list source-rest-arg)))
		  (t (mapcar (lambda (_arg)
                               (setq target-arg-index (1+ target-arg-index))
                               (ad-get-argument
                                source-arglist target-arg-index))
			     (append target-reqopt-args
				     (and target-rest-arg
					  ;; If we have a rest arg gobble up
					  ;; remaining source args:
					  (nthcdr (length target-reqopt-args)
						  source-reqopt-args)))))))))