Function: ad-assemble-advised-definition

ad-assemble-advised-definition is a byte-compiled function defined in advice.el.gz.

Signature

(ad-assemble-advised-definition ARGS DOCSTRING INTERACTIVE ORIG &optional BEFORES AROUNDS AFTERS)

Documentation

Assemble the advices into an overall advice function.

ARGS is the argument list that has to be used, DOCSTRING if non-nil defines the documentation of the definition, INTERACTIVE if non-nil is the interactive form to be used, ORIG is a form that calls the body of the original unadvised function, and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG should be modified. The assembled function will be returned.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/advice.el.gz
(defun ad-assemble-advised-definition
    (args docstring interactive orig &optional befores arounds afters)
  "Assemble the advices into an overall advice function.
ARGS is the argument list that has to be used,
DOCSTRING if non-nil defines the documentation of the definition,
INTERACTIVE if non-nil is the interactive form to be used,
ORIG is a form that calls the body of the original unadvised function,
and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG
should be modified.  The assembled function will be returned."
  ;; The ad-do-it call should always have the right number of arguments,
  ;; but the compiler might signal a bogus warning because it checks the call
  ;; against the advertised calling convention.
  (let ((around-form `(setq ad-return-value (with-no-warnings ,orig)))
        before-forms around-form-protected after-forms definition)
    (dolist (advice befores)
      (cond ((and (ad-advice-protected advice)
                  before-forms)
             (setq before-forms
                   `((unwind-protect
                         ,(macroexp-progn before-forms)
                       ,@(ad-body-forms
                          (ad-advice-definition advice))))))
            (t (setq before-forms
                     (append before-forms
                             (ad-body-forms (ad-advice-definition advice)))))))

    (dolist (advice (reverse arounds))
      ;; If any of the around advices is protected then we
      ;; protect the complete around advice onion:
      (if (ad-advice-protected advice)
          (setq around-form-protected t))
      (setq around-form
            (ad-substitute-tree
             (lambda (form) (eq form 'ad-do-it))
             (lambda (_form) around-form)
             (macroexp-progn (ad-body-forms (ad-advice-definition advice))))))

    (setq after-forms
	  (if (and around-form-protected before-forms)
	      `((unwind-protect
                     ,(macroexp-progn before-forms)
                  ,around-form))
              (append before-forms (list around-form))))
    (dolist (advice afters)
      (cond ((and (ad-advice-protected advice)
                  after-forms)
             (setq after-forms
                   `((unwind-protect
                         ,(macroexp-progn after-forms)
                       ,@(ad-body-forms
                          (ad-advice-definition advice))))))
            (t (setq after-forms
                     (append after-forms
                             (ad-body-forms (ad-advice-definition advice)))))))

    (setq definition
	  `(lambda (ad--addoit-function ,@args)
            ,@(if docstring (list docstring))
            ,@(if interactive (list interactive))
            (let (ad-return-value)
              ,@after-forms
              ad-return-value)))

    (ad-insert-argument-access-forms definition args)))