Function: subr--with-wrapper-hook-no-warnings

subr--with-wrapper-hook-no-warnings is a macro defined in subr.el.gz.

Signature

(subr--with-wrapper-hook-no-warnings HOOK ARGS &rest BODY)

Documentation

Like (with-wrapper-hook HOOK ARGS BODY), but without warnings.

Source Code

;; Defined in /usr/src/emacs/lisp/subr.el.gz
(defmacro subr--with-wrapper-hook-no-warnings (hook args &rest body)
  "Like (with-wrapper-hook HOOK ARGS BODY), but without warnings."
  (declare (debug (form sexp def-body)))
  ;; We need those two gensyms because CL's lexical scoping is not available
  ;; for function arguments :-(
  (let ((funs (make-symbol "funs"))
        (global (make-symbol "global"))
        (argssym (make-symbol "args"))
        (runrestofhook (make-symbol "runrestofhook")))
    ;; Since the hook is a wrapper, the loop has to be done via
    ;; recursion: a given hook function will call its parameter in order to
    ;; continue looping.
    `(letrec ((,runrestofhook
               (lambda (,funs ,global ,argssym)
                 ;; `funs' holds the functions left on the hook and `global'
                 ;; holds the functions left on the global part of the hook
                 ;; (in case the hook is local).
                 (if (consp ,funs)
                     (if (eq t (car ,funs))
                         (funcall ,runrestofhook
                                  (append ,global (cdr ,funs)) nil ,argssym)
                       (apply (car ,funs)
                              (apply-partially
                               (lambda (,funs ,global &rest ,argssym)
                                 (funcall ,runrestofhook ,funs ,global ,argssym))
                               (cdr ,funs) ,global)
                              ,argssym))
                   ;; Once there are no more functions on the hook, run
                   ;; the original body.
                   (apply (lambda ,args ,@body) ,argssym)))))
       (funcall ,runrestofhook ,hook
                ;; The global part of the hook, if any.
                ,(if (symbolp hook)
                     `(if (local-variable-p ',hook)
                          (default-value ',hook)))
                (list ,@args)))))