Subject: bug#59820: [PATCH] * nadvice/nadvice.el: support non-symbol (closure/lambda) advices (old Emacs)

From: daanturo <[email-masked]>
Date: Mon, 5 Dec 2022 00:14:49 +0700

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.
From b07fd697e097ed0ca6040781830ad42be2a9ac86 Mon Sep 17 00:00:00 2001
From: Daanturo <[email-masked]>
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