[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/compat 0faf5f469c 03/10: Merge branch 'master' into tes
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/compat 0faf5f469c 03/10: Merge branch 'master' into testing |
|
Date: |
Mon, 28 Feb 2022 03:57:33 -0500 (EST) |
branch: externals/compat
commit 0faf5f469c513a14e033c6e19a3de00f2ddf596d
Merge: ccc8b1fd36 47aeeb110f
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>
Merge branch 'master' into testing
---
Makefile | 2 +-
README.md | 27 ++--
compat-24.4.el | 41 +++---
compat-25.1.el | 30 ++--
compat-26.1.el | 27 ++--
compat-27.1.el | 42 +++---
compat-28.1.el | 45 +++---
compat-macs.el | 140 +++++++++---------
compat-tests.el | 435 ++++++++++++++++++++++++++++----------------------------
compat.el | 79 +---------
10 files changed, 409 insertions(+), 459 deletions(-)
diff --git a/Makefile b/Makefile
index b9a6e8b4b6..cc98a4b7fe 100644
--- a/Makefile
+++ b/Makefile
@@ -20,7 +20,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..71505625a0 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
------------
@@ -42,6 +49,10 @@ that all the functions and macros that compat.el provides are
automatically accessible or made accessible as soon as the right
libraries are loaded.
+It is recommended to subscribe to the [compat-announce] mailing list
+to be notified when new versions are released or relevant changes are
+made.
+
Contribute
----------
@@ -52,18 +63,16 @@ contributions.
Source code
-----------
-The project is managed can be found on [SourceHut] but has a [GitHub]
-mirror as well.
+Compat is developed on [SourceHut]. A restricted [GitHub] mirror is
+also provided.
Bug and patches
---------------
-Patches, bug reports and comments can be sent to the mailing list
-
- ~pkal/public-inbox@lists.sr.ht
-
-or via GitHub. These may include issues in the compatibility code,
-missing definitions or performance issues.
+Patches, bug reports and comments can be sent to the [development
+mailing list][compat-devel]. [GitHub] can also be used to submit
+patches ("Pull Request"). These may include issues in the
+compatibility code, missing definitions or performance issues.
When contributing, make sure to provide test and use the existing
tests defined in compat-test.el. These can be easily executed using
@@ -82,3 +91,5 @@ the GPL, Version 3 (like Emacs itself).
[copyright assignment]:
https://www.gnu.org/software/emacs/manual/html_node/emacs/Copyright-Assignment.html
[SourceHut]: https://sr.ht/~pkal/compat
[GitHub]: https://github.com/phikal/compat.el
+[compat-announce]: https://lists.sr.ht/~pkal/compat-announce
+[compat-devel]: https://lists.sr.ht/~pkal/compat-devel
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..2855fc6301 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)))))
@@ -159,7 +157,8 @@ In you specify the same value for `:null-object' and
`:false-object',
a potentially ambiguous situation, the JSON output will not contain
any JSON false values."
:cond (condition-case nil
- (json-parse-string "[]")
+ (let ((inhibit-message t))
+ (equal (json-parse-string "[]") nil))
(json-unavailable t)
(void-function t))
(require 'json)
@@ -173,7 +172,8 @@ This is the same as (insert (json-serialize OBJECT)), but
potentially
faster. See the function `json-serialize' for allowed values of
OBJECT."
:cond (condition-case nil
- (json-parse-string "[]")
+ (let ((inhibit-message t))
+ (equal (json-parse-string "[]") nil))
(json-unavailable t)
(void-function t))
(insert (apply #'compat--json-serialize object args)))
@@ -203,7 +203,8 @@ to represent a JSON null value. It defaults to `:null'.
The keyword argument `:false-object' specifies which object to use to
represent a JSON false value. It defaults to `:false'."
:cond (condition-case nil
- (json-parse-string "[]")
+ (let ((inhibit-message t))
+ (equal (json-parse-string "[]") nil))
(json-unavailable t)
(void-function t))
(require 'json)
@@ -246,7 +247,8 @@ to represent a JSON null value. It defaults to `:null'.
The keyword argument `:false-object' specifies which object to use to
represent a JSON false value. It defaults to `:false'."
:cond (condition-case nil
- (json-parse-string "[]")
+ (let ((inhibit-message t))
+ (equal (json-parse-string "[]") nil))
(json-unavailable t)
(void-function t))
(require 'json)
@@ -262,10 +264,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 +398,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 +409,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 +440,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 +454,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 789c5025e7..5f81e90c11 100644
--- a/compat-macs.el
+++ b/compat-macs.el
@@ -69,6 +69,9 @@ ignored:
- :alias :: Force create an alias starting with `compat--' or as
defined by :realname.
+- :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.")
(defun compat--generate-minimal (name def-fn install-fn check-fn attr type)
@@ -137,40 +140,46 @@ DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE."
(buffer-file-name))))
;; Guess the version from the file the macro is
;; being defined in.
- (and (string-match
+ (and file
+ (string-match
"compat-\\([[:digit:]]+\\.[[:digit:]]+\\)\\.\\(?:elc?\\)\\'"
file)
(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
+ (when (get ',name 'compat-def)
+ (error "Duplicate compatibility definition: %s" ',name))
+ (put ',name 'compat-def ',realname)
+ ,(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-generate-common (name def-fn install-fn check-fn attr type)
"Common code for generating compatibility definitions.
@@ -186,7 +195,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
@@ -195,6 +204,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)
@@ -213,17 +225,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
@@ -232,21 +244,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))
@@ -311,33 +309,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 00968e2501..43564d4807 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -124,6 +124,11 @@ the compatibility function."
+(unless (fboundp 'advice-add)
+ (require 'package)
+ (package-initialize)
+ (package-install 'nadvice))
+
(ert-deftest compat-string-search ()
"Check if `compat--string-search' was implemented correctly."
(compat-test string-search
@@ -411,20 +416,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."
@@ -533,16 +538,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
@@ -551,24 +556,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)
@@ -577,36 +582,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."
@@ -892,143 +897,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."
@@ -1073,10 +1078,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."
@@ -1155,21 +1160,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."
@@ -1331,11 +1336,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"))))
(provide 'compat-tests)
;;; compat-tests.el ends here
diff --git a/compat.el b/compat.el
index 78cf7487a9..f5147007a6 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/compat-devel@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))))
;; To accelerate the loading process, we insert the contents of
@@ -183,52 +161,5 @@ advice."
;; call is inserted directly into the autoload file:
;;;###autoload (require 'compat)
-;;;;; Update defaults
-
-;; This section updates default values that have been updated in
-;; "future" versions of Emacs, and are relevant to users on older
-;; versions of Emacs.
-;;
-;; To prevent these changes from taking effect, set
-;; `compat-preserve-defaults' to t in your early-init.el on Emacs 27 or
-;; before calling `package-initialize' before Emacs 27.
-
-(defvar compat-preserve-defaults nil)
-
-(unless compat-preserve-defaults
- ;; Add NonGNU ELPA to the list of package archives
- (defvar package-archives)
- (with-eval-after-load 'package
- (when (or (equal '(("gnu" . "https://elpa.gnu.org/packages/";))
- package-archives)
- (equal '(("gnu" . "http://elpa.gnu.org/packages/";))
- package-archives))
- (push (cons "nongnu"
- (format "http%s://elpa.nongnu.org/nongnu/"
- (if (and (fboundp 'gnutls-available-p)
- (gnutls-available-p))
- "s" "")))
- package-archives)))
-
- ;; Change the default IRC server from Freenode to Libera.
- (defvar rcirc-server-alist)
- (with-eval-after-load 'rcirc
- (when (equal '(("chat.freenode.net" :channels ("#rcirc")))
- rcirc-server-alist)
- (setq rcirc-server-alist
- (if (and (fboundp 'gnutls-available-p)
- (gnutls-available-p))
- ;; The #emacs channel is not added here (even though
- ;; it was added in 28.1), since that is a separate
- ;; feature that doesn't need to be added here.
- '(("irc.libera.chat" :channels ("#rcirc")
- :port 6697 :encryption tls))
- '(("irc.libera.chat" :channels ("#rcirc")))))))
-
- (defvar erc-default-server)
- (with-eval-after-load 'erc
- (when (equal erc-default-server "irc.freenode.net")
- (setq erc-default-server "irc.libera.chat"))))
-
(provide 'compat)
;;; compat.el ends here
- [elpa] externals/compat updated (ab08067970 -> 8792ab17be), ELPA Syncer, 2022/02/28
- [elpa] externals/compat 0faf5f469c 03/10: Merge branch 'master' into testing,
ELPA Syncer <=
- [elpa] externals/compat 5d4fdf41db 01/10: Merge byte compilation output into a single file, ELPA Syncer, 2022/02/28
- [elpa] externals/compat ccc8b1fd36 02/10: Compress and merge the compiled result of compat.elc, ELPA Syncer, 2022/02/28
- [elpa] externals/compat 50b26ffdf2 07/10: Install nadvice in compat-tests before loading compat, ELPA Syncer, 2022/02/28
- [elpa] externals/compat 28f57d52a0 06/10: Fix copyright for compat-font-lock.el, ELPA Syncer, 2022/02/28
- [elpa] externals/compat a793b0b6e9 05/10: Extract font-locking into compat-font-lock.el, ELPA Syncer, 2022/02/28
- [elpa] externals/compat 4d3d0bf680 08/10: Fix duplicate definition testing checking, ELPA Syncer, 2022/02/28
- [elpa] externals/compat 8792ab17be 10/10: Merge branch 'testing', ELPA Syncer, 2022/02/28
- [elpa] externals/compat c91756bad6 04/10: Have a prefixed minimal compatibility expand to nil, ELPA Syncer, 2022/02/28
- [elpa] externals/compat 164672060f 09/10: Only generate verbose expansions when testing, ELPA Syncer, 2022/02/28