[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/compat 5a1f3bdc59 03/84: Merge branch 'master' into ema
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/compat 5a1f3bdc59 03/84: Merge branch 'master' into emacs-29.1 |
|
Date: |
Tue, 3 Jan 2023 08:57:30 -0500 (EST) |
branch: externals/compat
commit 5a1f3bdc5904f9ac403b4d5838c968f780f2d753
Merge: f21b114ec7 edfc71a8b9
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>
Merge branch 'master' into emacs-29.1
---
Makefile | 2 +-
README.md | 7 +
compat-24.4.el | 41 +++---
compat-25.1.el | 30 ++--
compat-26.1.el | 27 ++--
compat-27.1.el | 30 ++--
compat-28.1.el | 45 +++---
compat-macs.el | 133 +++++++++---------
compat-tests.el | 430 ++++++++++++++++++++++++++++----------------------------
compat.el | 32 +----
10 files changed, 379 insertions(+), 398 deletions(-)
diff --git a/Makefile b/Makefile
index f0fe9ec7dd..7148b2f7d9 100644
--- a/Makefile
+++ b/Makefile
@@ -21,7 +21,7 @@ test:
$(EMACS) -Q --batch -L . -l compat-tests.el -f
ert-run-tests-batch-and-exit
clean:
- rm -f $(BYTEC)
+ $(RM) $(BYTEC)
.el.elc:
$(EMACS) -Q --batch -L . -f batch-byte-compile $^
diff --git a/README.md b/README.md
index ccf80adc41..e7e1d3e957 100644
--- a/README.md
+++ b/README.md
@@ -22,6 +22,13 @@ loading `compat-help` (on your system, not in a package) to
get
relevant notes inserted into the help buffers of functions that are
implemented or advised in compat.el.
+Note that compat.el provides a few prefixed function, ie. functions
+with a `compat-` prefix. These are used to provide extended
+functionality for commands that are already defined (`sort`, `assoc`,
+...). It might be possible to transform these into advised functions
+later on, so that the modified functionality is accessible without a
+prefix. Feedback on this point is appreciated.
+
Installation
------------
diff --git a/compat-24.4.el b/compat-24.4.el
index 2d67ce6182..338513fbaa 100644
--- a/compat-24.4.el
+++ b/compat-24.4.el
@@ -28,56 +28,55 @@
;;; Code:
(eval-when-compile (require 'compat-macs))
-(declare-function compat-maxargs-/= "compat" (func n))
;;;; Defined in data.c
-(compat-advise = (number-or-marker &rest numbers-or-markers)
+(compat-defun = (number-or-marker &rest numbers-or-markers)
"Handle multiple arguments."
- :cond (compat-maxargs-/= #'= 'many)
+ :prefix t
(catch 'fail
(while numbers-or-markers
- (unless (funcall oldfun number-or-marker (car numbers-or-markers))
+ (unless (= number-or-marker (car numbers-or-markers))
(throw 'fail nil))
(setq number-or-marker (pop numbers-or-markers)))
t))
-(compat-advise < (number-or-marker &rest numbers-or-markers)
+(compat-defun < (number-or-marker &rest numbers-or-markers)
"Handle multiple arguments."
- :cond (compat-maxargs-/= #'= 'many)
+ :prefix t
(catch 'fail
(while numbers-or-markers
- (unless (funcall oldfun number-or-marker (car numbers-or-markers))
+ (unless (< number-or-marker (car numbers-or-markers))
(throw 'fail nil))
(setq number-or-marker (pop numbers-or-markers)))
t))
-(compat-advise > (number-or-marker &rest numbers-or-markers)
+(compat-defun > (number-or-marker &rest numbers-or-markers)
"Handle multiple arguments."
- :cond (compat-maxargs-/= #'= 'many)
+ :prefix t
(catch 'fail
(while numbers-or-markers
- (unless (funcall oldfun number-or-marker (car numbers-or-markers))
+ (unless (> number-or-marker (car numbers-or-markers))
(throw 'fail nil))
(setq number-or-marker (pop numbers-or-markers)))
t))
-(compat-advise <= (number-or-marker &rest numbers-or-markers)
+(compat-defun <= (number-or-marker &rest numbers-or-markers)
"Handle multiple arguments."
- :cond (compat-maxargs-/= #'= 'many)
+ :prefix t
(catch 'fail
(while numbers-or-markers
- (unless (funcall oldfun number-or-marker (car numbers-or-markers))
+ (unless (<= number-or-marker (car numbers-or-markers))
(throw 'fail nil))
(setq number-or-marker (pop numbers-or-markers)))
t))
-(compat-advise >= (number-or-marker &rest numbers-or-markers)
+(compat-defun >= (number-or-marker &rest numbers-or-markers)
"Handle multiple arguments."
- :cond (compat-maxargs-/= #'= 'many)
+ :prefix t
(catch 'fail
(while numbers-or-markers
- (unless (funcall oldfun number-or-marker (pop numbers-or-markers))
+ (unless (>= number-or-marker (pop numbers-or-markers))
(throw 'fail nil)))
t))
@@ -119,10 +118,12 @@ attention to case differences."
(eq t (compare-strings suffix nil nil
string start-pos nil ignore-case)))))
-(compat-advise split-string (string &optional separators omit-nulls trim)
- "Handle optional argument TRIM."
- :cond (compat-maxargs-/= #'split-string 4)
- (let* ((token (funcall oldfun string separators omit-nulls))
+(compat-defun split-string (string &optional separators omit-nulls trim)
+ "Extend `split-string' by a TRIM argument.
+The remaining arguments STRING, SEPARATORS and OMIT-NULLS are
+handled just as with `split-string'."
+ :prefix t
+ (let* ((token (split-string string separators omit-nulls))
(trimmed (if trim
(mapcar
(lambda (token)
diff --git a/compat-25.1.el b/compat-25.1.el
index fbabae8997..9d2859dc40 100644
--- a/compat-25.1.el
+++ b/compat-25.1.el
@@ -28,18 +28,15 @@
;;; Code:
(eval-when-compile (require 'compat-macs))
-(declare-function compat-maxargs-/= "compat" (func n))
;;;; Defined in fns.c
-(compat-advise sort (seq predicate)
- "Handle SEQ of type vector."
- :cond (condition-case nil
- (ignore (sort [] #'ignore))
- (wrong-type-argument t))
+(compat-defun sort (seq predicate)
+ "Extend `sort' to sort SEQ as a vector."
+ :prefix t
(cond
((listp seq)
- (funcall oldfun seq predicate))
+ (sort seq predicate))
((vectorp seq)
(let ((cseq (sort (append seq nil) predicate)))
(dotimes (i (length cseq))
@@ -116,8 +113,7 @@ Equality with KEY is tested by TESTFN, defaulting to `eq'."
;; As the compatibility advise around `require` is more a hack than
;; of of actual value, the highlighting is suppressed.
:no-highlight t
- :max-version "24.5"
- (if (eq 'feature 'subr-x)
+ (if (eq feature 'subr-x)
(let ((entry (assq feature after-load-alist)))
(let ((load-file-name nil))
(dolist (form (cdr entry))
@@ -128,7 +124,7 @@ Equality with KEY is tested by TESTFN, defaulting to `eq'."
"Bind variables according to VARLIST and evaluate THEN or ELSE.
This is like `if-let' but doesn't handle a VARLIST of the form
\(SYMBOL SOMETHING) specially."
- :feature subr-x
+ :feature 'subr-x
(declare (indent 2)
(debug ((&rest [&or symbolp (symbolp form) (form)])
body)))
@@ -147,7 +143,7 @@ This is like `if-let' but doesn't handle a VARLIST of the
form
"Bind variables according to VARLIST and conditionally evaluate BODY.
This is like `when-let' but doesn't handle a VARLIST of the form
\(SYMBOL SOMETHING) specially."
- :feature subr-x
+ :feature 'subr-x
(declare (indent 1) (debug if-let*))
`(compat--if-let* ,varlist ,(macroexp-progn body)))
@@ -155,7 +151,7 @@ This is like `when-let' but doesn't handle a VARLIST of the
form
"Bind variables according to VARLIST and conditionally evaluate BODY.
Like `when-let*', except if BODY is empty and all the bindings
are non-nil, then the result is non-nil."
- :feature subr-x
+ :feature 'subr-x
(declare (indent 1) (debug if-let*))
`(compat--when-let* ,varlist ,@(or body '(t))))
@@ -175,7 +171,7 @@ SYMBOL is checked for nil.
As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING)
like \((SYMBOL SOMETHING)). This exists for backward compatibility
with an old syntax that accepted only one binding."
- :feature subr-x
+ :feature 'subr-x
(declare (indent 2)
(debug ([&or (symbolp form)
(&rest [&or symbolp (symbolp form) (form)])]
@@ -192,7 +188,7 @@ Evaluate each binding in turn, stopping if a binding value
is nil.
If all are non-nil, return the value of the last form in BODY.
The variable list SPEC is the same as in `if-let'."
- :feature subr-x
+ :feature 'subr-x
(declare (indent 1) (debug if-let))
`(compat-if-let ,spec ,(macroexp-progn body)))
@@ -209,7 +205,7 @@ Is equivalent to:
(+ (- (/ (+ 5 20) 25)) 40)
Note how the single `-' got converted into a list before
threading."
- :feature subr-x
+ :feature 'subr-x
(declare (indent 1)
(debug (form &rest [&or symbolp (sexp &rest form)])))
(let ((body (car forms)))
@@ -234,7 +230,7 @@ Is equivalent to:
(+ 40 (- (/ 25 (+ 20 5))))
Note how the single `-' got converted into a list before
threading."
- :feature subr-x
+ :feature 'subr-x
(declare (indent 1) (debug thread-first))
(let ((body (car forms)))
(dolist (form (cdr forms))
@@ -248,7 +244,7 @@ threading."
(declare-function macrop nil (object))
(compat-defun macroexpand-1 (form &optional environment)
"Perform (at most) one step of macro expansion."
- :feature macroexp
+ :feature 'macroexp
(cond
((consp form)
(let* ((head (car form))
diff --git a/compat-26.1.el b/compat-26.1.el
index fd62072ea3..d6b0d33d14 100644
--- a/compat-26.1.el
+++ b/compat-26.1.el
@@ -29,7 +29,6 @@
(eval-when-compile (require 'compat-macs))
(declare-function compat-func-arity "compat" (func))
-(declare-function compat-maxargs-/= "compat" (func n))
;;;; Defined in eval.c
@@ -43,15 +42,19 @@ function with ‘&rest’ args, or ‘unevalled’ for a special
form."
;;;; Defined in fns.c
-(compat-advise assoc (key alist &optional testfn)
- "Handle TESTFN manually."
- :cond (compat-maxargs-/= #'assoc 3)
+(compat-defun assoc (key alist &optional testfn)
+ "Handle the optional argument TESTFN.
+Equality is defined by the function TESTFN, defaulting to
+‘equal’. TESTFN is called with 2 arguments: a car of an alist
+element and KEY. With no optional argument, the function behaves
+just like `assoc'."
+ :prefix t
(if testfn
(catch 'found
(dolist (ent alist)
(when (funcall testfn (car ent) key)
(throw 'found ent))))
- (funcall oldfun key alist)))
+ (assoc key alist)))
(compat-defun mapcan (func sequence)
"Apply FUNC to each element of SEQUENCE.
@@ -59,33 +62,33 @@ Concatenate the results by altering them (using `nconc').
SEQUENCE may be a list, a vector, a boolean vector, or a string."
(apply #'nconc (mapcar func sequence)))
-(compat-advise line-number-at-pos (&optional position absolute)
+(compat-defun line-number-at-pos (&optional position absolute)
"Handle optional argument ABSOLUTE:
If the buffer is narrowed, the return value by default counts the lines
from the beginning of the accessible portion of the buffer. But if the
second optional argument ABSOLUTE is non-nil, the value counts the lines
from the absolute start of the buffer, disregarding the narrowing."
- :cond (compat-maxargs-/= #'line-number-at-pos 2)
+ :prefix t
(if absolute
(save-restriction
(widen)
- (funcall oldfun position))
- (funcall oldfun position)))
+ (line-number-at-pos position))
+ (line-number-at-pos position)))
;;;; Defined in subr.el
(declare-function compat--alist-get-full-elisp "compat-25.1"
(key alist &optional default remove testfn))
-(compat-advise alist-get (key alist &optional default remove testfn)
+(compat-defun alist-get (key alist &optional default remove testfn)
"Handle TESTFN manually."
:min-version "25.1" ;first defined in 25.1
:max-version "25.3" ;last version without testfn
:realname compat--alist-get-handle-testfn
- :cond (compat-maxargs-/= #'alist-get 5)
+ :prefix t
(if testfn
(compat--alist-get-full-elisp key alist default remove testfn)
- (funcall oldfun key alist default remove)))
+ (alist-get key alist default remove)))
(compat-defun string-trim-left (string &optional regexp)
"Trim STRING of leading string matching REGEXP.
diff --git a/compat-27.1.el b/compat-27.1.el
index 3fb14279aa..7afca8b3ab 100644
--- a/compat-27.1.el
+++ b/compat-27.1.el
@@ -28,7 +28,6 @@
;;; Code:
(eval-when-compile (require 'compat-macs))
-(declare-function compat-maxargs-/= "compat" (func n))
;;;; Defined in fns.c
@@ -99,26 +98,25 @@ Letter-case is significant, but text properties are
ignored."
;;;; Defined in window.c
-(compat-advise recenter (&optional arg redisplay)
+(compat-defun recenter (&optional arg redisplay)
"Handle optional argument REDISPLAY."
- (funcall oldfun arg)
+ :prefix t
+ (recenter arg)
(when (and redisplay recenter-redisplay)
(redisplay)))
;;;; Defined in keymap.c
-(compat-advise lookup-key (keymap key &optional accept-default)
+(compat-defun lookup-key (keymap key &optional accept-default)
"Allow for KEYMAP to be a list of keymaps."
- :cond (condition-case err
- (lookup-key '(x) nil)
- (wrong-type-argument (equal err '(keymapp (x)))))
+ :prefix t
(cond
((keymapp keymap)
- (funcall oldfun keymap key accept-default))
+ (lookup-key keymap key accept-default))
((listp keymap)
(catch 'found
(dolist (map keymap)
- (let ((fn (funcall oldfun map key accept-default)))
+ (let ((fn (lookup-key map key accept-default)))
(when fn (throw 'found fn))))))
((signal 'wrong-type-argument (list 'keymapp keymap)))))
@@ -262,10 +260,9 @@ represent a JSON false value. It defaults to `:false'."
;;;; Defined in subr.el
-(compat-advise setq-local (&rest pairs)
+(compat-defun setq-local (&rest pairs)
"Handle multiple assignments."
- :cond (compat-maxargs-/= #'setq-local 'many)
- (declare (debug setq))
+ :prefix t
(unless (zerop (mod (length pairs) 2))
(error "PAIRS must have an even number of variable/value members"))
(let (body)
@@ -397,7 +394,7 @@ the number of seconds east of Greenwich."
;;;; Defined in files.el
-(compat-advise file-size-human-readable (file-size &optional flavor space unit)
+(compat-defun file-size-human-readable (file-size &optional flavor space unit)
"Handle the optional third and forth argument:
Optional third argument SPACE is a string put between the number and unit.
@@ -408,6 +405,7 @@ position.
Optional fourth argument UNIT is the unit to use. It defaults to \"B\"
when FLAVOR is `iec' and the empty string otherwise. We recommend \"B\"
in all cases, since that is the standard symbol for byte."
+ :prefix t
(let ((power (if (or (null flavor) (eq flavor 'iec))
1024.0
1000.0))
@@ -438,9 +436,9 @@ in all cases, since that is the standard symbol for byte."
;;;; Defined in regexp-opt.el
-(compat-advise regexp-opt (strings &optional paren)
+(compat-defun regexp-opt (strings &optional paren)
"Handle an empty list of strings."
- :feature regexp-opt
+ :prefix t
(if (null strings)
(let ((re "\\`a\\`"))
(cond ((null paren)
@@ -452,7 +450,7 @@ in all cases, since that is the standard symbol for byte."
((eq paren 'symbols)
(concat "\\_\\(<" re "\\)\\_>"))
((concat "\\(" re "\\)"))))
- (funcall oldfun strings paren)))
+ (regexp-opt strings paren)))
;;;; Defined in package.el
diff --git a/compat-28.1.el b/compat-28.1.el
index 032bb8bc3e..028893bf4e 100644
--- a/compat-28.1.el
+++ b/compat-28.1.el
@@ -28,7 +28,6 @@
;;; Code:
(eval-when-compile (require 'compat-macs))
-(declare-function compat-maxargs-/= "compat" (func n))
;;;; Defined in fns.c
@@ -119,13 +118,14 @@ Returns non-nil if GC happened, and nil otherwise."
;;;; Defined in filelock.c
-(compat-advise unlock-buffer ()
+(compat-defun unlock-buffer ()
"Handle `file-error' conditions:
Handles file system errors by calling ‘display-warning’ and
continuing as if the error did not occur."
+ :prefix t
(condition-case error
- (funcall oldfun)
+ (unlock-buffer)
(file-error
(display-warning
'(unlock-file)
@@ -134,23 +134,23 @@ continuing as if the error did not occur."
;;;; Defined in characters.c
-(compat-advise string-width (string &optional from to)
+(compat-defun string-width (string &optional from to)
"Handle optional arguments FROM and TO:
Optional arguments FROM and TO specify the substring of STRING to
consider, and are interpreted as in `substring'."
- :cond (compat-maxargs-/= #'string-width 3)
- (funcall oldfun (substring string (or from 0) to)))
+ :prefix t
+ (string-width (substring string (or from 0) to)))
;;;; Defined in dired.c
-(compat-advise directory-files (directory &optional full match nosort count)
+(compat-defun directory-files (directory &optional full match nosort count)
"Handle additional optional argument COUNT:
If COUNT is non-nil and a natural number, the function will
return COUNT number of file names (if so many are present)."
- :cond (compat-maxargs-/= #'directory-files 5)
- (let ((files (funcall oldfun directory full match nosort)))
+ :prefix t
+ (let ((files (directory-files directory full match nosort)))
(when (natnump count)
(setf (nthcdr count files) nil))
files))
@@ -354,7 +354,7 @@ not a list, return a one-element list containing OBJECT."
All sequences of whitespaces in STRING are collapsed into a
single space character, and leading/trailing whitespace is
removed."
- :feature subr-x
+ :feature 'subr-x
(let ((blank "[[:blank:]\r\n]+"))
(replace-regexp-in-string
"^[[:blank:]\r\n]+\\|[[:blank:]\r\n]+$"
@@ -367,7 +367,7 @@ removed."
All sequences of whitespaces in STRING are collapsed into a
single space character, and leading/trailing whitespace is
removed."
- :feature subr-x
+ :feature 'subr-x
(with-temp-buffer
(insert string)
(goto-char (point-min))
@@ -379,7 +379,7 @@ removed."
(compat-defun string-lines (string &optional omit-nulls)
"Split STRING into a list of lines.
If OMIT-NULLS, empty lines will be removed from the results."
- :feature subr-x
+ :feature 'subr-x
(split-string string "\n" omit-nulls))
(compat-defun string-pad (string length &optional padding start)
@@ -393,7 +393,7 @@ is done.
If START is nil (or not present), the padding is done to the end
of the string, and if non-nil, padding is done to the start of
the string."
- :feature subr-x
+ :feature 'subr-x
(unless (natnump length)
(signal 'wrong-type-argument (list 'natnump length)))
(let ((pad-length (- length (length string))))
@@ -407,7 +407,7 @@ the string."
(compat-defun string-chop-newline (string)
"Remove the final newline (if any) from STRING."
- :feature subr-x
+ :feature 'subr-x
(if (and (>= (length string) 1) (= (aref string (1- (length string))) ?\n))
(substring string 0 -1)
string))
@@ -418,7 +418,7 @@ Like `let', bind variables in BINDINGS and then evaluate
BODY,
but with the twist that BODY can evaluate itself recursively by
calling NAME, where the arguments passed to NAME are used
as the new values of the bound variables in the recursive invocation."
- :feature subr-x
+ :feature 'subr-x
(declare (indent 2) (debug (symbolp (&rest (symbolp form)) body)))
(let ((fargs (mapcar (lambda (b)
(let ((var (if (consp b) (car b) b)))
@@ -565,20 +565,19 @@ is included in the return value."
;;;; Defined in windows.el
-(compat-advise count-windows (&optional minibuf all-frames)
+(compat-defun count-windows (&optional minibuf all-frames)
"Handle optional argument ALL-FRAMES:
If ALL-FRAMES is non-nil, count the windows in all frames instead
just the selected frame."
- :cond (compat-maxargs-/= #'count-windows 2)
+ :prefix t
(if all-frames
(let ((sum 0))
(dolist (frame (frame-list))
(with-selected-frame frame
- (setq sum (+ (funcall oldfun minibuf)
- sum))))
+ (setq sum (+ (count-windows minibuf) sum))))
sum)
- (funcall oldfun minibuf)))
+ (count-windows minibuf)))
;;;; Defined in thingatpt.el
@@ -587,7 +586,7 @@ just the selected frame."
"Return the THING at mouse click.
Like `thing-at-point', but tries to use the event
where the mouse button is clicked to find a thing nearby."
- :feature thingatpt
+ :feature 'thingatpt
(save-excursion
(mouse-set-point event)
(thing-at-point thing no-properties)))
@@ -601,7 +600,7 @@ A non-nil result is expected to be reliable when called
from a macro in order
to find the file in which the macro's call was found, and it should be
reliable as well when used at the top-level of a file.
Other uses risk returning non-nil value that point to the wrong file."
- :feature macroexp
+ :feature 'macroexp
(let ((file (car (last current-load-list))))
(or (if (stringp file) file)
(bound-and-true-p byte-compile-current-file))))
@@ -631,7 +630,7 @@ The previous values will be be restored upon exit."
When clicked, CALLBACK will be called with the DATA as the
function argument. If DATA isn't present (or is nil), the button
itself will be used instead as the function argument."
- :feature button
+ :feature 'button
(propertize string
'face 'button
'button t
diff --git a/compat-macs.el b/compat-macs.el
index 6f3236cf9a..5cf9e4685d 100644
--- a/compat-macs.el
+++ b/compat-macs.el
@@ -64,6 +64,9 @@ attributes are handled, all others are ignored:
- :notes :: Additional notes that a developer using this
compatibility function should keep in mind.
+- :prefix :: Add a `compat-' prefix to the name, and define the
+ compatibility code unconditionally.
+
TYPE is used to set the symbol property `compat-type' for NAME."
(let* ((min-version (plist-get attr :min-version))
(max-version (plist-get attr :max-version))
@@ -82,34 +85,37 @@ TYPE is used to set the symbol property `compat-type' for
NAME."
(match-string 1 file)))))
(realname (or (plist-get attr :realname)
(intern (format "compat--%S" name))))
- (body `(,@(cond
- ((and (or (not version)
- (version< emacs-version version))
- (or (not min-version)
- (version<= min-version emacs-version))
- (or (not max-version)
- (version<= emacs-version max-version)))
- `(when (and ,(if cond cond t)
- ,(funcall check-fn))))
- ('(compat--ignore)))
- ,(unless (plist-get attr :no-highlight)
- `(font-lock-add-keywords
- 'emacs-lisp-mode
- ',`((,(concat "\\_<\\("
- (regexp-quote (symbol-name name))
- "\\)\\_>")
- 1 font-lock-preprocessor-face prepend))))
- ,(funcall install-fn realname version))))
+ (body `(progn
+ ,(unless (plist-get attr :no-highlight)
+ `(font-lock-add-keywords
+ 'emacs-lisp-mode
+ ',`((,(concat "\\_<\\("
+ (regexp-quote (symbol-name name))
+ "\\)\\_>")
+ 1 font-lock-preprocessor-face prepend))))
+ ,(funcall install-fn realname version))))
`(progn
(put ',realname 'compat-type ',type)
(put ',realname 'compat-version ,version)
(put ',realname 'compat-doc ,(plist-get attr :note))
(put ',name 'compat-def ',realname)
,(funcall def-fn realname version)
- ,(if feature
- ;; See https://nullprogram.com/blog/2018/02/22/:
- `(eval-after-load ',feature `(funcall ',(lambda () ,body)))
- body))))
+ (,@(cond
+ ((or (and min-version
+ (version< emacs-version min-version))
+ (and max-version
+ (version< max-version emacs-version)))
+ '(compat--ignore))
+ ((plist-get attr :prefix)
+ '(progn))
+ ((and version (version<= version emacs-version))
+ '(compat--ignore))
+ (`(when (and ,(if cond cond t)
+ ,(funcall check-fn)))))
+ ,(if feature
+ ;; See https://nullprogram.com/blog/2018/02/22/:
+ `(eval-after-load ,feature `(funcall ',(lambda () ,body)))
+ body)))))
(defun compat-common-fdefine (type name arglist docstring rest)
"Generate compatibility code for a function NAME.
@@ -118,7 +124,7 @@ TYPE is one of `func', for functions and `macro' for
macros, and
DOCSTRING is prepended with a compatibility note. REST contains
the remaining definition, that may begin with a property list of
attributes (see `compat-generate-common')."
- (let ((body rest))
+ (let ((oldname name) (body rest))
(while (keywordp (car body))
(setq body (cddr body)))
;; It might be possible to set these properties otherwise. That
@@ -127,6 +133,9 @@ attributes (see `compat-generate-common')."
(when (version<= "25" emacs-version)
(delq (assq 'side-effect-free (car body)) (car body))
(delq (assq 'pure (car body)) (car body))))
+ ;; Check if we want an explicitly prefixed function
+ (when (plist-get rest :prefix)
+ (setq name (intern (format "compat-%s" name))))
(compat-generate-common
name
(lambda (realname version)
@@ -145,17 +154,17 @@ attributes (see `compat-generate-common')."
(if version
(format
"[Compatibility %s for `%S', defined in Emacs %s]\n\n%s"
- type name version docstring)
+ type oldname version docstring)
(format
"[Compatibility %s for `%S']\n\n%s"
- type name docstring)))
+ type oldname docstring)))
;; Advice may use the implicit variable `oldfun', but
;; to avoid triggering the byte compiler, we make
;; sure the argument is used at least once.
,@(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 +173,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))
@@ -243,33 +238,37 @@ local with a value of `permanent' or just buffer local
with any
non-nil value."
(declare (debug (name form stringp [&rest keywordp sexp]))
(doc-string 3) (indent 2))
- (compat-generate-common
- name
- (lambda (realname version)
- (let ((localp (plist-get attr :local)))
- `(progn
- (,(if (plist-get attr :constant) 'defconst 'defvar)
- ,realname ,initval
- ;; Prepend compatibility notice to the actual
- ;; documentation string.
- ,(if version
+ ;; Check if we want an explicitly prefixed function
+ (let ((oldname name))
+ (when (plist-get attr :prefix)
+ (setq name (intern (format "compat-%s" name))))
+ (compat-generate-common
+ name
+ (lambda (realname version)
+ (let ((localp (plist-get attr :local)))
+ `(progn
+ (,(if (plist-get attr :constant) 'defconst 'defvar)
+ ,realname ,initval
+ ;; Prepend compatibility notice to the actual
+ ;; documentation string.
+ ,(if version
+ (format
+ "[Compatibility variable for `%S', defined in Emacs
%s]\n\n%s"
+ oldname version docstring)
(format
- "[Compatibility variable for `%S', defined in Emacs %s]\n\n%s"
- name version docstring)
- (format
- "[Compatibility variable for `%S']\n\n%s"
- name docstring)))
- ;; Make variable as local if necessary
- ,(cond
- ((eq localp 'permanent)
- `(put ',realname 'permanent-local t))
- (localp
- `(make-variable-buffer-local ',realname))))))
- (lambda (realname _version)
- `(defvaralias ',name ',realname))
- (lambda ()
- `(not (boundp ',name)))
- attr 'variable))
+ "[Compatibility variable for `%S']\n\n%s"
+ oldname docstring)))
+ ;; Make variable as local if necessary
+ ,(cond
+ ((eq localp 'permanent)
+ `(put ',realname 'permanent-local t))
+ (localp
+ `(make-variable-buffer-local ',realname))))))
+ (lambda (realname _version)
+ `(defvaralias ',name ',realname))
+ (lambda ()
+ `(not (boundp ',name)))
+ attr 'variable)))
(provide 'compat-macs)
;;; compat-macs.el ends here
diff --git a/compat-tests.el b/compat-tests.el
index ac33f96236..4a4ab25a27 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -408,20 +408,20 @@ the compatibility function."
(ert-deftest compat-string-width ()
"Check if `compat--string-width' was implemented correctly."
- (compat-test string-width
- (compat--should* 0 "")
- (compat--should* 3 "abc") ;no argument
- (compat--should* 5 "abcあ")
- (compat--should* (1+ tab-width) "a ")
- (compat--should* 2 "abc" 1) ;with from
- (compat--should* 4 "abcあ" 1)
- (compat--should* tab-width "a " 1)
- (compat--should* 2 "abc" 0 2) ;with to
- (compat--should* 3 "abcあ" 0 3)
- (compat--should* 1 "a " 0 1)
- (compat--should* 1 "abc" 1 2) ;with from and to
- (compat--should* 2 "abcあ" 3 4)
- (compat--should* 0 "a " 1 1)))
+ (compat-test compat-string-width
+ (compat--should 0 "")
+ (compat--should 3 "abc") ;no argument
+ (compat--should 5 "abcあ")
+ (compat--should (1+ tab-width) "a ")
+ (compat--should 2 "abc" 1) ;with from
+ (compat--should 4 "abcあ" 1)
+ (compat--should tab-width "a " 1)
+ (compat--should 2 "abc" 0 2) ;with to
+ (compat--should 3 "abcあ" 0 3)
+ (compat--should 1 "a " 0 1)
+ (compat--should 1 "abc" 1 2) ;with from and to
+ (compat--should 2 "abcあ" 3 4)
+ (compat--should 0 "a " 1 1)))
(ert-deftest compat-ensure-list ()
"Check if `compat--ensure-list' was implemented correctly."
@@ -530,16 +530,16 @@ the compatibility function."
(ert-deftest compat-regexp-opt ()
"Check if `compat--regexp-opt' advice was defined correctly."
- (compat-test regexp-opt
- ;; Ensure `compat--regexp-opt' doesn't change the existing
- ;; behaviour:
- (compat--should* (regexp-opt '("a" "b" "c")) '("a" "b" "c"))
- (compat--should* (regexp-opt '("abc" "def" "ghe")) '("abc" "def" "ghe"))
- (compat--should* (regexp-opt '("a" "b" "c") 'words) '("a" "b" "c") 'words)
- ;; Test empty list:
- (compat--should* "\\(?:\\`a\\`\\)" '())
- (compat--should* "\\<\\(\\`a\\`\\)\\>" '() 'words))
- (let ((unmatchable (compat--regexp-opt #'regexp-opt '())))
+ (compat-test compat-regexp-opt
+ ;; Ensure `compat--regexp-opt' doesn't change the existing
+ ;; behaviour:
+ (compat--should (regexp-opt '("a" "b" "c")) '("a" "b" "c"))
+ (compat--should (regexp-opt '("abc" "def" "ghe")) '("abc" "def"
"ghe"))
+ (compat--should (regexp-opt '("a" "b" "c") 'words) '("a" "b"
"c") 'words)
+ ;; Test empty list:
+ (compat--should "\\(?:\\`a\\`\\)" '())
+ (compat--should "\\<\\(\\`a\\`\\)\\>" '() 'words))
+ (let ((unmatchable (compat--compat-regexp-opt '())))
(dolist (str '("" ;empty string
"a" ;simple string
"aaa" ;longer string
@@ -548,24 +548,24 @@ the compatibility function."
(ert-deftest compat-assoc ()
"Check if `compat--assoc' advice was advised correctly."
- (compat-test assoc
+ (compat-test compat-assoc
;; Fallback behaviour:
- (compat--should* nil 1 nil) ;empty list
- (compat--should* '(1) 1 '((1))) ;single element list
- (compat--should* nil 1 '(1))
- (compat--should* '(2) 2 '((1) (2) (3))) ;multiple element list
- (compat--should* nil 2 '(1 2 3))
- (compat--should* '(2) 2 '(1 (2) 3))
- (compat--should* nil 2 '((1) 2 (3)))
- (compat--should* '(1) 1 '((3) (2) (1)))
- (compat--should* '("a") "a" '(("a") ("b") ("c"))) ;non-primitive elements
- (compat--should* '("a" 0) "a" '(("c" . "a") "b" ("a" 0)))
+ (compat--should nil 1 nil) ;empty list
+ (compat--should '(1) 1 '((1))) ;single element list
+ (compat--should nil 1 '(1))
+ (compat--should '(2) 2 '((1) (2) (3))) ;multiple element list
+ (compat--should nil 2 '(1 2 3))
+ (compat--should '(2) 2 '(1 (2) 3))
+ (compat--should nil 2 '((1) 2 (3)))
+ (compat--should '(1) 1 '((3) (2) (1)))
+ (compat--should '("a") "a" '(("a") ("b") ("c"))) ;non-primitive elements
+ (compat--should '("a" 0) "a" '(("c" . "a") "b" ("a" 0)))
;; With testfn (advised behaviour):
- (compat--should* '(1) 3 '((10) (4) (1) (9)) #'<)
- (compat--should* '("a") "b" '(("c") ("a") ("b")) #'string-lessp)
- (compat--should* '("b") "a" '(("a") ("a") ("b"))
+ (compat--should '(1) 3 '((10) (4) (1) (9)) #'<)
+ (compat--should '("a") "b" '(("c") ("a") ("b")) #'string-lessp)
+ (compat--should '("b") "a" '(("a") ("a") ("b"))
(lambda (s1 s2) (not (string= s1 s2))))
- (compat--should*
+ (compat--should
'("\\.el\\'" . emacs-lisp-mode)
"file.el"
'(("\\.c\\'" . c-mode)
@@ -574,36 +574,36 @@ the compatibility function."
("\\.awk\\'" . awk-mode))
#'string-match-p)))
-(when (fboundp 'alist-get)
- (ert-deftest compat-alist-get-1 ()
- "Check if `compat--alist-get' was advised correctly."
- (compat-test (alist-get compat--alist-get-handle-testfn)
- ;; Fallback behaviour:
- (compat--should* nil 1 nil) ;empty list
- (compat--should* 'a 1 '((1 . a))) ;single element list
- (compat--should* nil 1 '(1))
- (compat--should* 'b 2 '((1 . a) (2 . b) (3 . c))) ;multiple element list
- (compat--should* nil 2 '(1 2 3))
- (compat--should* 'b 2 '(1 (2 . b) 3))
- (compat--should* nil 2 '((1 . a) 2 (3 . c)))
- (compat--should* 'a 1 '((3 . c) (2 . b) (1 . a)))
- (compat--should* nil "a" '(("a" . 1) ("b" . 2) ("c" . 3)))
;non-primitive elements
-
- ;; With testfn (advised behaviour):
- (compat--should* 1 "a" '(("a" . 1) ("b" . 2) ("c" . 3)) nil nil #'equal)
- (compat--should* 1 3 '((10 . 10) (4 . 4) (1 . 1) (9 . 9)) nil nil #'<)
- (compat--should* '(a) "b" '(("c" c) ("a" a) ("b" b)) nil nil
#'string-lessp)
- (compat--should* 'c "a" '(("a" . a) ("a" . b) ("b" . c)) nil nil
- (lambda (s1 s2) (not (string= s1 s2))))
- (compat--should* 'emacs-lisp-mode
- "file.el"
- '(("\\.c\\'" . c-mode)
- ("\\.p\\'" . pascal-mode)
- ("\\.el\\'" . emacs-lisp-mode)
- ("\\.awk\\'" . awk-mode))
- nil nil #'string-match-p)
- (compat--should* 'd 0 '((1 . a) (2 . b) (3 . c)) 'd) ;default value
- (compat--should* 'd 2 '((1 . a) (2 . b) (3 . c)) 'd nil #'ignore))))
+;; (when (fboundp 'alist-get)
+;; (ert-deftest compat-alist-get-1 ()
+;; "Check if `compat--alist-get' was advised correctly."
+;; (compat-test compat-alist-get
+;; ;; Fallback behaviour:
+;; (compat--should nil 1 nil) ;empty list
+;; (compat--should 'a 1 '((1 . a))) ;single element list
+;; (compat--should nil 1 '(1))
+;; (compat--should 'b 2 '((1 . a) (2 . b) (3 . c))) ;multiple element
list
+;; (compat--should nil 2 '(1 2 3))
+;; (compat--should 'b 2 '(1 (2 . b) 3))
+;; (compat--should nil 2 '((1 . a) 2 (3 . c)))
+;; (compat--should 'a 1 '((3 . c) (2 . b) (1 . a)))
+;; (compat--should nil "a" '(("a" . 1) ("b" . 2) ("c" . 3)))
;non-primitive elements
+
+;; ;; With testfn (advised behaviour):
+;; (compat--should 1 "a" '(("a" . 1) ("b" . 2) ("c" . 3)) nil nil
#'equal)
+;; (compat--should 1 3 '((10 . 10) (4 . 4) (1 . 1) (9 . 9)) nil nil #'<)
+;; (compat--should '(a) "b" '(("c" c) ("a" a) ("b" b)) nil nil
#'string-lessp)
+;; (compat--should 'c "a" '(("a" . a) ("a" . b) ("b" . c)) nil nil
+;; (lambda (s1 s2) (not (string= s1 s2))))
+;; (compat--should 'emacs-lisp-mode
+;; "file.el"
+;; '(("\\.c\\'" . c-mode)
+;; ("\\.p\\'" . pascal-mode)
+;; ("\\.el\\'" . emacs-lisp-mode)
+;; ("\\.awk\\'" . awk-mode))
+;; nil nil #'string-match-p)
+;; (compat--should 'd 0 '((1 . a) (2 . b) (3 . c)) 'd) ;default value
+;; (compat--should 'd 2 '((1 . a) (2 . b) (3 . c)) 'd nil #'ignore))))
(ert-deftest compat-alist-get-2 ()
"Check if `compat--alist-get' was implemented correctly."
@@ -889,143 +889,143 @@ the compatibility function."
(ert-deftest compat-sort ()
"Check if `compat--sort' was advised correctly."
- (compat-test sort
- (compat--should* (list 1 2 3) (list 1 2 3) #'<)
- (compat--should* (list 1 2 3) (list 3 2 1) #'<)
- (compat--should* '[1 2 3] '[1 2 3] #'<)
- (compat--should* '[1 2 3] '[3 2 1] #'<)))
+ (compat-test compat-sort
+ (compat--should (list 1 2 3) (list 1 2 3) #'<)
+ (compat--should (list 1 2 3) (list 3 2 1) #'<)
+ (compat--should '[1 2 3] '[1 2 3] #'<)
+ (compat--should '[1 2 3] '[3 2 1] #'<)))
(ert-deftest compat-= ()
"Check if `compat--=' was advised correctly."
- (compat-test =
- (compat--should* t 0 0)
- (compat--should* t 0 0 0)
- (compat--should* t 0 0 0 0)
- (compat--should* t 0 0 0 0 0)
- (compat--should* t 0.0 0.0)
- (compat--should* t +0.0 -0.0)
- (compat--should* t 0.0 0.0 0.0)
- (compat--should* t 0.0 0.0 0.0 0.0)
- (compat--should* nil 0 1)
- (compat--should* nil 0 0 1)
- (compat--should* nil 0 0 0 0 1)
- (compat--error* wrong-type-argument 0 0 'a)
- (compat--should* nil 0 1 'a)
- (compat--should* nil 0.0 0.0 0.0 0.1)))
+ (compat-test compat-=
+ (compat--should t 0 0)
+ (compat--should t 0 0 0)
+ (compat--should t 0 0 0 0)
+ (compat--should t 0 0 0 0 0)
+ (compat--should t 0.0 0.0)
+ (compat--should t +0.0 -0.0)
+ (compat--should t 0.0 0.0 0.0)
+ (compat--should t 0.0 0.0 0.0 0.0)
+ (compat--should nil 0 1)
+ (compat--should nil 0 0 1)
+ (compat--should nil 0 0 0 0 1)
+ (compat--error wrong-type-argument 0 0 'a)
+ (compat--should nil 0 1 'a)
+ (compat--should nil 0.0 0.0 0.0 0.1)))
(ert-deftest compat-< ()
"Check if `compat--<' was advised correctly."
- (compat-test <
- (compat--should* nil 0 0)
- (compat--should* nil 0 0 0)
- (compat--should* nil 0 0 0 0)
- (compat--should* nil 0 0 0 0 0)
- (compat--should* nil 0.0 0.0)
- (compat--should* nil +0.0 -0.0)
- (compat--should* nil 0.0 0.0 0.0)
- (compat--should* nil 0.0 0.0 0.0 0.0)
- (compat--should* t 0 1)
- (compat--should* nil 1 0)
- (compat--should* nil 0 0 1)
- (compat--should* t 0 1 2)
- (compat--should* nil 2 1 0)
- (compat--should* nil 0 0 0 0 1)
- (compat--should* t 0 1 2 3 4)
- (compat--error* wrong-type-argument 0 1 'a)
- (compat--should* nil 0 0 'a)
- (compat--should* nil 0.0 0.0 0.0 0.1)
- (compat--should* t -0.1 0.0 0.2 0.4)
- (compat--should* t -0.1 0 0.2 0.4)))
+ (compat-test compat-<
+ (compat--should nil 0 0)
+ (compat--should nil 0 0 0)
+ (compat--should nil 0 0 0 0)
+ (compat--should nil 0 0 0 0 0)
+ (compat--should nil 0.0 0.0)
+ (compat--should nil +0.0 -0.0)
+ (compat--should nil 0.0 0.0 0.0)
+ (compat--should nil 0.0 0.0 0.0 0.0)
+ (compat--should t 0 1)
+ (compat--should nil 1 0)
+ (compat--should nil 0 0 1)
+ (compat--should t 0 1 2)
+ (compat--should nil 2 1 0)
+ (compat--should nil 0 0 0 0 1)
+ (compat--should t 0 1 2 3 4)
+ (compat--error wrong-type-argument 0 1 'a)
+ (compat--should nil 0 0 'a)
+ (compat--should nil 0.0 0.0 0.0 0.1)
+ (compat--should t -0.1 0.0 0.2 0.4)
+ (compat--should t -0.1 0 0.2 0.4)))
(ert-deftest compat-> ()
"Check if `compat-->' was advised correctly."
- (compat-test >
- (compat--should* nil 0 0)
- (compat--should* nil 0 0 0)
- (compat--should* nil 0 0 0 0)
- (compat--should* nil 0 0 0 0 0)
- (compat--should* nil 0.0 0.0)
- (compat--should* nil +0.0 -0.0)
- (compat--should* nil 0.0 0.0 0.0)
- (compat--should* nil 0.0 0.0 0.0 0.0)
- (compat--should* t 1 0)
- (compat--should* nil 1 0 0)
- (compat--should* nil 0 1 2)
- (compat--should* t 2 1 0)
- (compat--should* nil 1 0 0 0 0)
- (compat--should* t 4 3 2 1 0)
- (compat--should* nil 4 3 2 1 1)
- (compat--error* wrong-type-argument 1 0 'a)
- (compat--should* nil 0 0 'a)
- (compat--should* nil 0.1 0.0 0.0 0.0)
- (compat--should* t 0.4 0.2 0.0 -0.1)
- (compat--should* t 0.4 0.2 0 -0.1)))
+ (compat-test compat->
+ (compat--should nil 0 0)
+ (compat--should nil 0 0 0)
+ (compat--should nil 0 0 0 0)
+ (compat--should nil 0 0 0 0 0)
+ (compat--should nil 0.0 0.0)
+ (compat--should nil +0.0 -0.0)
+ (compat--should nil 0.0 0.0 0.0)
+ (compat--should nil 0.0 0.0 0.0 0.0)
+ (compat--should t 1 0)
+ (compat--should nil 1 0 0)
+ (compat--should nil 0 1 2)
+ (compat--should t 2 1 0)
+ (compat--should nil 1 0 0 0 0)
+ (compat--should t 4 3 2 1 0)
+ (compat--should nil 4 3 2 1 1)
+ (compat--error wrong-type-argument 1 0 'a)
+ (compat--should nil 0 0 'a)
+ (compat--should nil 0.1 0.0 0.0 0.0)
+ (compat--should t 0.4 0.2 0.0 -0.1)
+ (compat--should t 0.4 0.2 0 -0.1)))
(ert-deftest compat-<= ()
"Check if `compat--<=' was advised correctly."
- (compat-test <=
- (compat--should* t 0 0)
- (compat--should* t 0 0 0)
- (compat--should* t 0 0 0 0)
- (compat--should* t 0 0 0 0 0)
- (compat--should* t 0.0 0.0)
- (compat--should* t +0.0 -0.0)
- (compat--should* t 0.0 0.0 0.0)
- (compat--should* t 0.0 0.0 0.0 0.0)
- (compat--should* nil 1 0)
- (compat--should* nil 1 0 0)
- (compat--should* t 0 1 2)
- (compat--should* nil 2 1 0)
- (compat--should* nil 1 0 0 0 0)
- (compat--should* nil 4 3 2 1 0)
- (compat--should* nil 4 3 2 1 1)
- (compat--should* t 0 1 2 3 4)
- (compat--should* t 1 1 2 3 4)
- (compat--error* wrong-type-argument 0 0 'a)
- (compat--error* wrong-type-argument 0 1 'a)
- (compat--should* nil 1 0 'a)
- (compat--should* nil 0.1 0.0 0.0 0.0)
- (compat--should* t 0.0 0.0 0.0 0.1)
- (compat--should* t -0.1 0.0 0.2 0.4)
- (compat--should* t -0.1 0.0 0.0 0.2 0.4)
- (compat--should* t -0.1 0.0 0 0.2 0.4)
- (compat--should* t -0.1 0 0.2 0.4)
- (compat--should* nil 0.4 0.2 0.0 -0.1)
- (compat--should* nil 0.4 0.2 0.0 0.0 -0.1)
- (compat--should* nil 0.4 0.2 0 0.0 0.0 -0.1)
- (compat--should* nil 0.4 0.2 0 -0.1)))
+ (compat-test compat-<=
+ (compat--should t 0 0)
+ (compat--should t 0 0 0)
+ (compat--should t 0 0 0 0)
+ (compat--should t 0 0 0 0 0)
+ (compat--should t 0.0 0.0)
+ (compat--should t +0.0 -0.0)
+ (compat--should t 0.0 0.0 0.0)
+ (compat--should t 0.0 0.0 0.0 0.0)
+ (compat--should nil 1 0)
+ (compat--should nil 1 0 0)
+ (compat--should t 0 1 2)
+ (compat--should nil 2 1 0)
+ (compat--should nil 1 0 0 0 0)
+ (compat--should nil 4 3 2 1 0)
+ (compat--should nil 4 3 2 1 1)
+ (compat--should t 0 1 2 3 4)
+ (compat--should t 1 1 2 3 4)
+ (compat--error wrong-type-argument 0 0 'a)
+ (compat--error wrong-type-argument 0 1 'a)
+ (compat--should nil 1 0 'a)
+ (compat--should nil 0.1 0.0 0.0 0.0)
+ (compat--should t 0.0 0.0 0.0 0.1)
+ (compat--should t -0.1 0.0 0.2 0.4)
+ (compat--should t -0.1 0.0 0.0 0.2 0.4)
+ (compat--should t -0.1 0.0 0 0.2 0.4)
+ (compat--should t -0.1 0 0.2 0.4)
+ (compat--should nil 0.4 0.2 0.0 -0.1)
+ (compat--should nil 0.4 0.2 0.0 0.0 -0.1)
+ (compat--should nil 0.4 0.2 0 0.0 0.0 -0.1)
+ (compat--should nil 0.4 0.2 0 -0.1)))
(ert-deftest compat->= ()
"Check if `compat-->=' was implemented correctly."
- (compat-test >=
- (compat--should* t 0 0)
- (compat--should* t 0 0 0)
- (compat--should* t 0 0 0 0)
- (compat--should* t 0 0 0 0 0)
- (compat--should* t 0.0 0.0)
- (compat--should* t +0.0 -0.0)
- (compat--should* t 0.0 0.0 0.0)
- (compat--should* t 0.0 0.0 0.0 0.0)
- (compat--should* t 1 0)
- (compat--should* t 1 0 0)
- (compat--should* nil 0 1 2)
- (compat--should* t 2 1 0)
- (compat--should* t 1 0 0 0 0)
- (compat--should* t 4 3 2 1 0)
- (compat--should* t 4 3 2 1 1)
- (compat--error* wrong-type-argument 0 0 'a)
- (compat--error* wrong-type-argument 1 0 'a)
- (compat--should* nil 0 1 'a)
- (compat--should* t 0.1 0.0 0.0 0.0)
- (compat--should* nil 0.0 0.0 0.0 0.1)
- (compat--should* nil -0.1 0.0 0.2 0.4)
- (compat--should* nil -0.1 0.0 0.0 0.2 0.4)
- (compat--should* nil -0.1 0.0 0 0.2 0.4)
- (compat--should* nil -0.1 0 0.2 0.4)
- (compat--should* t 0.4 0.2 0.0 -0.1)
- (compat--should* t 0.4 0.2 0.0 0.0 -0.1)
- (compat--should* t 0.4 0.2 0 0.0 0.0 -0.1)
- (compat--should* t 0.4 0.2 0 -0.1)))
+ (compat-test compat->=
+ (compat--should t 0 0)
+ (compat--should t 0 0 0)
+ (compat--should t 0 0 0 0)
+ (compat--should t 0 0 0 0 0)
+ (compat--should t 0.0 0.0)
+ (compat--should t +0.0 -0.0)
+ (compat--should t 0.0 0.0 0.0)
+ (compat--should t 0.0 0.0 0.0 0.0)
+ (compat--should t 1 0)
+ (compat--should t 1 0 0)
+ (compat--should nil 0 1 2)
+ (compat--should t 2 1 0)
+ (compat--should t 1 0 0 0 0)
+ (compat--should t 4 3 2 1 0)
+ (compat--should t 4 3 2 1 1)
+ (compat--error wrong-type-argument 0 0 'a)
+ (compat--error wrong-type-argument 1 0 'a)
+ (compat--should nil 0 1 'a)
+ (compat--should t 0.1 0.0 0.0 0.0)
+ (compat--should nil 0.0 0.0 0.0 0.1)
+ (compat--should nil -0.1 0.0 0.2 0.4)
+ (compat--should nil -0.1 0.0 0.0 0.2 0.4)
+ (compat--should nil -0.1 0.0 0 0.2 0.4)
+ (compat--should nil -0.1 0 0.2 0.4)
+ (compat--should t 0.4 0.2 0.0 -0.1)
+ (compat--should t 0.4 0.2 0.0 0.0 -0.1)
+ (compat--should t 0.4 0.2 0 0.0 0.0 -0.1)
+ (compat--should t 0.4 0.2 0 -0.1)))
(ert-deftest compat-special-form-p ()
"Check if `compat--special-form-p' was implemented correctly."
@@ -1070,10 +1070,10 @@ the compatibility function."
(ert-deftest compat-split-string ()
"Check if `compat--split-string' was advised correctly."
- (compat-test split-string
- (compat--should* '("a" "b" "c") "a b c")
- (compat--should* '("..a.." "..b.." "..c..") "..a.. ..b.. ..c..")
- (compat--should* '("a" "b" "c") "..a.. ..b.. ..c.." nil nil "\\.+")))
+ (compat-test compat-split-string
+ (compat--should '("a" "b" "c") "a b c")
+ (compat--should '("..a.." "..b.." "..c..") "..a.. ..b.. ..c..")
+ (compat--should '("a" "b" "c") "..a.. ..b.. ..c.." nil nil "\\.+")))
(ert-deftest compat-delete-consecutive-dups ()
"Check if `compat--delete-consecutive-dups' was implemented correctly."
@@ -1152,21 +1152,21 @@ the compatibility function."
(ert-deftest compat-file-size-human-readable ()
"Check if `compat--file-size-human-readable' was advised properly."
- (compat-test file-size-human-readable
- (compat--should* "1000" 1000)
- (compat--should* "1k" 1024)
- (compat--should* "1M" (* 1024 1024))
- (compat--should* "1G" (expt 1024 3))
- (compat--should* "1T" (expt 1024 4))
- (compat--should* "1k" 1000 'si)
- (compat--should* "1KiB" 1024 'iec)
- (compat--should* "1KiB" 1024 'iec)
- (compat--should* "1 KiB" 1024 'iec " ")
- (compat--should* "1KiA" 1024 'iec nil "A")
- (compat--should* "1 KiA" 1024 'iec " " "A")
- (compat--should* "1kA" 1000 'si nil "A")
- (compat--should* "1 k" 1000 'si " ")
- (compat--should* "1 kA" 1000 'si " " "A")))
+ (compat-test compat-file-size-human-readable
+ (compat--should "1000" 1000)
+ (compat--should "1k" 1024)
+ (compat--should "1M" (* 1024 1024))
+ (compat--should "1G" (expt 1024 3))
+ (compat--should "1T" (expt 1024 4))
+ (compat--should "1k" 1000 'si)
+ (compat--should "1KiB" 1024 'iec)
+ (compat--should "1KiB" 1024 'iec)
+ (compat--should "1 KiB" 1024 'iec " ")
+ (compat--should "1KiA" 1024 'iec nil "A")
+ (compat--should "1 KiA" 1024 'iec " " "A")
+ (compat--should "1kA" 1000 'si nil "A")
+ (compat--should "1 k" 1000 'si " ")
+ (compat--should "1 kA" 1000 'si " " "A")))
(ert-deftest compat-format-prompt ()
"Check if `compat--file-size-human-readable' was implemented properly."
@@ -1328,11 +1328,11 @@ the compatibility function."
(b-map (make-sparse-keymap)))
(define-key a-map "x" 'foo)
(define-key b-map "x" 'bar)
- (compat-test lookup-key
- (compat--should* 'foo a-map "x")
- (compat--should* 'bar b-map "x")
- (compat--should* 'foo (list a-map b-map) "x")
- (compat--should* 'bar (list b-map a-map) "x"))))
+ (compat-test compat-lookup-key
+ (compat--should 'foo a-map "x")
+ (compat--should 'bar b-map "x")
+ (compat--should 'foo (list a-map b-map) "x")
+ (compat--should 'bar (list b-map a-map) "x"))))
(ert-deftest compat-string-limit ()
"Check if `compat-string-limit' was implemented properly."
diff --git a/compat.el b/compat.el
index 52712f2502..c94a2f15e8 100644
--- a/compat.el
+++ b/compat.el
@@ -3,10 +3,10 @@
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
-;; Maintainer: Philip Kaludercic <philipk@posteo.net>
+;; Maintainer: Philip Kaludercic <~pkal/public-inbox@lists.sr.ht>
;; 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:
- [elpa] externals/compat updated (1573aa2e6d -> be4595fec8), ELPA Syncer, 2023/01/03
- [elpa] externals/compat dd334e5616 04/84: Add function-alias-p, ELPA Syncer, 2023/01/03
- [elpa] externals/compat 5a1f3bdc59 03/84: Merge branch 'master' into emacs-29.1,
ELPA Syncer <=
- [elpa] externals/compat ae2bf0aee5 08/84: Merge branch 'master' into emacs-29.1, ELPA Syncer, 2023/01/03
- [elpa] externals/compat 5031a586a3 09/84: Add take and ntake defined in Emacs 29, ELPA Syncer, 2023/01/03
- [elpa] externals/compat 71ddb93f75 10/84: Merge branch 'master' into emacs-29, ELPA Syncer, 2023/01/03
- [elpa] externals/compat 3104c89c2d 13/84: Test compat-string-trim instead of string-trim, ELPA Syncer, 2023/01/03
- [elpa] externals/compat 29dd29609a 15/84: Prepare compat.el for testing functions from compat-29, ELPA Syncer, 2023/01/03
- [elpa] externals/compat 9b8799091c 16/84: Add @subsection headers for Emacs 29.1 node, ELPA Syncer, 2023/01/03
- [elpa] externals/compat db53afa3a7 18/84: Add buffer-text-pixel-size from Emacs 29, ELPA Syncer, 2023/01/03
- [elpa] externals/compat a4036f9b1b 01/84: Prepare Emacs 29.1 compatibility, ELPA Syncer, 2023/01/03
- [elpa] externals/compat f21b114ec7 02/84: Add string-limit, ELPA Syncer, 2023/01/03
- [elpa] externals/compat 9083cfc4f6 05/84: Add get-display-property, ELPA Syncer, 2023/01/03