From 1148d375898652ce5dec986d11bec46bb8ac0e6d Mon Sep 17 00:00:00 2001 From: Leo Liu Date: Tue, 18 Nov 2014 23:57:01 +0800 Subject: New macro define-advice * doc/lispref/functions.texi (Advising Named Functions): Document define-advice. * lisp/emacs-lisp/nadvice.el (define-advice): New macro. * lisp/emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression): Add define-advice. (lisp-font-lock-keywords-1): Add define-advice. --- lisp/emacs-lisp/nadvice.el | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) (limited to 'lisp/emacs-lisp/nadvice.el') diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index bfd939d69e2..a81d3e43de3 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -441,6 +441,30 @@ of the piece of advice." (fset symbol (car (get symbol 'advice--saved-rewrite))))))) nil) +;;;###autoload +(defmacro define-advice (symbol args &rest body) + "Define an advice and add it to function named SYMBOL. +See `advice-add' and `add-function' for explanation on the +arguments. Note if NAME is nil the advice is anonymous; +otherwise it is named `SYMBOL@NAME'. + +\(fn SYMBOL (WHERE LAMBDA-LIST &optional NAME DEPTH) &rest BODY)" + (declare (indent 2) (doc-string 3) (debug (sexp sexp body))) + (or (listp args) (signal 'wrong-type-argument (list 'listp args))) + (or (<= 2 (length args) 4) + (signal 'wrong-number-of-arguments (list 2 4 (length args)))) + (let* ((where (nth 0 args)) + (lambda-list (nth 1 args)) + (name (nth 2 args)) + (depth (nth 3 args)) + (props (and depth `((depth . ,depth)))) + (advice (cond ((null name) `(lambda ,lambda-list ,@body)) + ((or (stringp name) (symbolp name)) + (intern (format "%s@%s" symbol name))) + (t (error "Unrecognized name spec `%S'" name))))) + `(prog1 ,@(and (symbolp advice) `((defun ,advice ,lambda-list ,@body))) + (advice-add ',symbol ,where #',advice ,@(and props `(',props)))))) + (defun advice-mapc (fun symbol) "Apply FUN to every advice function in SYMBOL. FUN is called with a two arguments: the function that was added, and the -- cgit v1.2.3