From: daanturo <daanturo@gmail.com>
To: 59820@debbugs.gnu.org
Subject: bug#59820: [PATCH] * nadvice/nadvice.el: support non-symbol (closure/lambda) advices (old Emacs)
Date: Mon, 5 Dec 2022 00:14:49 +0700 [thread overview]
Message-ID: <93f01864-6cdf-2d04-d08c-d0b52dc7773f@gmail.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 1820 bytes --]
This patch provides the ELPA version (for Emacs < 24.4) of nadvice.el's
advice-add the ability to handle anonymous advices.
I have tested with a simple example:
```emacs-lisp
(let* ((sym (make-symbol "nadvice λ")))
(defalias sym (lambda (&rest args) '(1)))
(advice-add sym :around (lambda (func &rest args)
(append (apply func args) '(2))))
(vector
;; advised returned value
(funcall sym)
(progn
(advice-remove sym (lambda (func &rest args)
(append (apply func args) '(2))))
;; unadvised returned value
(funcall sym))))
;; => [(1 2) (1)]
```
In GNU Emacs 24.3.1 (x86_64-redhat-linux-gnu, GTK+ Version 3.22.30)
of 2020-04-04 on x86-01.bsys.centos.org
Windowing system distributor `The X.Org Foundation', version
11.0.12201005
Configured using:
`configure '--build=x86_64-redhat-linux-gnu'
'--host=x86_64-redhat-linux-gnu' '--program-prefix='
'--disable-dependency-tracking' '--prefix=/usr' '--exec-prefix=/usr'
'--bindir=/usr/bin' '--sbindir=/usr/sbin' '--sysconfdir=/etc'
'--datadir=/usr/share' '--includedir=/usr/include'
'--libdir=/usr/lib64' '--libexecdir=/usr/libexec'
'--localstatedir=/var' '--sharedstatedir=/var/lib'
'--mandir=/usr/share/man' '--infodir=/usr/share/info' '--with-dbus'
'--with-gif' '--with-jpeg' '--with-png' '--with-rsvg' '--with-tiff'
'--with-xft' '--with-xpm' '--with-x-toolkit=gtk3' '--with-gpm=no'
'build_alias=x86_64-redhat-linux-gnu'
'host_alias=x86_64-redhat-linux-gnu' 'CFLAGS=-DMAIL_USE_LOCKF -O2 -g
-pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions
-fstack-protector-strong --param=ssp-buffer-size=4
-grecord-gcc-switches -m64 -mtune=generic' 'LDFLAGS=-Wl,-z,relro ''
--
Daanturo.
[-- Attachment #2: 0001-nadvice-nadvice.el-support-non-symbol-advices.patch --]
[-- Type: text/x-patch, Size: 3446 bytes --]
From b07fd697e097ed0ca6040781830ad42be2a9ac86 Mon Sep 17 00:00:00 2001
From: Daanturo <daanturo@gmail.com>
Date: Sun, 4 Dec 2022 21:34:52 +0700
Subject: [PATCH] * nadvice/nadvice.el: support non-symbol advices
(advice-add): by aliasing the function to a new symbol
---
nadvice.el | 53 +++++++++++++++++++++++++++++++----------------------
1 file changed, 31 insertions(+), 22 deletions(-)
diff --git a/nadvice.el b/nadvice.el
index 58523f6..443a5d0 100644
--- a/nadvice.el
+++ b/nadvice.el
@@ -52,30 +52,38 @@
(defun advice-member-p (advice symbol)
(ad-find-advice symbol 'around advice))
+
+(defun advice--ensure-symbol (func)
+ (if (symbolp func)
+ func
+ (let* ((sym (intern (format "%S" func))))
+ (unless (fboundp sym)
+ (defalias sym func))
+ sym)))
+
;;;###autoload
(defun advice-add (symbol where function &optional props)
(when props
(error "This version of nadvice.el does not support PROPS"))
- (unless (symbolp function)
- (error "This version of nadvice.el requires FUNCTION to be a symbol"))
- (let ((body (cond
- ((eq where :before)
- `(progn (apply #',function (ad-get-args 0)) ad-do-it))
- ((eq where :after)
- `(progn ad-do-it (apply #',function (ad-get-args 0))))
- ((eq where :override)
- `(setq ad-return-value (apply #',function (ad-get-args 0))))
- ((eq where :around)
- `(setq ad-return-value
- (apply #',function
- (lambda (&rest nadvice--rest-arg)
- (ad-set-args 0 nadvice--rest-arg)
- ad-do-it)
- (ad-get-args 0))))
- (t (error "This version of nadvice.el does not handle %S"
- where)))))
+ (let* ((advice-fn (advice--ensure-symbol function))
+ (body (cond
+ ((eq where :before)
+ `(progn (apply #',advice-fn (ad-get-args 0)) ad-do-it))
+ ((eq where :after)
+ `(progn ad-do-it (apply #',advice-fn (ad-get-args 0))))
+ ((eq where :override)
+ `(setq ad-return-value (apply #',advice-fn (ad-get-args 0))))
+ ((eq where :around)
+ `(setq ad-return-value
+ (apply #',advice-fn
+ (lambda (&rest nadvice--rest-arg)
+ (ad-set-args 0 nadvice--rest-arg)
+ ad-do-it)
+ (ad-get-args 0))))
+ (t (error "This version of nadvice.el does not handle %S"
+ where)))))
(ad-add-advice symbol
- `(,function nil t (advice lambda () ,body))
+ `(,advice-fn nil t (advice lambda () ,body))
'around
nil)
(ad-activate symbol)))
@@ -84,9 +92,10 @@
(defun advice-remove (symbol function)
;; Just return nil if there is no advice, rather than signaling an
;; error.
- (when (advice-member-p function symbol)
- (ad-remove-advice symbol 'around function)
- (ad-activate symbol)))
+ (let* ((advice-fn (advice--ensure-symbol function)))
+ (when (advice-member-p advice-fn symbol)
+ (ad-remove-advice symbol 'around advice-fn)
+ (ad-activate symbol))))
)
--
2.38.1
next reply other threads:[~2022-12-04 17:14 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-12-04 17:14 daanturo [this message]
2022-12-13 1:04 ` bug#59820: [PATCH] * nadvice/nadvice.el: support non-symbol (closure/lambda) advices (old Emacs) Stefan Kangas
2022-12-13 13:50 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-12-13 14:59 ` daanturo
2022-12-13 15:02 ` Daan Ro
2023-10-09 9:45 ` Stefan Kangas
2023-10-09 22:06 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-10-10 10:44 ` Stefan Kangas
2023-10-11 6:04 ` Daan Ro
2023-10-11 6:50 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=93f01864-6cdf-2d04-d08c-d0b52dc7773f@gmail.com \
--to=daanturo@gmail.com \
--cc=59820@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.