branch: externals/compat
commit 538e0c3e7f239c7dd41ae9212813880bcc00b634
Author: Philip Kaludercic <phil...@posteo.net>
Commit: Philip Kaludercic <phil...@posteo.net>
Use nadvice from ELPA instead of manually advising functions
---
compat-macs.el | 18 ++----------------
compat.el | 30 ++++--------------------------
2 files changed, 6 insertions(+), 42 deletions(-)
diff --git a/compat-macs.el b/compat-macs.el
index 6f3236cf9a..5d71ff51a2 100644
--- a/compat-macs.el
+++ b/compat-macs.el
@@ -155,7 +155,7 @@ attributes (see `compat-generate-common')."
,@(if (eq type 'advice)
(cons '(ignore oldfun) body)
body)))
- (lambda (realname version)
+ (lambda (realname _version)
(cond
((memq type '(func macro))
;; Functions and macros are installed by
@@ -164,21 +164,7 @@ attributes (see `compat-generate-common')."
;; function.
`(defalias ',name #',realname))
((eq type 'advice)
- ;; nadvice.el was introduced in Emacs 24.4, so older versions
- ;; have to advise the function using advice.el's `defadvice'.
- (if (or (version<= "24.4" emacs-version)
- (fboundp 'advice-add)) ;via ELPA
- `(advice-add ',name :around #',realname)
- (let ((oldfun (make-symbol (format "compat--oldfun-%S" realname))))
- `(progn
- (defvar ,oldfun (indirect-function ',name))
- (put ',name 'compat-advice-fn #',realname)
- (defalias ',name
- (lambda (&rest args)
- ,(format
- "[Manual compatibility advice for `%S', defined in Emacs
%s]\n\n%s"
- name version (if (fboundp name) (documentation name)
docstring))
- (apply #',realname (cons (autoload-do-load ,oldfun)
args))))))))))
+ `(advice-add ',name :around #',realname))))
(lambda ()
(cond
((memq type '(func macro))
diff --git a/compat.el b/compat.el
index d3f2e50a71..434f471ed6 100644
--- a/compat.el
+++ b/compat.el
@@ -6,7 +6,7 @@
;; Maintainer: Philip Kaludercic <phil...@posteo.net>
;; Version: 28.1.0.0-rc
;; URL: https://git.sr.ht/~pkal/compat/
-;; Package-Requires: ((emacs "24.1"))
+;; Package-Requires: ((emacs "24.1") (nadvice "0.3"))
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
@@ -43,35 +43,13 @@
;;;; Core functionality
-(declare-function advice--p "nadvice" (func))
-(declare-function advice--car "nadvice" (func))
-
;; The implementation is extracted here so that compatibility advice
;; can check if the right number of arguments are being handled.
-(defun compat-func-arity (func &optional handle-advice)
- "A reimplementation of `func-arity' for FUNC.
-If HANDLE-ADVICE is non-nil, return the effective arity of the
-advice."
+(defun compat-func-arity (func)
+ "A reimplementation of `func-arity' for FUNC."
(cond
((or (null func) (and (symbolp func) (not (fboundp func))) )
(signal 'void-function func))
- ((and handle-advice
- (featurep 'nadvice)
- (advice--p func))
- (let* ((adv (advice--car (symbol-function func)))
- (arity (compat-func-arity adv)))
- (cons (1- (car arity))
- (if (numberp (cdr arity))
- (1- (cdr arity))
- (cdr arity)))))
- ((and handle-advice (get func 'compat-advice-fn))
- ;; Handle manual advising:
- (let* ((adv (get func 'compat-advice-fn))
- (arity (compat-func-arity adv)))
- (cons (1- (car arity))
- (if (numberp (cdr arity))
- (1- (cdr arity))
- (cdr arity)))))
((and (symbolp func) (not (null func)))
(compat-func-arity (symbol-function func)))
((eq (car-safe func) 'macro)
@@ -137,7 +115,7 @@ advice."
(defun compat-maxargs-/= (func n)
"Non-nil when FUNC doesn't accept at most N arguments."
(condition-case nil
- (not (eq (cdr (compat-func-arity func t)) n))
+ (not (eq (cdr (compat-func-arity func)) n))
(void-function t))))
;; Load the actual compatibility definitions:
