[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/compat ae2bf0aee5 08/84: Merge branch 'master' into ema
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/compat ae2bf0aee5 08/84: Merge branch 'master' into emacs-29.1 |
|
Date: |
Tue, 3 Jan 2023 08:57:30 -0500 (EST) |
branch: externals/compat
commit ae2bf0aee526729e0df6600ba23ff9204ddf8931
Merge: 9083cfc4f6 2ee63f46b2
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>
Merge branch 'master' into emacs-29.1
---
.dir-locals.el | 3 +-
.elpaignore | 1 +
.github/workflows/makefile.yml | 5 +-
.gitignore | 3 +-
Makefile | 37 +-
NEWS.org | 88 ++
README.md | 46 +-
compat-24.4.el | 176 ---
compat-24.el | 524 ++++++++
compat-25.1.el => compat-25.el | 157 ++-
compat-26.1.el | 299 -----
compat-26.el | 631 ++++++++++
compat-27.1.el => compat-27.el | 299 ++++-
compat-28.1.el => compat-28.el | 341 ++++-
compat-29.1.el => compat-29.el | 9 +-
compat-font-lock.el | 48 +
compat-macs.el | 159 ++-
compat-tests.el | 2717 ++++++++++++++++++++++++----------------
compat.el | 164 +--
compat.texi | 1163 +++++++++++++++++
20 files changed, 4910 insertions(+), 1960 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index 1f7c4b7901..2ce32d64ca 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,4 +1,5 @@
;;; Directory Local Variables
;;; For more information see (info "(emacs) Directory Variables")
-((emacs-lisp-mode . ((indent-tabs-mode . nil))))
+((emacs-lisp-mode . ((show-trailing-whitespace . t)
+ (indent-tabs-mode . nil))))
diff --git a/.elpaignore b/.elpaignore
index 0767134b2a..2fe0af53a7 100644
--- a/.elpaignore
+++ b/.elpaignore
@@ -5,3 +5,4 @@ Makefile
.elpaignore
COPYING
README.md
+compat.texi
diff --git a/.github/workflows/makefile.yml b/.github/workflows/makefile.yml
index 21731ff754..bf7c0f7d5a 100644
--- a/.github/workflows/makefile.yml
+++ b/.github/workflows/makefile.yml
@@ -15,7 +15,7 @@ jobs:
strategy:
matrix:
emacs-version:
- - '24.3'
+ # - '24.3'
- '24.4'
- '24.5'
- '25.1'
@@ -26,6 +26,7 @@ jobs:
- '26.3'
- '27.1'
- '27.2'
+ - '28.1'
- 'snapshot'
steps:
- uses: actions/checkout@v2
@@ -33,4 +34,4 @@ jobs:
with:
version: ${{ matrix.emacs-version }}
- name: Compile and run tests
- run: make
+ run: make test
diff --git a/.gitignore b/.gitignore
index a3d210ab63..29f171e696 100644
--- a/.gitignore
+++ b/.gitignore
@@ -2,4 +2,5 @@
*~
\#*\#
/compat-pkg.el
-/compat-autoloads.el
\ No newline at end of file
+/compat-autoloads.el
+/compat.info
diff --git a/Makefile b/Makefile
index 7148b2f7d9..37700c0903 100644
--- a/Makefile
+++ b/Makefile
@@ -3,26 +3,39 @@
.SUFFIXES: .el .elc
EMACS = emacs
-BYTEC = compat-help.elc \
- compat-macs.elc \
- compat-24.4.elc \
- compat-25.1.elc \
- compat-26.1.elc \
- compat-27.1.elc \
- compat-28.1.elc \
- compat-29.1.elc \
+MAKEINFO = makeinfo
+BYTEC = compat-macs.elc \
+ compat-help.elc \
+ compat-font-lock.elc \
+ compat-24.elc \
+ compat-25.elc \
+ compat-26.elc \
+ compat-27.elc \
+ compat-28.elc \
+ compat-29.elc \
compat.elc
-all: compile test
+all: compile
compile: $(BYTEC)
-test:
+test: compile
+ $(EMACS) --version
$(EMACS) -Q --batch -L . -l compat-tests.el -f
ert-run-tests-batch-and-exit
clean:
- $(RM) $(BYTEC)
+ $(RM) $(BYTEC) compat.info
+
+compat-24.el: compat-macs.el
+compat-25.el: compat-macs.el
+compat-26.el: compat-macs.el
+compat-27.el: compat-macs.el
+compat-28.el: compat-macs.el
+compat-29.el: compat-macs.el
+compat-font-lock.el: compat-macs.el
.el.elc:
- $(EMACS) -Q --batch -L . -f batch-byte-compile $^
+ $(EMACS) -Q --batch -L . -f batch-byte-compile $<
+compat.info: compat.texi
+ $(MAKEINFO) $<
diff --git a/NEWS.org b/NEWS.org
new file mode 100644
index 0000000000..9c6a819b6a
--- /dev/null
+++ b/NEWS.org
@@ -0,0 +1,88 @@
+#+options: toc:nil num:nil
+#+link: compat https://todo.sr.ht/~pkal/compat/
+
+* Release of "Compat" Version 28.1.2.0
+
+The main change of this release has been the major simplification of
+Compat's initialisation system, improving the situation around issues
+people had been reporting ([[compat:4]], once again) with unconventional
+or unpopular packaging systems.
+
+In addition to this, the following functional changes have been made:
+
+- Fix =format-prompt= of an empty string as "default" argument
+- Add =decoded-time-period= defined in Emacs 28
+- Add =subr-primitive-p= defined in Emacs 28
+
+Minor improvements to manual are also part of this release.
+
+(Release <2022-07-18 Mon>)
+
+* Release of "Compat" Version 28.1.1.3
+
+This release just contains a hot-fix for an issue introduced in the
+last version, where compat.el raises an error during byte compilation.
+See [[compat:4]].
+
+(Release <2022-06-19 Sun>)
+
+* Release of "Compat" Version 28.1.1.2
+
+Two main changes have necessitated a new patch release:
+
+1. Fix issues related to the loading of compat when uncompiled. See
+
[[https://lists.sr.ht/~pkal/compat-devel/%3C20220530191000.2183047-1-jonas%40bernoul.li%3E][this
thread]] for more details on the problem.
+2. Fix issues related to the loading of compat on old pre-releases
+ (think of 28.0.50). See
[[https://lists.sr.ht/~pkal/compat-devel/%3Cf8635d7d-e233-448f-b325-9e850363241c%40www.fastmail.com%3E][this
thread]] for more details on the
+ problem.
+
+(Released <2022-06-22 Wed>)
+
+* Release of "Compat" Version 28.1.1.1
+
+This is a minor release fixing a bug in =json-serialize=, that could
+cause unintended side-effects, not related to packages using Compat
+directly (see [[compat:2]]).
+
+(Released <2022-05-05 Thu>)
+
+* Release of "Compat" Version 28.1.1.0
+
+This release mostly fixes a number of smaller bugs that were not
+identified as of 28.1.0.0. Nevertheless these warrent a version bump,
+as some of these changes a functional. These include:
+
+- The addition of the =file-attribute-*= accessor functions.
+- The addition of =file-attribute-collect=.
+- Improvements to the Texinfo manual (via Jonas Bernoulli's recent
+ work on =ox-texinfo=). For the time being, the Texinfo file is
+ maintained in the repository itself, next to the =MANUAL= file.
+ This might change in the future.
+- Adding a prefix to =string-trim=, =string-trim-left= and
+ =string-trim-right= (i.e. now =compat-string-trim=,
+ =compat-string-trim-left= and =compat-string-trim-right=)
+- Improving the version inference used in the =compat-*= macros.
+ This improves the compile-time optimisation that strips away
+ functions that are known to be defined for a specific version.
+- The addition of generalised variable (=setf=) support for
+ =compat-alist-get=.
+- The addition of =image-property= and generalised variable support
+ for =image-property=.
+- The addition of the function =compat-executable-find=.
+- The addition of the function =compat-dired-get-marked-files=.
+- The addition of the function =exec-path=.
+- The addition of the function =make-lock-file-name=.
+- The addition of the function =null-device=.
+- The addition of the function =time-equal-p=.
+- The addition of the function =date-days-in-month=.
+- Handling out-of-directory byte compilation better.
+- Fixing the usage and edge-cases of =and-let*=.
+
+Furthermore a bug tracker was added: https://todo.sr.ht/~pkal/compat,
+which is the preferred way to report issues or feature requests.
+General problems, questions, etc. are still better discussed on the
+development mailing list: https://lists.sr.ht/~pkal/compat-devel.
+
+(Released <2022-04-22 Fri>)
+
+
diff --git a/README.md b/README.md
index e7e1d3e957..9666e3999a 100644
--- a/README.md
+++ b/README.md
@@ -1,10 +1,6 @@
COMPATibility Library for Emacs
===============================
-> **Note to package developers:** compat.el hasn't yet been published,
-> and should not yet be added as a dependency. The official release
-> of the package will coincide with the release of Emacs 28.1.
-
Find here the source for compat.el, a forwards-compatibility library
for (GNU) Emacs Lisp, versions 24.3 and newer.
@@ -15,7 +11,7 @@ for users bound to specific Emacs releases.
Version 24.3 is chosen as the oldest version, because this is the
newest version on CentOS 7. It is intended to preserve compatibility
-for at least as the Centos 7 reaches [EOL], 2024.
+for at least as the CentOS 7 reaches [EOL], 2024.
If you are developing a package with compat.el in mind, consider
loading `compat-help` (on your system, not in a package) to get
@@ -42,12 +38,22 @@ Usage
The intended use-case for this library is for package developers to
add as a dependency in the header:
- ;; Package-Requires: ((emacs "24.3") (compat "28.1.0.0"))
+ ;; Package-Requires: ((emacs "24.3") (compat "28.1.2.0"))
+
+and later on a
+
+ (require 'compat)
+
+This will load all non-prefixed definitions (functions and macros with
+a leading `compat-`). To load these, an additional
-No further action should be required afterwards. The effect should be
-that all the functions and macros that compat.el provides are
-automatically accessible or made accessible as soon as the right
-libraries are loaded.
+ (require 'compat-XY) ; e.g. 26
+
+will be necessary, to load compatibility code for Emacs version XY.
+
+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
----------
@@ -59,18 +65,18 @@ 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 and comments can be sent to the [development mailing
+list][compat-devel]. Bug reports and issues should be directed to the
+[issue tracker][compat-tracker] (also accessible via
+[Email][compat-tracker-mailto]). [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
@@ -89,3 +95,7 @@ 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
+[compat-tracker]: https://todo.sr.ht/~pkal/compat
+[compat-tracker-mailto]: mailto:~pkal/compat@todo.sr.ht
diff --git a/compat-24.4.el b/compat-24.4.el
deleted file mode 100644
index 338513fbaa..0000000000
--- a/compat-24.4.el
+++ /dev/null
@@ -1,176 +0,0 @@
-;;; compat-24.4.el --- Compatibility Layer for Emacs 24.4 -*-
lexical-binding: t; -*-
-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
-
-;; Author: Philip Kaludercic <philipk@posteo.net>
-;; Keywords: lisp
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Find here the functionality added in Emacs 24.4, needed by older
-;; versions.
-;;
-;; Do NOT load this library manually. Instead require `compat'.
-
-;;; Code:
-
-(eval-when-compile (require 'compat-macs))
-
-;;;; Defined in data.c
-
-(compat-defun = (number-or-marker &rest numbers-or-markers)
- "Handle multiple arguments."
- :prefix t
- (catch 'fail
- (while numbers-or-markers
- (unless (= number-or-marker (car numbers-or-markers))
- (throw 'fail nil))
- (setq number-or-marker (pop numbers-or-markers)))
- t))
-
-(compat-defun < (number-or-marker &rest numbers-or-markers)
- "Handle multiple arguments."
- :prefix t
- (catch 'fail
- (while numbers-or-markers
- (unless (< number-or-marker (car numbers-or-markers))
- (throw 'fail nil))
- (setq number-or-marker (pop numbers-or-markers)))
- t))
-
-(compat-defun > (number-or-marker &rest numbers-or-markers)
- "Handle multiple arguments."
- :prefix t
- (catch 'fail
- (while numbers-or-markers
- (unless (> number-or-marker (car numbers-or-markers))
- (throw 'fail nil))
- (setq number-or-marker (pop numbers-or-markers)))
- t))
-
-(compat-defun <= (number-or-marker &rest numbers-or-markers)
- "Handle multiple arguments."
- :prefix t
- (catch 'fail
- (while numbers-or-markers
- (unless (<= number-or-marker (car numbers-or-markers))
- (throw 'fail nil))
- (setq number-or-marker (pop numbers-or-markers)))
- t))
-
-(compat-defun >= (number-or-marker &rest numbers-or-markers)
- "Handle multiple arguments."
- :prefix t
- (catch 'fail
- (while numbers-or-markers
- (unless (>= number-or-marker (pop numbers-or-markers))
- (throw 'fail nil)))
- t))
-
-;;;; Defined in subr.el
-
-(compat-defmacro with-eval-after-load (file &rest body)
- "Execute BODY after FILE is loaded.
-FILE is normally a feature name, but it can also be a file name,
-in case that file does not provide any feature. See `eval-after-load'
-for more details about the different forms of FILE and their semantics."
- (declare (indent 1) (debug (form def-body)))
- ;; See https://nullprogram.com/blog/2018/02/22/ on how
- ;; `eval-after-load' is used to preserve compatibility with 24.3.
- `(eval-after-load ,file `(funcall ',,`(lambda () ,@body))))
-
-(compat-defun special-form-p (object)
- "Non-nil if and only if OBJECT is a special form."
- (if (and (symbolp object) (fboundp object))
- (setq object (condition-case nil
- (indirect-function object)
- (void-function nil))))
- (and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
-
-(compat-defun macrop (object)
- "Non-nil if and only if OBJECT is a macro."
- (let ((def (condition-case nil
- (indirect-function object)
- (void-function nil))))
- (when (consp def)
- (or (eq 'macro (car def))
- (and (autoloadp def) (memq (nth 4 def) '(macro t)))))))
-
-(compat-defun string-suffix-p (suffix string &optional ignore-case)
- "Return non-nil if SUFFIX is a suffix of STRING.
-If IGNORE-CASE is non-nil, the comparison is done without paying
-attention to case differences."
- (let ((start-pos (- (length string) (length suffix))))
- (and (>= start-pos 0)
- (eq t (compare-strings suffix nil nil
- string start-pos nil ignore-case)))))
-
-(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)
- (when (string-match (concat "\\`" trim) token)
- (setq token (substring token (match-end 0))))
- (when (string-match (concat trim "\\'") token)
- (setq token (substring token 0 (match-beginning
0))))
- token)
- token)
- token)))
- (if omit-nulls (delete "" trimmed) trimmed)))
-
-(compat-defun delete-consecutive-dups (list &optional circular)
- "Destructively remove `equal' consecutive duplicates from LIST.
-First and last elements are considered consecutive if CIRCULAR is
-non-nil."
- (let ((tail list) last)
- (while (cdr tail)
- (if (equal (car tail) (cadr tail))
- (setcdr tail (cddr tail))
- (setq last tail
- tail (cdr tail))))
- (if (and circular
- last
- (equal (car tail) (car list)))
- (setcdr last nil)))
- list)
-
-(compat-defun define-error (name message &optional parent)
- "Define NAME as a new error signal.
-MESSAGE is a string that will be output to the echo area if such an error
-is signaled without being caught by a `condition-case'.
-PARENT is either a signal or a list of signals from which it inherits.
-Defaults to `error'."
- (unless parent (setq parent 'error))
- (let ((conditions
- (if (consp parent)
- (apply #'append
- (mapcar (lambda (parent)
- (cons parent
- (or (get parent 'error-conditions)
- (error "Unknown signal `%s'" parent))))
- parent))
- (cons parent (get parent 'error-conditions)))))
- (put name 'error-conditions
- (delete-dups (copy-sequence (cons name conditions))))
- (when message (put name 'error-message message))))
-
-(provide 'compat-24.4)
-;;; compat-24.4.el ends here
diff --git a/compat-24.el b/compat-24.el
new file mode 100644
index 0000000000..f208ae7bd8
--- /dev/null
+++ b/compat-24.el
@@ -0,0 +1,524 @@
+;;; compat-24.el --- Compatibility Layer for Emacs 24.4 -*- lexical-binding:
t; -*-
+
+;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
+
+;; Author: Philip Kaludercic <philipk@posteo.net>
+;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
+;; URL: https://git.sr.ht/~pkal/compat/
+;; Keywords: lisp
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Find here the functionality added in Emacs 24.4, needed by older
+;; versions.
+;;
+;; Only load this library if you need to use one of the following
+;; functions:
+;;
+;; - `compat-='
+;; - `compat-<'
+;; - `compat->'
+;; - `compat-<='
+;; - `compat->='
+;; - `split-string'.
+
+;;; Code:
+
+(eval-when-compile (require 'compat-macs))
+
+;;;; Defined in data.c
+
+(compat-defun = (number-or-marker &rest numbers-or-markers)
+ "Handle multiple arguments."
+ :version "24.4"
+ :prefix t
+ (catch 'fail
+ (while numbers-or-markers
+ (unless (= number-or-marker (car numbers-or-markers))
+ (throw 'fail nil))
+ (setq number-or-marker (pop numbers-or-markers)))
+ t))
+
+(compat-defun < (number-or-marker &rest numbers-or-markers)
+ "Handle multiple arguments."
+ :version "24.4"
+ :prefix t
+ (catch 'fail
+ (while numbers-or-markers
+ (unless (< number-or-marker (car numbers-or-markers))
+ (throw 'fail nil))
+ (setq number-or-marker (pop numbers-or-markers)))
+ t))
+
+(compat-defun > (number-or-marker &rest numbers-or-markers)
+ "Handle multiple arguments."
+ :version "24.4"
+ :prefix t
+ (catch 'fail
+ (while numbers-or-markers
+ (unless (> number-or-marker (car numbers-or-markers))
+ (throw 'fail nil))
+ (setq number-or-marker (pop numbers-or-markers)))
+ t))
+
+(compat-defun <= (number-or-marker &rest numbers-or-markers)
+ "Handle multiple arguments."
+ :version "24.4"
+ :prefix t
+ (catch 'fail
+ (while numbers-or-markers
+ (unless (<= number-or-marker (car numbers-or-markers))
+ (throw 'fail nil))
+ (setq number-or-marker (pop numbers-or-markers)))
+ t))
+
+(compat-defun >= (number-or-marker &rest numbers-or-markers)
+ "Handle multiple arguments."
+ :version "24.4"
+ :prefix t
+ (catch 'fail
+ (while numbers-or-markers
+ (unless (>= number-or-marker (pop numbers-or-markers))
+ (throw 'fail nil)))
+ t))
+
+(compat-defun bool-vector-exclusive-or (a b &optional c)
+ "Return A ^ B, bitwise exclusive or.
+If optional third argument C is given, store result into C.
+A, B, and C must be bool vectors of the same length.
+Return the destination vector if it changed or nil otherwise."
+ :version "24.4"
+ (unless (bool-vector-p a)
+ (signal 'wrong-type-argument (list 'bool-vector-p a)))
+ (unless (bool-vector-p b)
+ (signal 'wrong-type-argument (list 'bool-vector-p b)))
+ (unless (or (null c) (bool-vector-p c))
+ (signal 'wrong-type-argument (list 'bool-vector-p c)))
+ (when (/= (length a) (length b))
+ (signal 'wrong-length-argument (list (length a) (length b))))
+ (let ((dest (or c (make-bool-vector (length a) nil))) changed)
+ (when (/= (length a) (length dest))
+ (signal 'wrong-length-argument (list (length a) (length dest))))
+ (dotimes (i (length dest))
+ (let ((val (not (eq (aref a i) (aref b i)))))
+ (unless (eq val (aref dest i))
+ (setq changed t))
+ (aset dest i val)))
+ (if c (and changed c) dest)))
+
+(compat-defun bool-vector-union (a b &optional c)
+ "Return A | B, bitwise or.
+If optional third argument C is given, store result into C.
+A, B, and C must be bool vectors of the same length.
+Return the destination vector if it changed or nil otherwise."
+ :version "24.4"
+ (unless (bool-vector-p a)
+ (signal 'wrong-type-argument (list 'bool-vector-p a)))
+ (unless (bool-vector-p b)
+ (signal 'wrong-type-argument (list 'bool-vector-p b)))
+ (unless (or (null c) (bool-vector-p c))
+ (signal 'wrong-type-argument (list 'bool-vector-p c)))
+ (when (/= (length a) (length b))
+ (signal 'wrong-length-argument (list (length a) (length b))))
+ (let ((dest (or c (make-bool-vector (length a) nil))) changed)
+ (when (/= (length a) (length dest))
+ (signal 'wrong-length-argument (list (length a) (length dest))))
+ (dotimes (i (length dest))
+ (let ((val (or (aref a i) (aref b i))))
+ (unless (eq val (aref dest i))
+ (setq changed t))
+ (aset dest i val)))
+ (if c (and changed c) dest)))
+
+(compat-defun bool-vector-intersection (a b &optional c)
+ "Return A & B, bitwise and.
+If optional third argument C is given, store result into C.
+A, B, and C must be bool vectors of the same length.
+Return the destination vector if it changed or nil otherwise."
+ :version "24.4"
+ (unless (bool-vector-p a)
+ (signal 'wrong-type-argument (list 'bool-vector-p a)))
+ (unless (bool-vector-p b)
+ (signal 'wrong-type-argument (list 'bool-vector-p b)))
+ (unless (or (null c) (bool-vector-p c))
+ (signal 'wrong-type-argument (list 'bool-vector-p c)))
+ (when (/= (length a) (length b))
+ (signal 'wrong-length-argument (list (length a) (length b))))
+ (let ((dest (or c (make-bool-vector (length a) nil))) changed)
+ (when (/= (length a) (length dest))
+ (signal 'wrong-length-argument (list (length a) (length dest))))
+ (dotimes (i (length dest))
+ (let ((val (and (aref a i) (aref b i))))
+ (unless (eq val (aref dest i))
+ (setq changed t))
+ (aset dest i val)))
+ (if c (and changed c) dest)))
+
+(compat-defun bool-vector-set-difference (a b &optional c)
+ "Return A &~ B, set difference.
+If optional third argument C is given, store result into C.
+A, B, and C must be bool vectors of the same length.
+Return the destination vector if it changed or nil otherwise."
+ :version "24.4"
+ (unless (bool-vector-p a)
+ (signal 'wrong-type-argument (list 'bool-vector-p a)))
+ (unless (bool-vector-p b)
+ (signal 'wrong-type-argument (list 'bool-vector-p b)))
+ (unless (or (null c) (bool-vector-p c))
+ (signal 'wrong-type-argument (list 'bool-vector-p c)))
+ (when (/= (length a) (length b))
+ (signal 'wrong-length-argument (list (length a) (length b))))
+ (let ((dest (or c (make-bool-vector (length a) nil))) changed)
+ (when (/= (length a) (length dest))
+ (signal 'wrong-length-argument (list (length a) (length dest))))
+ (dotimes (i (length dest))
+ (let ((val (and (aref a i) (not (aref b i)))))
+ (unless (eq val (aref dest i))
+ (setq changed t))
+ (aset dest i val)))
+ (if c (and changed c) dest)))
+
+(compat-defun bool-vector-not (a &optional b)
+ "Compute ~A, set complement.
+If optional second argument B is given, store result into B.
+A and B must be bool vectors of the same length.
+Return the destination vector."
+ :version "24.4"
+ (unless (bool-vector-p a)
+ (signal 'wrong-type-argument (list 'bool-vector-p a)))
+ (unless (or (null b) (bool-vector-p b))
+ (signal 'wrong-type-argument (list 'bool-vector-p b)))
+ (let ((dest (or b (make-bool-vector (length a) nil))))
+ (when (/= (length a) (length dest))
+ (signal 'wrong-length-argument (list (length a) (length dest))))
+ (dotimes (i (length dest))
+ (aset dest i (not (aref a i))))
+ dest))
+
+(compat-defun bool-vector-subsetp (a b)
+ "Return t if every t value in A is also t in B, nil otherwise.
+A and B must be bool vectors of the same length."
+ :version "24.4"
+ (unless (bool-vector-p a)
+ (signal 'wrong-type-argument (list 'bool-vector-p a)))
+ (unless (bool-vector-p b)
+ (signal 'wrong-type-argument (list 'bool-vector-p b)))
+ (when (/= (length a) (length b))
+ (signal 'wrong-length-argument (list (length a) (length b))))
+ (catch 'not-subset
+ (dotimes (i (length a))
+ (when (if (aref a i) (not (aref b i)) nil)
+ (throw 'not-subset nil)))
+ t))
+
+(compat-defun bool-vector-count-consecutive (a b i)
+ "Count how many consecutive elements in A equal B starting at I.
+A is a bool vector, B is t or nil, and I is an index into A."
+ :version "24.4"
+ (unless (bool-vector-p a)
+ (signal 'wrong-type-argument (list 'bool-vector-p a)))
+ (setq b (and b t)) ;normalise to nil or t
+ (unless (< i (length a))
+ (signal 'args-out-of-range (list a i)))
+ (let ((len (length a)) (n i))
+ (while (and (< i len) (eq (aref a i) b))
+ (setq i (1+ i)))
+ (- i n)))
+
+(compat-defun bool-vector-count-population (a)
+ "Count how many elements in A are t.
+A is a bool vector. To count A's nil elements, subtract the
+return value from A's length."
+ :version "24.4"
+ (unless (bool-vector-p a)
+ (signal 'wrong-type-argument (list 'bool-vector-p a)))
+ (let ((n 0))
+ (dotimes (i (length a))
+ (when (aref a i)
+ (setq n (1+ n))))
+ n))
+
+;;;; Defined in subr.el
+
+;;* UNTESTED
+(compat-defmacro with-eval-after-load (file &rest body)
+ "Execute BODY after FILE is loaded.
+FILE is normally a feature name, but it can also be a file name,
+in case that file does not provide any feature. See `eval-after-load'
+for more details about the different forms of FILE and their semantics."
+ :version "24.4"
+ (declare (indent 1) (debug (form def-body)))
+ ;; See https://nullprogram.com/blog/2018/02/22/ on how
+ ;; `eval-after-load' is used to preserve compatibility with 24.3.
+ `(eval-after-load ,file `(funcall ',,`(lambda () ,@body))))
+
+(compat-defun special-form-p (object)
+ "Non-nil if and only if OBJECT is a special form."
+ :version "24.4"
+ (if (and (symbolp object) (fboundp object))
+ (setq object (condition-case nil
+ (indirect-function object)
+ (void-function nil))))
+ (and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
+
+(compat-defun macrop (object)
+ "Non-nil if and only if OBJECT is a macro."
+ :version "24.4"
+ (let ((def (condition-case nil
+ (indirect-function object)
+ (void-function nil))))
+ (when (consp def)
+ (or (eq 'macro (car def))
+ (and (autoloadp def) (memq (nth 4 def) '(macro t)))))))
+
+(compat-defun string-suffix-p (suffix string &optional ignore-case)
+ "Return non-nil if SUFFIX is a suffix of STRING.
+If IGNORE-CASE is non-nil, the comparison is done without paying
+attention to case differences."
+ :version "24.4"
+ (let ((start-pos (- (length string) (length suffix))))
+ (and (>= start-pos 0)
+ (eq t (compare-strings suffix nil nil
+ string start-pos nil ignore-case)))))
+
+(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'."
+ :version "24.4"
+ :prefix t
+ (let* ((token (split-string string separators omit-nulls))
+ (trimmed (if trim
+ (mapcar
+ (lambda (token)
+ (when (string-match (concat "\\`" trim) token)
+ (setq token (substring token (match-end 0))))
+ (when (string-match (concat trim "\\'") token)
+ (setq token (substring token 0 (match-beginning
0))))
+ token)
+ token)
+ token)))
+ (if omit-nulls (delete "" trimmed) trimmed)))
+
+(compat-defun delete-consecutive-dups (list &optional circular)
+ "Destructively remove `equal' consecutive duplicates from LIST.
+First and last elements are considered consecutive if CIRCULAR is
+non-nil."
+ :version "24.4"
+ (let ((tail list) last)
+ (while (cdr tail)
+ (if (equal (car tail) (cadr tail))
+ (setcdr tail (cddr tail))
+ (setq last tail
+ tail (cdr tail))))
+ (if (and circular
+ last
+ (equal (car tail) (car list)))
+ (setcdr last nil)))
+ list)
+
+;;* UNTESTED
+(compat-defun define-error (name message &optional parent)
+ "Define NAME as a new error signal.
+MESSAGE is a string that will be output to the echo area if such an error
+is signaled without being caught by a `condition-case'.
+PARENT is either a signal or a list of signals from which it inherits.
+Defaults to `error'."
+ :version "24.4"
+ (unless parent (setq parent 'error))
+ (let ((conditions
+ (if (consp parent)
+ (apply #'append
+ (mapcar (lambda (parent)
+ (cons parent
+ (or (get parent 'error-conditions)
+ (error "Unknown signal `%s'" parent))))
+ parent))
+ (cons parent (get parent 'error-conditions)))))
+ (put name 'error-conditions
+ (delete-dups (copy-sequence (cons name conditions))))
+ (when message (put name 'error-message message))))
+
+;;;; Defined in minibuffer.el
+
+;;* UNTESTED
+(compat-defun completion-table-with-cache (fun &optional ignore-case)
+ "Create dynamic completion table from function FUN, with cache.
+This is a wrapper for `completion-table-dynamic' that saves the last
+argument-result pair from FUN, so that several lookups with the
+same argument (or with an argument that starts with the first one)
+only need to call FUN once. This can be useful when FUN performs a
+relatively slow operation, such as calling an external process.
+
+When IGNORE-CASE is non-nil, FUN is expected to be case-insensitive."
+ :version "24.4"
+ (let* (last-arg last-result
+ (new-fun
+ (lambda (arg)
+ (if (and last-arg (string-prefix-p last-arg arg ignore-case))
+ last-result
+ (prog1
+ (setq last-result (funcall fun arg))
+ (setq last-arg arg))))))
+ (completion-table-dynamic new-fun)))
+
+;;* UNTESTED
+(compat-defun completion-table-merge (&rest tables)
+ "Create a completion table that collects completions from all TABLES."
+ :version "24.4"
+ (lambda (string pred action)
+ (cond
+ ((null action)
+ (let ((retvals (mapcar (lambda (table)
+ (try-completion string table pred))
+ tables)))
+ (if (member string retvals)
+ string
+ (try-completion string
+ (mapcar (lambda (value)
+ (if (eq value t) string value))
+ (delq nil retvals))
+ pred))))
+ ((eq action t)
+ (apply #'append (mapcar (lambda (table)
+ (all-completions string table pred))
+ tables)))
+ (t
+ (completion--some (lambda (table)
+ (complete-with-action action table string pred))
+ tables)))))
+
+;;;; Defined in subr-x.el
+
+;;* UNTESTED
+(compat-advise require (feature &rest args)
+ "Allow for Emacs 24.x to require the inexistent FEATURE subr-x."
+ :version "24.4"
+ ;; As the compatibility advise around `require` is more a hack than
+ ;; of of actual value, the highlighting is suppressed.
+ :no-highlight t
+ (if (eq feature 'subr-x)
+ (let ((entry (assq feature after-load-alist)))
+ (let ((load-file-name nil))
+ (dolist (form (cdr entry))
+ (funcall (eval form t)))))
+ (apply oldfun feature args)))
+
+(compat-defun hash-table-keys (hash-table)
+ "Return a list of keys in HASH-TABLE."
+ :version "24.4"
+ (let (values)
+ (maphash
+ (lambda (k _v) (push k values))
+ hash-table)
+ values))
+
+(compat-defun hash-table-values (hash-table)
+ "Return a list of values in HASH-TABLE."
+ :version "24.4"
+ (let (values)
+ (maphash
+ (lambda (_k v) (push v values))
+ hash-table)
+ values))
+
+(compat-defun string-empty-p (string)
+ "Check whether STRING is empty."
+ :version "24.4"
+ (string= string ""))
+
+(compat-defun string-join (strings &optional separator)
+ "Join all STRINGS using SEPARATOR.
+Optional argument SEPARATOR must be a string, a vector, or a list of
+characters; nil stands for the empty string."
+ :version "24.4"
+ (mapconcat #'identity strings separator))
+
+(compat-defun string-blank-p (string)
+ "Check whether STRING is either empty or only whitespace.
+The following characters count as whitespace here: space, tab, newline and
+carriage return."
+ :version "24.4"
+ (string-match-p "\\`[ \t\n\r]*\\'" string))
+
+(compat-defun string-remove-prefix (prefix string)
+ "Remove PREFIX from STRING if present."
+ :version "24.4"
+ (if (string-prefix-p prefix string)
+ (substring string (length prefix))
+ string))
+
+(compat-defun string-remove-suffix (suffix string)
+ "Remove SUFFIX from STRING if present."
+ :version "24.4"
+ (if (string-suffix-p suffix string)
+ (substring string 0 (- (length string) (length suffix)))
+ string))
+
+;;;; Defined in faces.el
+
+;;* UNTESTED
+(compat-defun face-spec-set (face spec &optional spec-type)
+ "Set the FACE's spec SPEC, define FACE, and recalculate its attributes.
+See `defface' for the format of SPEC.
+
+The appearance of each face is controlled by its specs (set via
+this function), and by the internal frame-specific face
+attributes (set via `set-face-attribute').
+
+This function also defines FACE as a valid face name if it is not
+already one, and (re)calculates its attributes on existing
+frames.
+
+The optional argument SPEC-TYPE determines which spec to set:
+ nil, omitted or `face-override-spec' means the override spec,
+ which overrides all the other types of spec mentioned below
+ (this is usually what you want if calling this function
+ outside of Custom code);
+ `customized-face' or `saved-face' means the customized spec or
+ the saved custom spec;
+ `face-defface-spec' means the default spec
+ (usually set only via `defface');
+ `reset' means to ignore SPEC, but clear the `customized-face'
+ and `face-override-spec' specs;
+Any other value means not to set any spec, but to run the
+function for defining FACE and recalculating its attributes."
+ :version "24.4"
+ (if (get face 'face-alias)
+ (setq face (get face 'face-alias)))
+ ;; Save SPEC to the relevant symbol property.
+ (unless spec-type
+ (setq spec-type 'face-override-spec))
+ (if (memq spec-type '(face-defface-spec face-override-spec
+ customized-face saved-face))
+ (put face spec-type spec))
+ (if (memq spec-type '(reset saved-face))
+ (put face 'customized-face nil))
+ ;; Setting the face spec via Custom empties out any override spec,
+ ;; similar to how setting a variable via Custom changes its values.
+ (if (memq spec-type '(customized-face saved-face reset))
+ (put face 'face-override-spec nil))
+ ;; If we reset the face based on its custom spec, it is unmodified
+ ;; as far as Custom is concerned.
+ (unless (eq face 'face-override-spec)
+ (put face 'face-modified nil))
+ ;; Initialize the face if it does not exist, then recalculate.
+ (make-empty-face face)
+ (dolist (frame (frame-list))
+ (face-spec-recalc face frame)))
+
+(compat--inhibit-prefixed (provide 'compat-24))
+;;; compat-24.el ends here
diff --git a/compat-25.1.el b/compat-25.el
similarity index 62%
rename from compat-25.1.el
rename to compat-25.el
index 9d2859dc40..eb9d0a8b8f 100644
--- a/compat-25.1.el
+++ b/compat-25.el
@@ -1,8 +1,10 @@
-;;; compat-25.1.el --- Compatibility Layer for Emacs 25.1 -*-
lexical-binding: t; -*-
+;;; compat-25.el --- Compatibility Layer for Emacs 25.1 -*- lexical-binding:
t; -*-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
+;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
+;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
+;; URL: https://git.sr.ht/~pkal/compat/
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
@@ -23,12 +25,30 @@
;; Find here the functionality added in Emacs 25.1, needed by older
;; versions.
;;
-;; Do NOT load this library manually. Instead require `compat'.
+;; Only load this library if you need to use one of the following
+;; functions:
+;;
+;; - `compat-sort'
;;; Code:
(eval-when-compile (require 'compat-macs))
+;;;; Defined in alloc.c
+
+(compat-defun bool-vector (&rest objects)
+ "Return a new bool-vector with specified arguments as elements.
+Allows any number of arguments, including zero.
+usage: (bool-vector &rest OBJECTS)"
+ (let ((vec (make-bool-vector (length objects) nil))
+ (i 0))
+ (while objects
+ (when (car objects)
+ (aset vec i t))
+ (setq objects (cdr objects)
+ i (1+ i)))
+ vec))
+
;;;; Defined in fns.c
(compat-defun sort (seq predicate)
@@ -62,6 +82,7 @@ This implementation is equivalent to `format'."
(compat-defun directory-name-p (name)
"Return non-nil if NAME ends with a directory separator character."
+ :realname compat--directory-name-p
(eq (eval-when-compile
(if (memq system-type '(cygwin windows-nt ms-dos))
?\\ ?/))
@@ -75,6 +96,7 @@ Case is significant.
Symbols are also allowed; their print names are used instead."
(string-lessp string2 string1))
+;;* UNTESTED
(compat-defmacro with-file-modes (modes &rest body)
"Execute BODY with default file permissions temporarily set to MODES.
MODES is as for `set-default-file-modes'."
@@ -108,53 +130,6 @@ Equality with KEY is tested by TESTFN, defaulting to `eq'."
;;;; Defined in subr-x.el
-(compat-advise require (feature &rest args)
- "Allow for Emacs 24.x to require the inexistent FEATURE subr-x."
- ;; As the compatibility advise around `require` is more a hack than
- ;; of of actual value, the highlighting is suppressed.
- :no-highlight t
- (if (eq feature 'subr-x)
- (let ((entry (assq feature after-load-alist)))
- (let ((load-file-name nil))
- (dolist (form (cdr entry))
- (funcall (eval form t)))))
- (apply oldfun feature args)))
-
-(compat-defmacro if-let* (varlist then &rest else)
- "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
- (declare (indent 2)
- (debug ((&rest [&or symbolp (symbolp form) (form)])
- body)))
- (let ((empty (make-symbol "s"))
- (last t) list)
- (dolist (var varlist)
- (push `(,(if (cdr var) (car var) empty)
- (and ,last ,(or (cadr var) (car var))))
- list)
- (when (or (cdr var) (consp (car var)))
- (setq last (caar list))))
- `(let* ,(nreverse list)
- (if ,(caar list) ,then ,@else))))
-
-(compat-defmacro when-let* (varlist &rest body)
- "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
- (declare (indent 1) (debug if-let*))
- `(compat--if-let* ,varlist ,(macroexp-progn body)))
-
-(compat-defmacro and-let* (varlist &rest body)
- "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
- (declare (indent 1) (debug if-let*))
- `(compat--when-let* ,varlist ,@(or body '(t))))
-
(compat-defmacro if-let (spec then &rest else)
"Bind variables according to SPEC and evaluate THEN or ELSE.
Evaluate each binding in turn, as in `let*', stopping if a
@@ -171,6 +146,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."
+ :realname compat--if-let
:feature 'subr-x
(declare (indent 2)
(debug ([&or (symbolp form)
@@ -180,7 +156,7 @@ with an old syntax that accepted only one binding."
(not (listp (car spec))))
;; Adjust the single binding case
(setq spec (list spec)))
- `(compat--if-let* ,spec ,then ,@(macroexp-unprogn else)))
+ `(compat--if-let* ,spec ,then ,(macroexp-progn else)))
(compat-defmacro when-let (spec &rest body)
"Bind variables according to SPEC and conditionally evaluate BODY.
@@ -190,7 +166,7 @@ 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
(declare (indent 1) (debug if-let))
- `(compat-if-let ,spec ,(macroexp-progn body)))
+ `(compat--if-let ,spec ,(macroexp-progn body)))
(compat-defmacro thread-first (&rest forms)
"Thread FORMS elements as the first argument of their successor.
@@ -267,5 +243,78 @@ threading."
form))))))))
(t form)))
-(provide 'compat-25.1)
-;;; compat-25.1.el ends here
+;;;; Defined in byte-run.el
+
+;;* UNTESTED
+(compat-defun function-put (func prop value)
+ "Set FUNCTION's property PROP to VALUE.
+The namespace for PROP is shared with symbols.
+So far, FUNCTION can only be a symbol, not a lambda expression."
+ :version "24.4"
+ (put func prop value))
+
+;;;; Defined in files.el
+
+;;* UNTESTED
+(compat-defun directory-files-recursively
+ (dir regexp &optional include-directories predicate follow-symlinks)
+ "Return list of all files under directory DIR whose names match REGEXP.
+This function works recursively. Files are returned in \"depth
+first\" order, and files from each directory are sorted in
+alphabetical order. Each file name appears in the returned list
+in its absolute form.
+
+By default, the returned list excludes directories, but if
+optional argument INCLUDE-DIRECTORIES is non-nil, they are
+included.
+
+PREDICATE can be either nil (which means that all subdirectories
+of DIR are descended into), t (which means that subdirectories that
+can't be read are ignored), or a function (which is called with
+the name of each subdirectory, and should return non-nil if the
+subdirectory is to be descended into).
+
+If FOLLOW-SYMLINKS is non-nil, symbolic links that point to
+directories are followed. Note that this can lead to infinite
+recursion."
+ :realname compat--directory-files-recursively
+ (let* ((result nil)
+ (files nil)
+ (dir (directory-file-name dir))
+ ;; When DIR is "/", remote file names like "/method:" could
+ ;; also be offered. We shall suppress them.
+ (tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
+ (dolist (file (sort (file-name-all-completions "" dir)
+ 'string<))
+ (unless (member file '("./" "../"))
+ (if (directory-name-p file)
+ (let* ((leaf (substring file 0 (1- (length file))))
+ (full-file (concat dir "/" leaf)))
+ ;; Don't follow symlinks to other directories.
+ (when (and (or (not (file-symlink-p full-file))
+ (and (file-symlink-p full-file)
+ follow-symlinks))
+ ;; Allow filtering subdirectories.
+ (or (eq predicate nil)
+ (eq predicate t)
+ (funcall predicate full-file)))
+ (let ((sub-files
+ (if (eq predicate t)
+ (condition-case nil
+ (compat--directory-files-recursively
+ full-file regexp include-directories
+ predicate follow-symlinks)
+ (file-error nil))
+ (compat--directory-files-recursively
+ full-file regexp include-directories
+ predicate follow-symlinks))))
+ (setq result (nconc result sub-files))))
+ (when (and include-directories
+ (string-match regexp leaf))
+ (setq result (nconc result (list full-file)))))
+ (when (string-match regexp file)
+ (push (concat dir "/" file) files)))))
+ (nconc result (nreverse files))))
+
+(compat--inhibit-prefixed (provide 'compat-25))
+;;; compat-25.el ends here
diff --git a/compat-26.1.el b/compat-26.1.el
deleted file mode 100644
index d6b0d33d14..0000000000
--- a/compat-26.1.el
+++ /dev/null
@@ -1,299 +0,0 @@
-;;; compat-26.1.el --- Compatibility Layer for Emacs 26.1 -*-
lexical-binding: t; -*-
-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
-
-;; Author: Philip Kaludercic <philipk@posteo.net>
-;; Keywords: lisp
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Find here the functionality added in Emacs 26.1, needed by older
-;; versions.
-;;
-;; Do NOT load this library manually. Instead require `compat'.
-
-;;; Code:
-
-(eval-when-compile (require 'compat-macs))
-(declare-function compat-func-arity "compat" (func))
-
-;;;; Defined in eval.c
-
-(compat-defun func-arity (func)
- "Return minimum and maximum number of args allowed for FUNC.
-FUNC must be a function of some kind.
-The returned value is a cons cell (MIN . MAX). MIN is the minimum number
-of args. MAX is the maximum number, or the symbol ‘many’, for a
-function with ‘&rest’ args, or ‘unevalled’ for a special form."
- (compat-func-arity func))
-
-;;;; Defined in fns.c
-
-(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))))
- (assoc key alist)))
-
-(compat-defun mapcan (func sequence)
- "Apply FUNC to each element of SEQUENCE.
-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-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."
- :prefix t
- (if absolute
- (save-restriction
- (widen)
- (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-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
- :prefix t
- (if testfn
- (compat--alist-get-full-elisp key alist default remove testfn)
- (alist-get key alist default remove)))
-
-(compat-defun string-trim-left (string &optional regexp)
- "Trim STRING of leading string matching REGEXP.
-
-REGEXP defaults to \"[ \\t\\n\\r]+\"."
- (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string)
- (substring string (match-end 0))
- string))
-
-(compat-defun string-trim-right (string &optional regexp)
- "Trim STRING of trailing string matching REGEXP.
-
-REGEXP defaults to \"[ \\t\\n\\r]+\"."
- (let ((i (string-match-p
- (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'")
- string)))
- (if i (substring string 0 i) string)))
-
-(compat-defun string-trim (string &optional trim-left trim-right)
- "Trim STRING of leading with and trailing matching TRIM-LEFT and TRIM-RIGHT.
-
-TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
- ;; `string-trim-left' and `string-trim-right' were moved from subr-x
- ;; to subr in Emacs 27, so to avoid loading subr-x we use the
- ;; compatibility function here:
- (compat--string-trim-left
- (compat--string-trim-right
- string
- trim-right)
- trim-left))
-
-(compat-defun caaar (x)
- "Return the `car' of the `car' of the `car' of X."
- (declare (pure t))
- (car (car (car x))))
-
-(compat-defun caadr (x)
- "Return the `car' of the `car' of the `cdr' of X."
- (declare (pure t))
- (car (car (cdr x))))
-
-(compat-defun cadar (x)
- "Return the `car' of the `cdr' of the `car' of X."
- (declare (pure t))
- (car (cdr (car x))))
-
-(compat-defun caddr (x)
- "Return the `car' of the `cdr' of the `cdr' of X."
- (declare (pure t))
- (car (cdr (cdr x))))
-
-(compat-defun cdaar (x)
- "Return the `cdr' of the `car' of the `car' of X."
- (declare (pure t))
- (cdr (car (car x))))
-
-(compat-defun cdadr (x)
- "Return the `cdr' of the `car' of the `cdr' of X."
- (declare (pure t))
- (cdr (car (cdr x))))
-
-(compat-defun cddar (x)
- "Return the `cdr' of the `cdr' of the `car' of X."
- (declare (pure t))
- (cdr (cdr (car x))))
-
-(compat-defun cdddr (x)
- "Return the `cdr' of the `cdr' of the `cdr' of X."
- (declare (pure t))
- (cdr (cdr (cdr x))))
-
-(compat-defun caaaar (x)
- "Return the `car' of the `car' of the `car' of the `car' of X."
- (declare (pure t))
- (car (car (car (car x)))))
-
-(compat-defun caaadr (x)
- "Return the `car' of the `car' of the `car' of the `cdr' of X."
- (declare (pure t))
- (car (car (car (cdr x)))))
-
-(compat-defun caadar (x)
- "Return the `car' of the `car' of the `cdr' of the `car' of X."
- (declare (pure t))
- (car (car (cdr (car x)))))
-
-(compat-defun caaddr (x)
- "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
- (declare (pure t))
- (car (car (cdr (cdr x)))))
-
-(compat-defun cadaar (x)
- "Return the `car' of the `cdr' of the `car' of the `car' of X."
- (declare (pure t))
- (car (cdr (car (car x)))))
-
-(compat-defun cadadr (x)
- "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
- (declare (pure t))
- (car (cdr (car (cdr x)))))
-
-(compat-defun caddar (x)
- "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
- (declare (pure t))
- (car (cdr (cdr (car x)))))
-
-(compat-defun cadddr (x)
- "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
- (declare (pure t))
- (car (cdr (cdr (cdr x)))))
-
-(compat-defun cdaaar (x)
- "Return the `cdr' of the `car' of the `car' of the `car' of X."
- (declare (pure t))
- (cdr (car (car (car x)))))
-
-(compat-defun cdaadr (x)
- "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
- (declare (pure t))
- (cdr (car (car (cdr x)))))
-
-(compat-defun cdadar (x)
- "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
- (declare (pure t))
- (cdr (car (cdr (car x)))))
-
-(compat-defun cdaddr (x)
- "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
- (declare (pure t))
- (cdr (car (cdr (cdr x)))))
-
-(compat-defun cddaar (x)
- "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
- (declare (pure t))
- (cdr (cdr (car (car x)))))
-
-(compat-defun cddadr (x)
- "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
- (declare (pure t))
- (cdr (cdr (car (cdr x)))))
-
-(compat-defun cdddar (x)
- "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
- (declare (pure t))
- (cdr (cdr (cdr (car x)))))
-
-(compat-defun cddddr (x)
- "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
- (declare (pure t))
- (cdr (cdr (cdr (cdr x)))))
-
-(compat-defvar gensym-counter 0
- "Number used to construct the name of the next symbol created by `gensym'.")
-
-(compat-defun gensym (&optional prefix)
- "Return a new uninterned symbol.
-The name is made by appending `gensym-counter' to PREFIX.
-PREFIX is a string, and defaults to \"g\"."
- (let ((num (prog1 compat--gensym-counter
- (setq compat--gensym-counter
- (1+ compat--gensym-counter)))))
- (make-symbol (format "%s%d" (or prefix "g") num))))
-
-;;;; Defined in files.el
-
-(declare-function temporary-file-directory nil)
-(compat-defun make-nearby-temp-file (prefix &optional dir-flag suffix)
- "Create a temporary file as close as possible to `default-directory'.
-If PREFIX is a relative file name, and `default-directory' is a
-remote file name or located on a mounted file systems, the
-temporary file is created in the directory returned by the
-function `temporary-file-directory'. Otherwise, the function
-`make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the
-same meaning as in `make-temp-file'."
- (let ((handler (find-file-name-handler
- default-directory 'make-nearby-temp-file)))
- (if (and handler (not (file-name-absolute-p default-directory)))
- (funcall handler 'make-nearby-temp-file prefix dir-flag suffix)
- (let ((temporary-file-directory (temporary-file-directory)))
- (make-temp-file prefix dir-flag suffix)))))
-
-(compat-defvar mounted-file-systems
- (eval-when-compile
- (if (memq system-type '(windows-nt cygwin))
- "^//[^/]+/"
- (concat
- "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/")))))
- "File systems that ought to be mounted.")
-
-(compat-defun temporary-file-directory ()
- "The directory for writing temporary files.
-In case of a remote `default-directory', this is a directory for
-temporary files on that remote host. If such a directory does
-not exist, or `default-directory' ought to be located on a
-mounted file system (see `mounted-file-systems'), the function
-returns `default-directory'.
-For a non-remote and non-mounted `default-directory', the value of
-the variable `temporary-file-directory' is returned."
- (let ((handler (find-file-name-handler
- default-directory 'temporary-file-directory)))
- (if handler
- (funcall handler 'temporary-file-directory)
- (if (string-match compat--mounted-file-systems default-directory)
- default-directory
- temporary-file-directory))))
-
-(provide 'compat-26.1)
-;;; compat-26.1.el ends here
diff --git a/compat-26.el b/compat-26.el
new file mode 100644
index 0000000000..83b89c56c1
--- /dev/null
+++ b/compat-26.el
@@ -0,0 +1,631 @@
+;;; compat-26.el --- Compatibility Layer for Emacs 26.1 -*- lexical-binding:
t; -*-
+
+;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
+
+;; Author: Philip Kaludercic <philipk@posteo.net>
+;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
+;; URL: https://git.sr.ht/~pkal/compat/
+;; Keywords: lisp
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Find here the functionality added in Emacs 26.1, needed by older
+;; versions.
+;;
+;; Only load this library if you need to use one of the following
+;; functions:
+;;
+;; - `compat-sort'
+;; - `line-number-at-pos'
+;; - `compat-alist-get'
+;; - `string-trim-left'
+;; - `string-trim-right'
+;; - `string-trim'
+
+;;; Code:
+
+(eval-when-compile (require 'compat-macs))
+(declare-function compat-func-arity "compat" (func))
+
+;;;; Defined in eval.c
+
+(compat-defun func-arity (func)
+ "Return minimum and maximum number of args allowed for FUNC.
+FUNC must be a function of some kind.
+The returned value is a cons cell (MIN . MAX). MIN is the minimum number
+of args. MAX is the maximum number, or the symbol `many', for a
+function with `&rest' args, or `unevalled' for a special form."
+ :realname compat--func-arity
+ (cond
+ ((or (null func) (and (symbolp func) (not (fboundp func))))
+ (signal 'void-function func))
+ ((and (symbolp func) (not (null func)))
+ (compat--func-arity (symbol-function func)))
+ ((eq (car-safe func) 'macro)
+ (compat--func-arity (cdr func)))
+ ((subrp func)
+ (subr-arity func))
+ ((memq (car-safe func) '(closure lambda))
+ ;; See lambda_arity from eval.c
+ (when (eq (car func) 'closure)
+ (setq func (cdr func)))
+ (let ((syms-left (if (consp func)
+ (car func)
+ (signal 'invalid-function func)))
+ (min-args 0) (max-args 0) optional)
+ (catch 'many
+ (dolist (next syms-left)
+ (cond
+ ((not (symbolp next))
+ (signal 'invalid-function func))
+ ((eq next '&rest)
+ (throw 'many (cons min-args 'many)))
+ ((eq next '&optional)
+ (setq optional t))
+ (t (unless optional
+ (setq min-args (1+ min-args)))
+ (setq max-args (1+ max-args)))))
+ (cons min-args max-args))))
+ ((and (byte-code-function-p func) (numberp (aref func 0)))
+ ;; See get_byte_code_arity from bytecode.c
+ (let ((at (aref func 0)))
+ (cons (logand at 127)
+ (if (= (logand at 128) 0)
+ (ash at -8)
+ 'many))))
+ ((and (byte-code-function-p func) (numberp (aref func 0)))
+ ;; See get_byte_code_arity from bytecode.c
+ (let ((at (aref func 0)))
+ (cons (logand at 127)
+ (if (= (logand at 128) 0)
+ (ash at -8)
+ 'many))))
+ ((and (byte-code-function-p func) (listp (aref func 0)))
+ ;; Based on `byte-compile-make-args-desc', this is required for
+ ;; old versions of Emacs that don't use a integer for the argument
+ ;; list description, per e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6.
+ (let ((arglist (aref func 0)) (mandatory 0) nonrest)
+ (while (and arglist (not (memq (car arglist) '(&optional &rest))))
+ (setq mandatory (1+ mandatory))
+ (setq arglist (cdr arglist)))
+ (setq nonrest mandatory)
+ (when (eq (car arglist) '&optional)
+ (setq arglist (cdr arglist))
+ (while (and arglist (not (eq (car arglist) '&rest)))
+ (setq nonrest (1+ nonrest))
+ (setq arglist (cdr arglist))))
+ (cons mandatory (if arglist 'many nonrest))))
+ ((autoloadp func)
+ (autoload-do-load func)
+ (compat--func-arity func))
+ ((signal 'invalid-function func))))
+
+;;;; Defined in fns.c
+
+(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))))
+ (assoc key alist)))
+
+(compat-defun mapcan (func sequence)
+ "Apply FUNC to each element of SEQUENCE.
+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)))
+
+;;* UNTESTED
+(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."
+ :prefix t
+ (if absolute
+ (save-restriction
+ (widen)
+ (line-number-at-pos position))
+ (line-number-at-pos position)))
+
+;;;; Defined in subr.el
+
+(declare-function compat--alist-get-full-elisp "compat-25"
+ (key alist &optional default remove testfn))
+(compat-defun alist-get (key alist &optional default remove testfn)
+ "Handle TESTFN manually."
+ :realname compat--alist-get-handle-testfn
+ :prefix t
+ (if testfn
+ (compat--alist-get-full-elisp key alist default remove testfn)
+ (alist-get key alist default remove)))
+
+(gv-define-expander compat-alist-get
+ (lambda (do key alist &optional default remove testfn)
+ (macroexp-let2 macroexp-copyable-p k key
+ (gv-letplace (getter setter) alist
+ (macroexp-let2 nil p `(if (and ,testfn (not (eq ,testfn 'eq)))
+ (compat-assoc ,k ,getter ,testfn)
+ (assq ,k ,getter))
+ (funcall do (if (null default) `(cdr ,p)
+ `(if ,p (cdr ,p) ,default))
+ (lambda (v)
+ (macroexp-let2 nil v v
+ (let ((set-exp
+ `(if ,p (setcdr ,p ,v)
+ ,(funcall setter
+ `(cons (setq ,p (cons ,k ,v))
+ ,getter)))))
+ `(progn
+ ,(cond
+ ((null remove) set-exp)
+ ((or (eql v default)
+ (and (eq (car-safe v) 'quote)
+ (eq (car-safe default) 'quote)
+ (eql (cadr v) (cadr default))))
+ `(if ,p ,(funcall setter `(delq ,p ,getter))))
+ (t
+ `(cond
+ ((not (eql ,default ,v)) ,set-exp)
+ (,p ,(funcall setter
+ `(delq ,p ,getter))))))
+ ,v))))))))))
+
+(compat-defun string-trim-left (string &optional regexp)
+ "Trim STRING of leading string matching REGEXP.
+
+REGEXP defaults to \"[ \\t\\n\\r]+\"."
+ :realname compat--string-trim-left
+ :prefix t
+ (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string)
+ (substring string (match-end 0))
+ string))
+
+(compat-defun string-trim-right (string &optional regexp)
+ "Trim STRING of trailing string matching REGEXP.
+
+REGEXP defaults to \"[ \\t\\n\\r]+\"."
+ :realname compat--string-trim-right
+ :prefix t
+ (let ((i (string-match-p
+ (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'")
+ string)))
+ (if i (substring string 0 i) string)))
+
+(compat-defun string-trim (string &optional trim-left trim-right)
+ "Trim STRING of leading with and trailing matching TRIM-LEFT and TRIM-RIGHT.
+
+TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
+ :prefix t
+ ;; `string-trim-left' and `string-trim-right' were moved from subr-x
+ ;; to subr in Emacs 27, so to avoid loading subr-x we use the
+ ;; compatibility function here:
+ (compat--string-trim-left
+ (compat--string-trim-right
+ string
+ trim-right)
+ trim-left))
+
+(compat-defun caaar (x)
+ "Return the `car' of the `car' of the `car' of X."
+ (declare (pure t))
+ (car (car (car x))))
+
+(compat-defun caadr (x)
+ "Return the `car' of the `car' of the `cdr' of X."
+ (declare (pure t))
+ (car (car (cdr x))))
+
+(compat-defun cadar (x)
+ "Return the `car' of the `cdr' of the `car' of X."
+ (declare (pure t))
+ (car (cdr (car x))))
+
+(compat-defun caddr (x)
+ "Return the `car' of the `cdr' of the `cdr' of X."
+ (declare (pure t))
+ (car (cdr (cdr x))))
+
+(compat-defun cdaar (x)
+ "Return the `cdr' of the `car' of the `car' of X."
+ (declare (pure t))
+ (cdr (car (car x))))
+
+(compat-defun cdadr (x)
+ "Return the `cdr' of the `car' of the `cdr' of X."
+ (declare (pure t))
+ (cdr (car (cdr x))))
+
+(compat-defun cddar (x)
+ "Return the `cdr' of the `cdr' of the `car' of X."
+ (declare (pure t))
+ (cdr (cdr (car x))))
+
+(compat-defun cdddr (x)
+ "Return the `cdr' of the `cdr' of the `cdr' of X."
+ (declare (pure t))
+ (cdr (cdr (cdr x))))
+
+(compat-defun caaaar (x)
+ "Return the `car' of the `car' of the `car' of the `car' of X."
+ (declare (pure t))
+ (car (car (car (car x)))))
+
+(compat-defun caaadr (x)
+ "Return the `car' of the `car' of the `car' of the `cdr' of X."
+ (declare (pure t))
+ (car (car (car (cdr x)))))
+
+(compat-defun caadar (x)
+ "Return the `car' of the `car' of the `cdr' of the `car' of X."
+ (declare (pure t))
+ (car (car (cdr (car x)))))
+
+(compat-defun caaddr (x)
+ "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
+ (declare (pure t))
+ (car (car (cdr (cdr x)))))
+
+(compat-defun cadaar (x)
+ "Return the `car' of the `cdr' of the `car' of the `car' of X."
+ (declare (pure t))
+ (car (cdr (car (car x)))))
+
+(compat-defun cadadr (x)
+ "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
+ (declare (pure t))
+ (car (cdr (car (cdr x)))))
+
+(compat-defun caddar (x)
+ "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
+ (declare (pure t))
+ (car (cdr (cdr (car x)))))
+
+(compat-defun cadddr (x)
+ "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
+ (declare (pure t))
+ (car (cdr (cdr (cdr x)))))
+
+(compat-defun cdaaar (x)
+ "Return the `cdr' of the `car' of the `car' of the `car' of X."
+ (declare (pure t))
+ (cdr (car (car (car x)))))
+
+(compat-defun cdaadr (x)
+ "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
+ (declare (pure t))
+ (cdr (car (car (cdr x)))))
+
+(compat-defun cdadar (x)
+ "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
+ (declare (pure t))
+ (cdr (car (cdr (car x)))))
+
+(compat-defun cdaddr (x)
+ "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
+ (declare (pure t))
+ (cdr (car (cdr (cdr x)))))
+
+(compat-defun cddaar (x)
+ "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
+ (declare (pure t))
+ (cdr (cdr (car (car x)))))
+
+(compat-defun cddadr (x)
+ "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
+ (declare (pure t))
+ (cdr (cdr (car (cdr x)))))
+
+(compat-defun cdddar (x)
+ "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
+ (declare (pure t))
+ (cdr (cdr (cdr (car x)))))
+
+(compat-defun cddddr (x)
+ "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
+ (declare (pure t))
+ (cdr (cdr (cdr (cdr x)))))
+
+(compat-defvar gensym-counter 0
+ "Number used to construct the name of the next symbol created by `gensym'.")
+
+(compat-defun gensym (&optional prefix)
+ "Return a new uninterned symbol.
+The name is made by appending `gensym-counter' to PREFIX.
+PREFIX is a string, and defaults to \"g\"."
+ (let ((num (prog1 gensym-counter
+ (setq gensym-counter
+ (1+ gensym-counter)))))
+ (make-symbol (format "%s%d" (or prefix "g") num))))
+
+;;;; Defined in files.el
+
+(declare-function temporary-file-directory nil)
+
+;;* UNTESTED
+(compat-defun make-nearby-temp-file (prefix &optional dir-flag suffix)
+ "Create a temporary file as close as possible to `default-directory'.
+If PREFIX is a relative file name, and `default-directory' is a
+remote file name or located on a mounted file systems, the
+temporary file is created in the directory returned by the
+function `temporary-file-directory'. Otherwise, the function
+`make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the
+same meaning as in `make-temp-file'."
+ (let ((handler (find-file-name-handler
+ default-directory 'make-nearby-temp-file)))
+ (if (and handler (not (file-name-absolute-p default-directory)))
+ (funcall handler 'make-nearby-temp-file prefix dir-flag suffix)
+ (let ((temporary-file-directory (temporary-file-directory)))
+ (make-temp-file prefix dir-flag suffix)))))
+
+(compat-defvar mounted-file-systems
+ (eval-when-compile
+ (if (memq system-type '(windows-nt cygwin))
+ "^//[^/]+/"
+ (concat
+ "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/")))))
+ "File systems that ought to be mounted.")
+
+(compat-defun file-local-name (file)
+ "Return the local name component of FILE.
+This function removes from FILE the specification of the remote host
+and the method of accessing the host, leaving only the part that
+identifies FILE locally on the remote system.
+The returned file name can be used directly as argument of
+`process-file', `start-file-process', or `shell-command'."
+ :realname compat--file-local-name
+ (or (file-remote-p file 'localname) file))
+
+(compat-defun file-name-quoted-p (name &optional top)
+ "Whether NAME is quoted with prefix \"/:\".
+If NAME is a remote file name and TOP is nil, check the local part of NAME."
+ :realname compat--file-name-quoted-p
+ (let ((file-name-handler-alist (unless top file-name-handler-alist)))
+ (string-prefix-p "/:" (compat--file-local-name name))))
+
+(compat-defun file-name-quote (name &optional top)
+ "Add the quotation prefix \"/:\" to file NAME.
+If NAME is a remote file name and TOP is nil, the local part of
+NAME is quoted. If NAME is already a quoted file name, NAME is
+returned unchanged."
+ (let ((file-name-handler-alist (unless top file-name-handler-alist)))
+ (if (compat--file-name-quoted-p name top)
+ name
+ (concat (file-remote-p name) "/:" (compat--file-local-name name)))))
+
+;;* UNTESTED
+(compat-defun temporary-file-directory ()
+ "The directory for writing temporary files.
+In case of a remote `default-directory', this is a directory for
+temporary files on that remote host. If such a directory does
+not exist, or `default-directory' ought to be located on a
+mounted file system (see `mounted-file-systems'), the function
+returns `default-directory'.
+For a non-remote and non-mounted `default-directory', the value of
+the variable `temporary-file-directory' is returned."
+ (let ((handler (find-file-name-handler
+ default-directory 'temporary-file-directory)))
+ (if handler
+ (funcall handler 'temporary-file-directory)
+ (if (string-match mounted-file-systems default-directory)
+ default-directory
+ temporary-file-directory))))
+
+;;* UNTESTED
+(compat-defun file-attribute-type (attributes)
+ "The type field in ATTRIBUTES returned by `file-attributes'.
+The value is either t for directory, string (name linked to) for
+symbolic link, or nil."
+ (nth 0 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-link-number (attributes)
+ "Return the number of links in ATTRIBUTES returned by `file-attributes'."
+ (nth 1 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-user-id (attributes)
+ "The UID field in ATTRIBUTES returned by `file-attributes'.
+This is either a string or a number. If a string value cannot be
+looked up, a numeric value, either an integer or a float, is
+returned."
+ (nth 2 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-group-id (attributes)
+ "The GID field in ATTRIBUTES returned by `file-attributes'.
+This is either a string or a number. If a string value cannot be
+looked up, a numeric value, either an integer or a float, is
+returned."
+ (nth 3 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-access-time (attributes)
+ "The last access time in ATTRIBUTES returned by `file-attributes'.
+This a Lisp timestamp in the style of `current-time'."
+ (nth 4 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-modification-time (attributes)
+ "The modification time in ATTRIBUTES returned by `file-attributes'.
+This is the time of the last change to the file's contents, and
+is a Lisp timestamp in the style of `current-time'."
+ (nth 5 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-status-change-time (attributes)
+ "The status modification time in ATTRIBUTES returned by `file-attributes'.
+This is the time of last change to the file's attributes: owner
+and group, access mode bits, etc., and is a Lisp timestamp in the
+style of `current-time'."
+ (nth 6 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-size (attributes)
+ "The integer size (in bytes) in ATTRIBUTES returned by `file-attributes'."
+ (nth 7 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-modes (attributes)
+ "The file modes in ATTRIBUTES returned by `file-attributes'.
+This is a string of ten letters or dashes as in ls -l."
+ (nth 8 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-inode-number (attributes)
+ "The inode number in ATTRIBUTES returned by `file-attributes'.
+It is a nonnegative integer."
+ (nth 10 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-device-number (attributes)
+ "The file system device number in ATTRIBUTES returned by `file-attributes'.
+It is an integer."
+ (nth 11 attributes))
+
+(compat-defun file-attribute-collect (attributes &rest attr-names)
+ "Return a sublist of ATTRIBUTES returned by `file-attributes'.
+ATTR-NAMES are symbols with the selected attribute names.
+
+Valid attribute names are: type, link-number, user-id, group-id,
+access-time, modification-time, status-change-time, size, modes,
+inode-number and device-number."
+ (let ((idx '((type . 0)
+ (link-number . 1)
+ (user-id . 2)
+ (group-id . 3)
+ (access-time . 4)
+ (modification-time . 5)
+ (status-change-time . 6)
+ (size . 7)
+ (modes . 8)
+ (inode-number . 10)
+ (device-number . 11)))
+ result)
+ (while attr-names
+ (let ((attr (pop attr-names)))
+ (if (assq attr idx)
+ (push (nth (cdr (assq attr idx))
+ attributes)
+ result)
+ (error "Wrong attribute name '%S'" attr))))
+ (nreverse result)))
+
+;;;; Defined in subr-x.el
+
+(compat-defmacro if-let* (varlist then &rest else)
+ "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."
+ :realname compat--if-let*
+ :feature 'subr-x
+ (declare (indent 2)
+ (debug ((&rest [&or symbolp (symbolp form) (form)])
+ body)))
+ (let ((empty (make-symbol "s"))
+ (last t) list)
+ (dolist (var varlist)
+ (push `(,(if (cdr var) (car var) empty)
+ (and ,last ,(or (cadr var) (car var))))
+ list)
+ (when (or (cdr var) (consp (car var)))
+ (setq last (caar list))))
+ `(let* ,(nreverse list)
+ (if ,(caar list) ,then ,@else))))
+
+(compat-defmacro when-let* (varlist &rest body)
+ "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
+ (declare (indent 1) (debug if-let*))
+ (let ((empty (make-symbol "s"))
+ (last t) list)
+ (dolist (var varlist)
+ (push `(,(if (cdr var) (car var) empty)
+ (and ,last ,(or (cadr var) (car var))))
+ list)
+ (when (or (cdr var) (consp (car var)))
+ (setq last (caar list))))
+ `(let* ,(nreverse list)
+ (when ,(caar list) ,@body))))
+
+(compat-defmacro and-let* (varlist &rest body)
+ "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
+ (declare (indent 1) (debug if-let*))
+ (let ((empty (make-symbol "s"))
+ (last t) list)
+ (dolist (var varlist)
+ (push `(,(if (cdr var) (car var) empty)
+ (and ,last ,(or (cadr var) (car var))))
+ list)
+ (when (or (cdr var) (consp (car var)))
+ (setq last (caar list))))
+ `(let* ,(nreverse list)
+ (if ,(caar list) ,(macroexp-progn (or body '(t)))))))
+
+;;;; Defined in image.el
+
+;;* UNTESTED
+(compat-defun image-property (image property)
+ "Return the value of PROPERTY in IMAGE.
+Properties can be set with
+
+ (setf (image-property IMAGE PROPERTY) VALUE)
+
+If VALUE is nil, PROPERTY is removed from IMAGE."
+ (plist-get (cdr image) property))
+
+;;* UNTESTED
+(unless (get 'image-property 'gv-expander)
+ (gv-define-setter image-property (image property value)
+ (let ((image* (make-symbol "image"))
+ (property* (make-symbol "property"))
+ (value* (make-symbol "value")))
+ `(let ((,image* ,image)
+ (,property* ,property)
+ (,value* ,value))
+ (if
+ (null ,value*)
+ (while
+ (cdr ,image*)
+ (if
+ (eq
+ (cadr ,image*)
+ ,property*)
+ (setcdr ,image*
+ (cdddr ,image*))
+ (setq ,image*
+ (cddr ,image*))))
+ (setcdr ,image*
+ (plist-put
+ (cdr ,image*)
+ ,property* ,value*)))))))
+
+(compat--inhibit-prefixed (provide 'compat-26))
+;;; compat-26.el ends here
diff --git a/compat-27.1.el b/compat-27.el
similarity index 63%
rename from compat-27.1.el
rename to compat-27.el
index 7afca8b3ab..a5eb72e36a 100644
--- a/compat-27.1.el
+++ b/compat-27.el
@@ -1,8 +1,10 @@
-;;; compat-27.1.el --- Compatibility Layer for Emacs 27.1 -*-
lexical-binding: t; -*-
+;;; compat-27.el --- Compatibility Layer for Emacs 27.1 -*- lexical-binding:
t; -*-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
+;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
+;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
+;; URL: https://git.sr.ht/~pkal/compat/
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
@@ -23,7 +25,17 @@
;; Find here the functionality added in Emacs 27.1, needed by older
;; versions.
;;
-;; Do NOT load this library manually. Instead require `compat'.
+;; Only load this library if you need to use one of the following
+;; functions or macros:
+;;
+;; - `compat-recenter'
+;; - `compat-lookup-key'
+;; - `compat-setq-local'
+;; - `compat-assoc-delete-all'
+;; - `compat-file-size-human-readable'
+;; - `compat-executable-find'
+;; - `compat-regexp-opt'
+;; - `compat-dired-get-marked-files'
;;; Code:
@@ -52,7 +64,7 @@ is nil)."
(when (listp object)
(catch 'cycle
(let ((hare object) (tortoise object)
- (max 2) (q 2) )
+ (max 2) (q 2))
(while (consp hare)
(setq hare (cdr hare))
(when (and (or (/= 0 (setq q (1- q)))
@@ -123,14 +135,18 @@ Letter-case is significant, but text properties are
ignored."
;;;; Defined in json.c
(declare-function json-parse-string nil (string &rest args))
-(declare-function json-encode-string "json" (object))
+(declare-function json-encode "json" (object))
(declare-function json-read-from-string "json" (string))
(declare-function json-read "json" ())
+(defvar json-encoding-pretty-print)
(defvar json-object-type)
(defvar json-array-type)
(defvar json-false)
(defvar json-null)
+;; The function is declared to satisfy the byte compiler while testing
+;; if native JSON parsing is available.;
+(declare-function json-serialize nil (object &rest args))
(compat-defun json-serialize (object &rest args)
"Return the JSON representation of OBJECT as a string.
@@ -156,24 +172,72 @@ represent a JSON false value. It defaults to `:false'.
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 "[]")
- (json-unavailable t)
- (void-function t))
+ :cond (not (condition-case nil
+ (equal (json-serialize '()) "{}")
+ (:success t)
+ (void-function nil)
+ (json-unavailable nil)))
+ :realname compat--json-serialize
(require 'json)
- (let ((json-false (or (plist-get args :false-object) :false))
- (json-null (or (plist-get args :null-object) :null)))
- (json-encode-string object)))
+ (letrec ((fix (lambda (obj)
+ (cond
+ ((hash-table-p obj)
+ (let ((ht (copy-hash-table obj)))
+ (maphash
+ (lambda (key val)
+ (unless (stringp key)
+ (signal
+ 'wrong-type-argument
+ (list 'stringp key)))
+ (puthash key (funcall fix val) ht))
+ obj)
+ ht))
+ ((and (listp obj) (consp (car obj))) ;alist
+ (mapcar
+ (lambda (ent)
+ (cons (symbol-name (car ent))
+ (funcall fix (cdr ent))))
+ obj))
+ ((listp obj) ;plist
+ (let (alist)
+ (while obj
+ (push (cons (cond
+ ((keywordp (car obj))
+ (substring
+ (symbol-name (car obj))
+ 1))
+ ((symbolp (car obj))
+ (symbol-name (car obj)))
+ ((signal
+ 'wrong-type-argument
+ (list 'symbolp (car obj)))))
+ (funcall fix (cadr obj)))
+ alist)
+ (unless (consp (cdr obj))
+ (signal 'wrong-type-argument '(consp nil)))
+ (setq obj (cddr obj)))
+ (nreverse alist)))
+ ((vectorp obj)
+ (let ((vec (make-vector (length obj) nil)))
+ (dotimes (i (length obj))
+ (aset vec i (funcall fix (aref obj i))))
+ vec))
+ (obj))))
+ (json-encoding-pretty-print nil)
+ (json-false (or (plist-get args :false-object) :false))
+ (json-null (or (plist-get args :null-object) :null)))
+ (json-encode (funcall fix object))))
(compat-defun json-insert (object &rest args)
"Insert the JSON representation of OBJECT before point.
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 "[]")
- (json-unavailable t)
- (void-function t))
+ :cond (not (condition-case nil
+ (equal (json-serialize '()) "{}")
+ (:success t)
+ (void-function nil)
+ (json-unavailable nil)))
(insert (apply #'compat--json-serialize object args)))
(compat-defun json-parse-string (string &rest args)
@@ -200,10 +264,11 @@ 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 "[]")
- (json-unavailable t)
- (void-function t))
+ :cond (not (condition-case nil
+ (equal (json-serialize '()) "{}")
+ (:success t)
+ (void-function nil)
+ (json-unavailable nil)))
(require 'json)
(condition-case err
(let ((json-object-type (or (plist-get args :object-type) 'hash-table))
@@ -243,10 +308,11 @@ 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 "[]")
- (json-unavailable t)
- (void-function t))
+ :cond (not (condition-case nil
+ (equal (json-serialize '()) "{}")
+ (:success t)
+ (void-function nil)
+ (json-unavailable nil)))
(require 'json)
(condition-case err
(let ((json-object-type (or (plist-get args :object-type) 'hash-table))
@@ -258,9 +324,65 @@ represent a JSON false value. It defaults to `:false'."
(json-read))
(json-error (signal 'json-parse-buffer err))))
+;;;; Defined in timefns.c
+
+(compat-defun time-equal-p (t1 t2)
+ "Return non-nil if time value T1 is equal to time value T2.
+A nil value for either argument stands for the current time."
+ :note "This function is not as accurate as the actual `time-equal-p'."
+ (cond
+ ((eq t1 t2))
+ ((and (consp t1) (consp t2))
+ (equal t1 t2))
+ ((let ((now (current-time)))
+ ;; Due to inaccuracies and the relatively slow evaluating of
+ ;; Emacs Lisp compared to C, we allow for slight inaccuracies
+ ;; (less than a millisecond) when comparing time values.
+ (< (abs (- (float-time (or t1 now))
+ (float-time (or t2 now))))
+ 1e-5)))))
+
+;;;; Defined in fileio.c
+
+(compat-defun file-name-absolute-p (filename)
+ "Return t if FILENAME is an absolute file name.
+On Unix, absolute file names start with `/'. In Emacs, an absolute
+file name can also start with an initial `~' or `~USER' component,
+where USER is a valid login name."
+ ;; See definitions in filename.h
+ (let ((seperator
+ (eval-when-compile
+ (if (memq system-type '(cygwin windows-nt ms-dos))
+ "[\\/]" "/")))
+ (drive
+ (eval-when-compile
+ (cond
+ ((memq system-type '(windows-nt ms-dos))
+ "\\`[A-Za-z]:[\\/]")
+ ((eq system-type 'cygwin)
+ "\\`\\([\\/]\\|[A-Za-z]:\\)")
+ ("\\`/"))))
+ (home
+ (eval-when-compile
+ (if (memq system-type '(cygwin windows-nt ms-dos))
+ "\\`~[\\/]" "\\`~/")))
+ (user-home
+ (eval-when-compile
+ (format "\\`\\(~.*?\\)\\(%s.*\\)?$"
+ (if (memq system-type '(cygwin windows-nt ms-dos))
+ "[\\/]" "/")))))
+ (or (and (string-match-p drive filename) t)
+ (and (string-match-p home filename) t)
+ (save-excursion
+ (when (string-match user-home filename)
+ (let ((init (match-string 1 filename)))
+ (not (string=
+ (file-name-base (expand-file-name init))
+ init))))))))
+
;;;; Defined in subr.el
-(compat-defun setq-local (&rest pairs)
+(compat-defmacro setq-local (&rest pairs)
"Handle multiple assignments."
:prefix t
(unless (zerop (mod (length pairs) 2))
@@ -275,6 +397,7 @@ represent a JSON false value. It defaults to `:false'."
body)))
(cons 'progn (nreverse body))))
+;;* UNTESTED
(compat-defmacro ignore-error (condition &rest body)
"Execute BODY; if the error CONDITION occurs, return nil.
Otherwise, return result of last form in BODY.
@@ -283,6 +406,7 @@ CONDITION can also be a list of error conditions."
(declare (debug t) (indent 1))
`(condition-case nil (progn ,@body) (,condition nil)))
+;;* UNTESTED
(compat-defmacro dolist-with-progress-reporter (spec reporter-or-message &rest
body)
"Loop over a list and report progress in the echo area.
Evaluate BODY with VAR bound to each car from LIST, in turn.
@@ -341,49 +465,76 @@ return nil."
"Standard regexp guaranteed not to match any string at all."
:constant t)
+(compat-defun assoc-delete-all (key alist &optional test)
+ "Delete from ALIST all elements whose car is KEY.
+Compare keys with TEST. Defaults to `equal'.
+Return the modified alist.
+Elements of ALIST that are not conses are ignored."
+ :prefix t
+ (unless test (setq test #'equal))
+ (while (and (consp (car alist))
+ (funcall test (caar alist) key))
+ (setq alist (cdr alist)))
+ (let ((tail alist) tail-cdr)
+ (while (setq tail-cdr (cdr tail))
+ (if (and (consp (car tail-cdr))
+ (funcall test (caar tail-cdr) key))
+ (setcdr tail (cdr tail-cdr))
+ (setq tail tail-cdr))))
+ alist)
+
;;;; Defined in simple.el
+;;* UNTESTED
(compat-defun decoded-time-second (time)
"The seconds in TIME, which is a value returned by `decode-time'.
This is an integer between 0 and 60 (inclusive). (60 is a leap
second, which only some operating systems support.)"
(nth 0 time))
+;;* UNTESTED
(compat-defun decoded-time-minute (time)
"The minutes in TIME, which is a value returned by `decode-time'.
This is an integer between 0 and 59 (inclusive)."
(nth 1 time))
+;;* UNTESTED
(compat-defun decoded-time-hour (time)
"The hours in TIME, which is a value returned by `decode-time'.
This is an integer between 0 and 23 (inclusive)."
(nth 2 time))
+;;* UNTESTED
(compat-defun decoded-time-day (time)
"The day-of-the-month in TIME, which is a value returned by `decode-time'.
This is an integer between 1 and 31 (inclusive)."
(nth 3 time))
+;;* UNTESTED
(compat-defun decoded-time-month (time)
"The month in TIME, which is a value returned by `decode-time'.
This is an integer between 1 and 12 (inclusive). January is 1."
(nth 4 time))
+;;* UNTESTED
(compat-defun decoded-time-year (time)
"The year in TIME, which is a value returned by `decode-time'.
This is a four digit integer."
(nth 5 time))
+;;* UNTESTED
(compat-defun decoded-time-weekday (time)
"The day-of-the-week in TIME, which is a value returned by `decode-time'.
This is a number between 0 and 6, and 0 is Sunday."
(nth 6 time))
+;;* UNTESTED
(compat-defun decoded-time-dst (time)
"The daylight saving time in TIME, which is a value returned by
`decode-time'.
This is t if daylight saving time is in effect, and nil if not."
(nth 7 time))
+;;* UNTESTED
(compat-defun decoded-time-zone (time)
"The time zone in TIME, which is a value returned by `decode-time'.
This is an integer indicating the UTC offset in seconds, i.e.,
@@ -428,6 +579,64 @@ in all cases, since that is the standard symbol for byte."
(if (string= prefixed-unit "") "" (or space ""))
prefixed-unit))))
+(declare-function compat--file-name-quote "compat-26"
+ (name &optional top))
+
+;;*UNTESTED
+(compat-defun exec-path ()
+ "Return list of directories to search programs to run in remote subprocesses.
+The remote host is identified by `default-directory'. For remote
+hosts that do not support subprocesses, this returns nil.
+If `default-directory' is a local directory, this function returns
+the value of the variable `exec-path'."
+ :realname compat--exec-path
+ (cond
+ ((let ((handler (find-file-name-handler default-directory 'exec-path)))
+ ;; FIXME: The handler was added in 27.1, and this compatibility
+ ;; function only applies to versions of Emacs before that.
+ (when handler
+ (condition-case nil
+ (funcall handler 'exec-path)
+ (error nil)))))
+ ((file-remote-p default-directory)
+ ;; TODO: This is not completely portable, even if "sh" and
+ ;; "getconf" should be provided on every POSIX system, the chance
+ ;; of this not working are greater than zero.
+ ;;
+ ;; FIXME: This invokes a shell process every time exec-path is
+ ;; called. It should instead be cached on a host-local basis.
+ (with-temp-buffer
+ (if (condition-case nil
+ (zerop (process-file "sh" nil t nil "-c" "getconf PATH"))
+ (file-missing t))
+ (list "/bin" "/usr/bin")
+ (let (path)
+ (while (re-search-forward "\\([^:]+?\\)[\n:]" nil t)
+ (push (match-string 1) path))
+ (nreverse path)))))
+ (exec-path)))
+
+(declare-function compat--file-local-name "compat-26"
+ (file))
+
+;;*UNTESTED
+(compat-defun executable-find (command &optional remote)
+ "Search for COMMAND in `exec-path' and return the absolute file name.
+Return nil if COMMAND is not found anywhere in `exec-path'. If
+REMOTE is non-nil, search on the remote host indicated by
+`default-directory' instead."
+ :prefix t
+ (if (and remote (file-remote-p default-directory))
+ (let ((res (locate-file
+ command
+ (mapcar
+ (apply-partially
+ #'concat (file-remote-p default-directory))
+ (compat--exec-path))
+ exec-suffixes 'file-executable-p)))
+ (when (stringp res) (compat--file-local-name res)))
+ (executable-find command)))
+
;; TODO provide advice for directory-files-recursively
;;;; Defined in format-spec.el
@@ -456,6 +665,7 @@ in all cases, since that is the standard symbol for byte."
(declare-function lm-header "lisp-mnt")
+;;* UNTESTED
(compat-defun package-get-version ()
"Return the version number of the package in which this is used.
Assumes it is used from an Elisp file placed inside the top-level directory
@@ -490,5 +700,40 @@ The return value is a string (or nil in case we can’t find
it)."
(or (lm-header "package-version")
(lm-header "version")))))))))
-(provide 'compat-27.1)
-;;; compat-27.1.el ends here
+
+;;;; Defined in dired.el
+
+(declare-function
+ dired-get-marked-files "dired.el"
+ (&optional localp arg filter distinguish-one-marked error))
+
+;;* UNTESTED
+(compat-defun dired-get-marked-files
+ (&optional localp arg filter distinguish-one-marked error)
+ "Return the marked files’ names as list of strings."
+ :feature 'dired
+ :prefix t
+ (let ((result (dired-get-marked-files localp arg filter
distinguish-one-marked)))
+ (if (and (null result) error)
+ (user-error (if (stringp error) error "No files specified"))
+ result)))
+
+;;;; Defined in time-date.el
+
+(compat-defun date-days-in-month (year month)
+ "The number of days in MONTH in YEAR."
+ :feature 'time-date
+ (unless (and (numberp month)
+ (<= 1 month)
+ (<= month 12))
+ (error "Month %s is invalid" month))
+ (if (= month 2)
+ (if (date-leap-year-p year)
+ 29
+ 28)
+ (if (memq month '(1 3 5 7 8 10 12))
+ 31
+ 30)))
+
+(compat--inhibit-prefixed (provide 'compat-27))
+;;; compat-27.el ends here
diff --git a/compat-28.1.el b/compat-28.el
similarity index 65%
rename from compat-28.1.el
rename to compat-28.el
index 028893bf4e..0c399b4823 100644
--- a/compat-28.1.el
+++ b/compat-28.el
@@ -1,8 +1,10 @@
-;;; compat-28.1.el --- Compatibility Layer for Emacs 28.1 -*-
lexical-binding: t; -*-
+;;; compat-28.el --- Compatibility Layer for Emacs 28.1 -*- lexical-binding:
t; -*-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
+;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
+;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
+;; URL: https://git.sr.ht/~pkal/compat/
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
@@ -23,7 +25,17 @@
;; Find here the functionality added in Emacs 28.1, needed by older
;; versions.
;;
-;; Do NOT load this library manually. Instead require `compat'.
+;; Only load this library if you need to use one of the following
+;; functions:
+;;
+;; - `unlock-buffer'
+;; - `string-width'
+;; - `directory-files'
+;; - `json-serialize'
+;; - `json-insert'
+;; - `json-parse-string'
+;; - `json-parse-buffer'
+;; - `count-windows'
;;; Code:
@@ -31,6 +43,7 @@
;;;; Defined in fns.c
+;;* INCOMPLETE FEATURE: Should handle multibyte regular expressions
(compat-defun string-search (needle haystack &optional start-pos)
"Search for the string NEEDLE in the strign HAYSTACK.
@@ -46,7 +59,8 @@ Case is always significant and text properties are ignored."
multibyte regular expressions. As the compatibility function
for `string-search' is implemented via `string-match', these
issues are inherited."
- (when (and start-pos (< start-pos 0))
+ (when (and start-pos (or (< (length haystack) start-pos)
+ (< start-pos 0)))
(signal 'args-out-of-range (list start-pos)))
(save-match-data
(let ((case-fold-search nil))
@@ -105,6 +119,7 @@ inserted before contatenating."
;;;; Defined in alloc.c
+;;* UNTESTED (but also not necessary)
(compat-defun garbage-collect-maybe (_factor)
"Call ‘garbage-collect’ if enough allocation happened.
FACTOR determines what \"enough\" means here: If FACTOR is a
@@ -140,10 +155,16 @@ continuing as if the error did not occur."
Optional arguments FROM and TO specify the substring of STRING to
consider, and are interpreted as in `substring'."
:prefix t
- (string-width (substring string (or from 0) to)))
+ (let* ((len (length string))
+ (from (or from 0))
+ (to (or to len)))
+ (if (and (= from 0) (= to len))
+ (string-width string)
+ (string-width (substring string from to)))))
;;;; Defined in dired.c
+;;* UNTESTED
(compat-defun directory-files (directory &optional full match nosort count)
"Handle additional optional argument COUNT:
@@ -157,78 +178,49 @@ If COUNT is non-nil and a natural number, the function
will
;;;; Defined in json.c
+(declare-function json-insert nil (object &rest args))
(declare-function json-serialize nil (object &rest args))
(declare-function json-parse-string nil (string &rest args))
+(declare-function json-parse-buffer nil (&rest args))
-(compat-advise json-serialize (object &rest args)
+(compat-defun json-serialize (object &rest args)
"Handle top-level JSON values."
- :cond (condition-case err
- ;; Use `random' to prevent byte compiler from optimising
- ;; the "pure" `json-serialize' call.
- (ignore (json-serialize (if (random) 0 0)))
- (wrong-type-argument (eq (cadr err) 'json-value-p))
- ;; `json-serialize' might be disabled at compile time, so we
- ;; have to check if an error was raised that the function
- ;; was not defined.
- (void-function (eq (cadr err) 'json-serialize)))
- :realname compat--json-serialize-handle-tlo
+ :prefix t
:min-version "27"
(if (or (listp object) (vectorp object))
- (apply oldfun object args)
+ (apply #'json-serialize object args)
(substring (json-serialize (list object)) 1 -1)))
-(compat-advise json-insert (object &rest args)
+(compat-defun json-insert (object &rest args)
"Handle top-level JSON values."
- :cond (condition-case err
- ;; Use `random' to prevent byte compiler from optimising
- ;; the "pure" `json-serialize' call.
- (ignore (json-serialize (if (random) 0 0)))
- (wrong-type-argument (eq (cadr err) 'json-value-p))
- ;; `json-serialize' might be disabled at compile time, so we
- ;; have to check if an error was raised that the function
- ;; was not defined.
- (void-function (eq (cadr err) 'json-serialize)))
- :realname compat--json-insert-handle-tlo
+ :prefix t
:min-version "27"
(if (or (listp object) (vectorp object))
- (apply oldfun object args)
- (insert (apply #'compat--json-serialize-handle-tlo oldfun object args))))
-
-(compat-advise json-parse-string (string &rest args)
+ (apply #'json-insert object args)
+ ;; `compat-json-serialize' is not sharp-quoted as the byte
+ ;; compiled doesn't always know that the function has been
+ ;; defined, but it will only be used in this function if the
+ ;; prefixed definition of `json-serialize' (see above) has also
+ ;; been defined.
+ (insert (apply 'compat-json-serialize object args))))
+
+(compat-defun json-parse-string (string &rest args)
"Handle top-level JSON values."
- :cond (condition-case err
- ;; Use `random' to prevent byte compiler from optimising
- ;; the "pure" `json-serialize' call.
- (ignore (json-parse-string (if (random) "0" "0")))
- (json-parse-error t)
- ;; `json-parse-string' might be disabled at compile time, so
- ;; we have to check if an error was raised that the function
- ;; was not defined.
- (void-function (eq (cadr err) 'json-parse-error)))
- :realname compat--json-parse-string-handle-tlo
+ :prefix t
:min-version "27"
(if (string-match-p "\\`[[:space:]]*[[{]" string)
- (apply oldfun string args)
+ (apply #'json-parse-string string args)
;; Wrap the string in an array, and extract the value back using
;; `elt', to ensure that no matter what the value of `:array-type'
;; is we can access the first element.
- (elt (apply oldfun (concat "[" string "]") args) 0)))
+ (elt (apply #'json-parse-string (concat "[" string "]") args) 0)))
-(compat-advise json-parse-buffer (&rest args)
+(compat-defun json-parse-buffer (&rest args)
"Handle top-level JSON values."
- :cond (condition-case err
- ;; Use `random' to prevent byte compiler from optimising
- ;; the "pure" `json-serialize' call.
- (ignore (json-parse-string (if (random) "0" "0")))
- (json-parse-error t)
- ;; `json-parse-string' might be disabled at compile time, so
- ;; we have to check if an error was raised that the function
- ;; was not defined.
- (void-function (eq (cadr err) 'json-parse-error)))
- :realname compat--json-parse-buffer-handle-tlo
+ :prefix t
:min-version "27"
(if (looking-at-p "[[:space:]]*[[{]")
- (apply oldfun args)
+ (apply #'json-parse-buffer args)
(catch 'escape
(atomic-change-group
(with-syntax-table
@@ -241,10 +233,86 @@ If COUNT is non-nil and a natural number, the function
will
(insert "[")
(forward-sexp 1)
(insert "]"))))
- (throw 'escape (elt (apply oldfun args) 0))))))
+ (throw 'escape (elt (apply #'json-parse-buffer args) 0))))))
+
+;;;; xfaces.c
+
+(compat-defun color-values-from-color-spec (spec)
+ "Parse color SPEC as a numeric color and return (RED GREEN BLUE).
+This function recognises the following formats for SPEC:
+
+ #RGB, where R, G and B are hex numbers of equal length, 1-4 digits each.
+ rgb:R/G/B, where R, G, and B are hex numbers, 1-4 digits each.
+ rgbi:R/G/B, where R, G and B are floating-point numbers in [0,1].
+
+If SPEC is not in one of the above forms, return nil.
+
+Each of the 3 integer members of the resulting list, RED, GREEN,
+and BLUE, is normalized to have its value in [0,65535]."
+ (let ((case-fold-search nil))
+ (save-match-data
+ (cond
+ ((string-match
+ ;; (rx bos "#"
+ ;; (or (: (group-n 1 (= 1 hex)) (group-n 2 (= 1 hex)) (group-n 3
(= 1 hex)))
+ ;; (: (group-n 1 (= 2 hex)) (group-n 2 (= 2 hex)) (group-n 3
(= 2 hex)))
+ ;; (: (group-n 1 (= 3 hex)) (group-n 2 (= 3 hex)) (group-n 3
(= 3 hex)))
+ ;; (: (group-n 1 (= 4 hex)) (group-n 2 (= 4 hex)) (group-n 3
(= 4 hex))))
+ ;; eos)
+
"\\`#\\(?:\\(?1:[[:xdigit:]]\\{1\\}\\)\\(?2:[[:xdigit:]]\\{1\\}\\)\\(?3:[[:xdigit:]]\\{1\\}\\)\\|\\(?1:[[:xdigit:]]\\{2\\}\\)\\(?2:[[:xdigit:]]\\{2\\}\\)\\(?3:[[:xdigit:]]\\{2\\}\\)\\|\\(?1:[[:xdigit:]]\\{3\\}\\)\\(?2:[[:xdigit:]]\\{3\\}\\)\\(?3:[[:xdigit:]]\\{3\\}\\)\\|\\(?1:[[:xdigit:]]\\{4\\}\\)\\(?2:[[:xdigit:]]\\{4\\}\\)\\(?3:[[:xdigit:]]\\{4\\}\\)\\)\\'"
+ spec)
+ (let ((max (1- (ash 1 (* (- (match-end 1) (match-beginning 1)) 4)))))
+ (list (/ (* (string-to-number (match-string 1 spec) 16) 65535) max)
+ (/ (* (string-to-number (match-string 2 spec) 16) 65535) max)
+ (/ (* (string-to-number (match-string 3 spec) 16) 65535)
max))))
+ ((string-match
+ ;; (rx bos "rgb:"
+ ;; (group (** 1 4 hex)) "/"
+ ;; (group (** 1 4 hex)) "/"
+ ;; (group (** 1 4 hex))
+ ;; eos)
+
"\\`rgb:\\([[:xdigit:]]\\{1,4\\}\\)/\\([[:xdigit:]]\\{1,4\\}\\)/\\([[:xdigit:]]\\{1,4\\}\\)\\'"
+ spec)
+ (list (/ (* (string-to-number (match-string 1 spec) 16) 65535)
+ (1- (ash 1 (* (- (match-end 1) (match-beginning 1)) 4))))
+ (/ (* (string-to-number (match-string 2 spec) 16) 65535)
+ (1- (ash 1 (* (- (match-end 2) (match-beginning 2)) 4))))
+ (/ (* (string-to-number (match-string 3 spec) 16) 65535)
+ (1- (ash 1 (* (- (match-end 3) (match-beginning 3)) 4))))))
+ ;; The "RGBi" (RGB Intensity) specification is defined by
+ ;; XCMS[0], see [1] for the implementation in Xlib.
+ ;;
+ ;; [0] http://www.nic.funet.fi/pub/X11/X11R4/DOCS/color/Xcms.text
+ ;; [1]
https://gitlab.freedesktop.org/xorg/lib/libx11/-/blob/master/src/xcms/LRGB.c#L1392
+ ((string-match
+ (rx bos "rgbi:" (* space)
+ (group (? (or "-" "+"))
+ (or (: (+ digit) (? "." (* digit)))
+ (: "." (+ digit)))
+ (? "e" (? (or "-" "+")) (+ digit)))
+ "/" (* space)
+ (group (? (or "-" "+"))
+ (or (: (+ digit) (? "." (* digit)))
+ (: "." (+ digit)))
+ (? "e" (? (or "-" "+")) (+ digit)))
+ "/" (* space)
+ (group (? (or "-" "+"))
+ (or (: (+ digit) (? "." (* digit)))
+ (: "." (+ digit)))
+ (? "e" (? (or "-" "+")) (+ digit)))
+ eos)
+ spec)
+ (let ((r (round (* (string-to-number (match-string 1 spec)) 65535)))
+ (g (round (* (string-to-number (match-string 2 spec)) 65535)))
+ (b (round (* (string-to-number (match-string 3 spec)) 65535))))
+ (when (and (<= 0 r) (<= r 65535)
+ (<= 0 g) (<= g 65535)
+ (<= 0 b) (<= b 65535))
+ (list r g b))))))))
;;;; Defined in subr.el
+;;* INCOMPLETE FEATURE: Should handle multibyte regular expressions
(compat-defun string-replace (fromstring tostring instring)
"Replace FROMSTRING with TOSTRING in INSTRING each time it occurs."
(when (equal fromstring "")
@@ -261,6 +329,7 @@ This function accepts any number of ARGUMENTS, but ignores
them.
Also see `ignore'."
t)
+;;* UNTESTED
(compat-defun insert-into-buffer (buffer &optional start end)
"Insert the contents of the current buffer into BUFFER.
If START/END, only insert that region from the current buffer.
@@ -269,6 +338,35 @@ Point in BUFFER will be placed after the inserted text."
(with-current-buffer buffer
(insert-buffer-substring current start end))))
+;;* UNTESTED
+(compat-defun replace-string-in-region (string replacement &optional start end)
+ "Replace STRING with REPLACEMENT in the region from START to END.
+The number of replaced occurrences are returned, or nil if STRING
+doesn't exist in the region.
+
+If START is nil, use the current point. If END is nil, use `point-max'.
+
+Comparisons and replacements are done with fixed case."
+ (if start
+ (when (< start (point-min))
+ (error "Start before start of buffer"))
+ (setq start (point)))
+ (if end
+ (when (> end (point-max))
+ (error "End after end of buffer"))
+ (setq end (point-max)))
+ (save-excursion
+ (let ((matches 0)
+ (case-fold-search nil))
+ (goto-char start)
+ (while (search-forward string end t)
+ (delete-region (match-beginning 0) (match-end 0))
+ (insert replacement)
+ (setq matches (1+ matches)))
+ (and (not (zerop matches))
+ matches))))
+
+;;* UNTESTED
(compat-defun replace-regexp-in-region (regexp replacement &optional start end)
"Replace REGEXP with REPLACEMENT in the region from START to END.
The number of replaced occurrences are returned, or nil if REGEXP
@@ -303,6 +401,7 @@ REPLACEMENT can use the following special elements:
(and (not (zerop matches))
matches))))
+;;* UNTESTED
(compat-defun buffer-local-boundp (symbol buffer)
"Return non-nil if SYMBOL is bound in BUFFER.
Also see `local-variable-p'."
@@ -312,12 +411,12 @@ Also see `local-variable-p'."
(void-variable nil (throw 'fail nil)))
t))
-(declare-function gensym nil (&optional prefix))
+;;* UNTESTED
(compat-defmacro with-existing-directory (&rest body)
"Execute BODY with `default-directory' bound to an existing directory.
If `default-directory' is already an existing directory, it's not changed."
(declare (indent 0) (debug t))
- (let ((quit (gensym)))
+ (let ((quit (make-symbol "with-existing-directory-quit")))
`(catch ',quit
(dolist (dir (list default-directory
(expand-file-name "~/")
@@ -330,6 +429,7 @@ If `default-directory' is already an existing directory,
it's not changed."
(throw ',quit (let ((default-directory dir))
,@body)))))))
+;;* UNTESTED
(compat-defmacro dlet (binders &rest body)
"Like `let' but using dynamic scoping."
(declare (indent 1) (debug let))
@@ -347,6 +447,10 @@ not a list, return a one-element list containing OBJECT."
object
(list object)))
+(compat-defun subr-primitive-p (object)
+ "Return t if OBJECT is a built-in primitive function."
+ (subrp object))
+
;;;; Defined in subr-x.el
(compat-defun string-clean-whitespace (string)
@@ -502,8 +606,8 @@ as the new values of the bound variables in the recursive
invocation."
;;;; Defined in files.el
-(declare-function compat--string-trim-left "compat-26.1" (string &optional
regexp))
-(declare-function compat--directory-name-p "compat-25.1" (name))
+(declare-function compat--string-trim-left "compat-26" (string &optional
regexp))
+(declare-function compat--directory-name-p "compat-25" (name))
(compat-defun file-name-with-extension (filename extension)
"Set the EXTENSION of a FILENAME.
The extension (in a file name) is the part that begins with the last \".\".
@@ -526,6 +630,7 @@ See also `file-name-sans-extension'."
(t
(concat (file-name-sans-extension filename) "." extn)))))
+;;* UNTESTED
(compat-defun directory-empty-p (dir)
"Return t if DIR names an existing directory containing no other files.
Return nil if DIR does not name a directory, or if there was
@@ -536,6 +641,86 @@ See `file-symlink-p' to distinguish symlinks."
(and (file-directory-p dir)
(null (directory-files dir nil directory-files-no-dot-files-regexp t))))
+(compat-defun file-modes-number-to-symbolic (mode &optional filetype)
+ "Return a string describing a file's MODE.
+For instance, if MODE is #o700, then it produces `-rwx------'.
+FILETYPE if provided should be a character denoting the type of file,
+such as `?d' for a directory, or `?l' for a symbolic link and will override
+the leading `-' char."
+ (string
+ (or filetype
+ (pcase (lsh mode -12)
+ ;; POSIX specifies that the file type is included in st_mode
+ ;; and provides names for the file types but values only for
+ ;; the permissions (e.g., S_IWOTH=2).
+
+ ;; (#o017 ??) ;; #define S_IFMT 00170000
+ (#o014 ?s) ;; #define S_IFSOCK 0140000
+ (#o012 ?l) ;; #define S_IFLNK 0120000
+ ;; (8 ??) ;; #define S_IFREG 0100000
+ (#o006 ?b) ;; #define S_IFBLK 0060000
+ (#o004 ?d) ;; #define S_IFDIR 0040000
+ (#o002 ?c) ;; #define S_IFCHR 0020000
+ (#o001 ?p) ;; #define S_IFIFO 0010000
+ (_ ?-)))
+ (if (zerop (logand 256 mode)) ?- ?r)
+ (if (zerop (logand 128 mode)) ?- ?w)
+ (if (zerop (logand 64 mode))
+ (if (zerop (logand 2048 mode)) ?- ?S)
+ (if (zerop (logand 2048 mode)) ?x ?s))
+ (if (zerop (logand 32 mode)) ?- ?r)
+ (if (zerop (logand 16 mode)) ?- ?w)
+ (if (zerop (logand 8 mode))
+ (if (zerop (logand 1024 mode)) ?- ?S)
+ (if (zerop (logand 1024 mode)) ?x ?s))
+ (if (zerop (logand 4 mode)) ?- ?r)
+ (if (zerop (logand 2 mode)) ?- ?w)
+ (if (zerop (logand 512 mode))
+ (if (zerop (logand 1 mode)) ?- ?x)
+ (if (zerop (logand 1 mode)) ?T ?t))))
+
+;;* UNTESTED
+(compat-defun file-backup-file-names (filename)
+ "Return a list of backup files for FILENAME.
+The list will be sorted by modification time so that the most
+recent files are first."
+ ;; `make-backup-file-name' will get us the right directory for
+ ;; ordinary or numeric backups. It might create a directory for
+ ;; backups as a side-effect, according to `backup-directory-alist'.
+ (let* ((filename (file-name-sans-versions
+ (make-backup-file-name (expand-file-name filename))))
+ (dir (file-name-directory filename))
+ files)
+ (dolist (file (file-name-all-completions
+ (file-name-nondirectory filename) dir))
+ (let ((candidate (concat dir file)))
+ (when (and (backup-file-name-p candidate)
+ (string= (file-name-sans-versions candidate) filename))
+ (push candidate files))))
+ (sort files #'file-newer-than-file-p)))
+
+(compat-defun make-lock-file-name (filename)
+ "Make a lock file name for FILENAME.
+This prepends \".#\" to the non-directory part of FILENAME, and
+doesn't respect `lock-file-name-transforms', as Emacs 28.1 and
+onwards does."
+ (expand-file-name
+ (concat
+ ".#" (file-name-nondirectory filename))
+ (file-name-directory filename)))
+
+;;;; Defined in files-x.el
+
+(declare-function tramp-tramp-file-p "tramp" (name))
+
+;;* UNTESTED
+(compat-defun null-device ()
+ "Return the best guess for the null device."
+ (require 'tramp)
+ (if (tramp-tramp-file-p default-directory)
+ "/dev/null"
+ null-device))
+
;;;; Defined in minibuffer.el
(compat-defun format-prompt (prompt default &rest format-args)
@@ -556,7 +741,7 @@ is included in the return value."
(apply #'format prompt format-args))
(and default
(or (not (stringp default))
- (not (null default)))
+ (> (length default) 0))
(format " (default %s)"
(if (consp default)
(car default)
@@ -565,6 +750,7 @@ is included in the return value."
;;;; Defined in windows.el
+;;* UNTESTED
(compat-defun count-windows (&optional minibuf all-frames)
"Handle optional argument ALL-FRAMES:
@@ -582,6 +768,8 @@ just the selected frame."
;;;; Defined in thingatpt.el
(declare-function mouse-set-point "mouse" (event &optional promote-to-region))
+
+;;* UNTESTED
(compat-defun thing-at-mouse (event thing &optional no-properties)
"Return the THING at mouse click.
Like `thing-at-point', but tries to use the event
@@ -593,6 +781,7 @@ where the mouse button is clicked to find a thing nearby."
;;;; Defined in macroexp.el
+;;* UNTESTED
(compat-defun macroexp-file-name ()
"Return the name of the file from which the code comes.
Returns nil when we do not know.
@@ -607,6 +796,7 @@ Other uses risk returning non-nil value that point to the
wrong file."
;;;; Defined in env.el
+;;* UNTESTED
(compat-defmacro with-environment-variables (variables &rest body)
"Set VARIABLES in the environent and execute BODY.
VARIABLES is a list of variable settings of the form (VAR VALUE),
@@ -625,6 +815,7 @@ The previous values will be be restored upon exit."
;;;; Defined in button.el
+;;* UNTESTED
(compat-defun button-buttonize (string callback &optional data)
"Make STRING into a button and return it.
When clicked, CALLBACK will be called with the DATA as the
@@ -643,6 +834,8 @@ itself will be used instead as the function argument."
;;;; Defined in autoload.el
(defvar generated-autoload-file)
+
+;;* UNTESTED
(compat-defun make-directory-autoloads (dir output-file)
"Update autoload definitions for Lisp files in the directories DIRS.
DIR can be either a single directory or a list of
@@ -662,5 +855,25 @@ directory or directories specified."
(apply 'update-directory-autoloads
(if (listp dir) dir (list dir)))))
-(provide 'compat-28.1)
-;;; compat-28.1.el ends here
+;;;; Defined in time-data.el
+
+(compat-defun decoded-time-period (time)
+ "Interpret DECODED as a period and return its length in seconds.
+For computational purposes, years are 365 days long and months
+are 30 days long."
+ :feature 'time-date
+ :version "28"
+ ;; Inlining the definitions from compat-27
+ (+ (if (consp (nth 0 time))
+ ;; Fractional second.
+ (/ (float (car (nth 0 time)))
+ (cdr (nth 0 time)))
+ (or (nth 0 time) 0))
+ (* (or (nth 1 time) 0) 60)
+ (* (or (nth 2 time) 0) 60 60)
+ (* (or (nth 3 time) 0) 60 60 24)
+ (* (or (nth 4 time) 0) 60 60 24 30)
+ (* (or (nth 5 time) 0) 60 60 24 365)))
+
+(compat--inhibit-prefixed (provide 'compat-28))
+;;; compat-28.el ends here
diff --git a/compat-29.1.el b/compat-29.el
similarity index 95%
rename from compat-29.1.el
rename to compat-29.el
index 3ff48f4f3c..57495c193d 100644
--- a/compat-29.1.el
+++ b/compat-29.el
@@ -1,6 +1,6 @@
-;;; compat-29.1.el --- Compatibility Layer for Emacs 29.1 -*-
lexical-binding: t; -*-
+;;; compat-29.el --- Compatibility Layer for Emacs 29.1 -*- lexical-binding:
t; -*-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
+;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Keywords: lisp
@@ -28,7 +28,6 @@
;;; Code:
(eval-when-compile (require 'compat-macs))
-(declare-function compat-maxargs-/= "compat" (func n))
;;;; Defined in xdisp.c
@@ -130,5 +129,5 @@ than this function."
(end (substring string (- (length string) length)))
(t (substring string 0 length)))))
-(provide 'compat-29.1)
-;;; compat-29.1.el ends here
+(provide 'compat-29)
+;;; compat-29.el ends here
diff --git a/compat-font-lock.el b/compat-font-lock.el
new file mode 100644
index 0000000000..66a62e5522
--- /dev/null
+++ b/compat-font-lock.el
@@ -0,0 +1,48 @@
+;;; compat-font-lock.el --- -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Philip Kaludercic <philipk@posteo.net>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Optional font-locking for `compat' definitions. Every symbol with
+;; an active compatibility definition will be highlighted.
+;;
+;; Load this file to enable the functionality.
+
+;;; Code:
+
+(eval-and-compile
+ (require 'cl-lib)
+ (require 'compat-macs))
+
+(defvar compat-generate-common-fn)
+(let ((compat-generate-common-fn
+ (lambda (name _def-fn _install-fn check-fn attr _type)
+ (unless (and (plist-get attr :no-highlight)
+ (funcall check-fn))
+ `(font-lock-add-keywords
+ 'emacs-lisp-mode
+ ',`((,(concat "\\_<\\("
+ (regexp-quote (symbol-name name))
+ "\\)\\_>")
+ 1 font-lock-preprocessor-face prepend)))))))
+ (load "compat"))
+
+(provide 'compat-font-lock)
+;;; compat-font-lock.el ends here
diff --git a/compat-macs.el b/compat-macs.el
index 5cf9e4685d..f661fd1158 100644
--- a/compat-macs.el
+++ b/compat-macs.el
@@ -1,6 +1,6 @@
;;; compat-macs.el --- Compatibility Macros -*- lexical-binding: t;
-*-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
+;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Keywords: lisp
@@ -29,16 +29,29 @@
"Ignore all arguments."
nil)
-(defun compat-generate-common (name def-fn install-fn check-fn attr type)
- "Common code for generating compatibility definitions for NAME.
-The resulting body is constructed by invoking the functions
-DEF-FN (passed the \"realname\" and the version number, returning
-the compatibility definition), the INSTALL-FN (passed the
-\"realname\" and returning the installation code),
-CHECK-FN (passed the \"realname\" and returning a check to see if
-the compatibility definition should be installed). ATTR is a
-plist used to modify the generated code. The following
-attributes are handled, all others are ignored:
+(defvar compat--inhibit-prefixed nil
+ "Non-nil means that prefixed definitions are not loaded.
+A prefixed function is something like `compat-assoc', that is
+only made visible when the respective compatibility version file
+is loaded (in this case `compat-26').")
+
+(defmacro compat--inhibit-prefixed (&rest body)
+ "Ignore BODY unless `compat--inhibit-prefixed' is true."
+ `(unless (bound-and-true-p compat--inhibit-prefixed)
+ ,@body))
+
+(defvar compat--generate-function #'compat--generate-default
+ "Function used to generate compatibility code.
+The function must take six arguments: NAME, DEF-FN, INSTALL-FN,
+CHECK-FN, ATTR and TYPE. The resulting body is constructed by
+invoking the functions DEF-FN (passed the \"realname\" and the
+version number, returning the compatibility definition), the
+INSTALL-FN (passed the \"realname\" and returning the
+installation code), CHECK-FN (passed the \"realname\" and
+returning a check to see if the compatibility definition should
+be installed). ATTR is a plist used to modify the generated
+code. The following attributes are handled, all others are
+ignored:
- :min-version :: Prevent the compatibility definition from begin
installed in versions older than indicated (string).
@@ -52,6 +65,9 @@ attributes are handled, all others are ignored:
- :cond :: Only install the compatibility code, iff the value
evaluates to non-nil.
+ For prefixed functions, this can be interpreted as a test to
+ `defalias' an existing definition or not.
+
- :no-highlight :: Do not highlight this definition as
compatibility function.
@@ -67,55 +83,88 @@ attributes are handled, all others are ignored:
- :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."
+TYPE is used to set the symbol property `compat-type' for NAME.")
+
+(defun compat--generate-default (name def-fn install-fn check-fn attr type)
+ "Generate a leaner compatibility definition.
+See `compat-generate-function' for details on the arguments NAME,
+DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE."
(let* ((min-version (plist-get attr :min-version))
(max-version (plist-get attr :max-version))
(feature (plist-get attr :feature))
(cond (plist-get attr :cond))
- (version (or (plist-get attr :version)
- (let ((file (or (and (boundp 'byte-compile-current-file)
- byte-compile-current-file)
- load-file-name
- (buffer-file-name))))
- ;; Guess the version from the file the macro is
- ;; being defined in.
- (and (string-match
-
"compat-\\([[:digit:]]+\\.[[:digit:]]+\\)\\.\\(?:elc?\\)\\'"
- file)
- (match-string 1 file)))))
+ (version
+ ;; If you edit this, also edit `compat--generate-testable' in
+ ;; `compat-tests.el'.
+ (or (plist-get attr :version)
+ (let* ((file (car (last current-load-list)))
+ (file (if (stringp file)
+ ;; Some library, which requires compat-XY.el,
+ ;; is being compiled and compat-XY.el has not
+ ;; been compiled yet.
+ file
+ ;; compat-XY.el is being compiled.
+ (or (bound-and-true-p byte-compile-current-file)
+ ;; Fallback to the buffer being evaluated.
+ (buffer-file-name)))))
+ (if (and file
+ (string-match
+ "compat-\\([[:digit:]]+\\)\\.\\(?:elc?\\)\\'" file))
+ (concat (match-string 1 file) ".1")
+ (error "BUG: No version number could be extracted")))))
(realname (or (plist-get attr :realname)
(intern (format "compat--%S" name))))
- (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)
- (,@(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)))))
+ (check (cond
+ ((or (and min-version
+ (version< emacs-version min-version))
+ (and max-version
+ (version< max-version emacs-version)))
+ '(compat--ignore))
+ ((plist-get attr :prefix)
+ '(compat--inhibit-prefixed))
+ ((and version (version<= version emacs-version) (not cond))
+ '(compat--ignore))
+ (`(when (and ,(if cond cond t)
+ ,(funcall check-fn)))))))
+ (cond
+ ((and (plist-get attr :prefix) (memq type '(func macro))
+ (string-match "\\`compat-\\(.+\\)\\'" (symbol-name name))
+ (let* ((actual-name (intern (match-string 1 (symbol-name name))))
+ (body (funcall install-fn actual-name version)))
+ (when (and (version<= version emacs-version)
+ (fboundp actual-name))
+ `(,@check
+ ,(if feature
+ ;; See https://nullprogram.com/blog/2018/02/22/:
+ `(eval-after-load ,feature `(funcall ',(lambda ()
,body)))
+ body))))))
+ ((plist-get attr :realname)
+ `(progn
+ ,(funcall def-fn realname version)
+ (,@check
+ ,(let ((body (funcall install-fn realname version)))
+ (if feature
+ ;; See https://nullprogram.com/blog/2018/02/22/:
+ `(eval-after-load ,feature `(funcall ',(lambda () ,body)))
+ body)))))
+ ((let* ((body (if (eq type 'advice)
+ `(,@check
+ ,(funcall def-fn realname version)
+ ,(funcall install-fn realname version))
+ `(,@check ,(funcall def-fn name version)))))
+ (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.
+See `compat-generate-function' for details on the arguments NAME,
+DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE."
+ (when (and (plist-get attr :cond) (plist-get attr :prefix))
+ (error "A prefixed function %s cannot have a condition" name))
+ (funcall compat--generate-function
+ name def-fn install-fn check-fn attr type))
(defun compat-common-fdefine (type name arglist docstring rest)
"Generate compatibility code for a function NAME.
@@ -130,7 +179,7 @@ attributes (see `compat-generate-common')."
;; It might be possible to set these properties otherwise. That
;; should be looked into and implemented if it is the case.
(when (and (listp (car-safe body)) (eq (caar body) 'declare))
- (when (version<= "25" emacs-version)
+ (when (version<= emacs-version "25")
(delq (assq 'side-effect-free (car body)) (car body))
(delq (assq 'pure (car body)) (car body))))
;; Check if we want an explicitly prefixed function
diff --git a/compat-tests.el b/compat-tests.el
index ac2c5e411e..5983e92017 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1,6 +1,6 @@
;;; compat-tests.el --- Tests for compat.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
+;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Package-Requires: ((emacs "28.1"))
@@ -33,306 +33,359 @@
;;; Code:
(require 'ert)
-(require 'compat)
-
-(defvar compat--current-fn nil)
-(defvar compat--compat-fn nil)
-
-(defmacro compat--should (result &rest input)
- "Generate code for test with INPUT evaluating to RESULT."
- (let ((cfn (or compat--compat-fn
- (intern (format "compat--%s" compat--current-fn))))
- (rfn compat--current-fn))
- (macroexp-progn
- (list
- `(should (equal (,cfn ,@input) ,result))
- (and (fboundp rfn)
- `(should (equal (,rfn ,@input) ,result)))))))
-
-(defmacro compat--should* (result &rest input)
- "Generate code for test with INPUT evaluating to RESULT."
- (let ((cfn (or compat--compat-fn
- (intern (format "compat--%s" compat--current-fn))))
- (rfn compat--current-fn))
- (macroexp-progn
- (list
- `(should (equal (funcall (apply-partially #',cfn #',rfn) ,@input)
,result))
- (and (and (fboundp rfn)
- (or (not (eq (get cfn 'compat-type) 'advice))
- (not (get cfn 'compat-version))
- (version<= (get cfn 'compat-version) emacs-version)))
- `(should (equal (,rfn ,@input) ,result)))))))
-
-(defmacro compat--mshould (result &rest input)
- "Generate code for test with INPUT evaluating to RESULT."
- (let ((cfn (or compat--compat-fn
- (intern (format "compat--%s" compat--current-fn))))
- (rfn compat--current-fn))
- (macroexp-progn
- (list
- `(should (equal (macroexpand-all `(,',cfn ,,@input)) ,result))
- (and (fboundp rfn)
- `(should (equal (macroexpand-all `(,',rfn ,,@input)) ,result)))))))
-
-(defmacro compat--error (error &rest input)
- "Generate code for test FN with INPUT to signal ERROR."
- (let ((cfn (or compat--compat-fn
- (intern (format "compat--%s" compat--current-fn))))
- (rfn compat--current-fn))
- (macroexp-progn
- (list
- `(should-error (,cfn ,@input) :type ',error)
- (and (fboundp rfn)
- `(should-error (,rfn ,@input) :type ',error))))))
-
-(defmacro compat--error* (error &rest input)
- "Generate code for test FN with INPUT to signal ERROR."
- (let ((cfn (or compat--compat-fn
- (intern (format "compat--%s" compat--current-fn))))
- (rfn compat--current-fn))
- (macroexp-progn
- (list
- `(should-error (funcall (apply-partially #',cfn #',rfn) ,@input) :type
',error)
- (and (and (fboundp rfn)
- (or (not (eq (get cfn 'compat-type) 'advice))
- (not (get cfn 'compat-version))
- (version<= (get cfn 'compat-version) emacs-version)))
- `(should-error (,rfn ,@input) :type ',error))))))
-
-;; FIXME: extract the name of the test out of the ERT-test, instead
-;; of having to re-declare the name of the test redundantly.
-(defmacro compat-test (fn &rest body)
- "Set `compat--current-fn' to FN in BODY.
-If FN is a list, the car should be the actual function, and cadr
-the compatibility function."
- (declare (indent 1))
- (if (consp fn)
- (setq compat--current-fn (if (symbolp (car fn))
- (car fn)
- ;; Handle expressions
- (eval (car fn) t))
- compat--compat-fn (if (symbolp (cadr fn))
- (cadr fn)
- ;; Handle expressions
- (eval (cadr fn) t)))
- (setq compat--current-fn fn
- compat--compat-fn nil))
- (macroexp-progn body))
+
+(require 'compat-macs)
+
+(defun compat--generate-testable (name def-fn install-fn check-fn attr type)
+ "Generate a more verbose compatibility definition, fit for testing.
+See `compat-generate-function' for details on the arguments NAME,
+DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE."
+ (let* ((min-version (plist-get attr :min-version))
+ (max-version (plist-get attr :max-version))
+ (feature (plist-get attr :feature))
+ (cond (plist-get attr :cond))
+ (version
+ ;; If you edit this, also edit `compat--generate-default' in
+ ;; compat-macs.el.
+ (or (plist-get attr :version)
+ (let* ((file (car (last current-load-list)))
+ (file (if (stringp file)
+ file
+ (or (bound-and-true-p byte-compile-current-file)
+ (buffer-file-name)))))
+ (if (and file
+ (string-match
+ "compat-\\([[:digit:]]+\\)\\.\\(?:elc?\\)\\'" file))
+ (concat (match-string 1 file) ".1")
+ (error "BUG: No version number could be extracted")))))
+ (realname (or (plist-get attr :realname)
+ (intern (format "compat--%S" name))))
+ (body `(progn
+ (unless (or (null (get ',name 'compat-def))
+ (eq (get ',name 'compat-def) ',realname))
+ (error "Duplicate compatibility definition: %s (was %s,
now %s)"
+ ',name (get ',name 'compat-def) ',realname))
+ (put ',name 'compat-def ',realname)
+ ,(funcall install-fn realname version))))
+ `(progn
+ (put ',realname 'compat-type ',type)
+ (put ',realname 'compat-version ,version)
+ (put ',realname 'compat-min-version ,min-version)
+ (put ',realname 'compat-max-version ,max-version)
+ (put ',realname 'compat-doc ,(plist-get attr :note))
+ ,(funcall def-fn realname version)
+ (,@(cond
+ ((or (and min-version
+ (version< emacs-version min-version))
+ (and max-version
+ (version< max-version emacs-version)))
+ '(compat--ignore))
+ ((plist-get attr :prefix)
+ '(compat--inhibit-prefixed))
+ ((and version (version<= version emacs-version) (not cond))
+ '(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)))))
+
+(setq compat--generate-function #'compat--generate-testable)
+
+(defvar compat-testing)
+(let ((compat-testing t))
+ (load "compat.el"))
+
+(defvar compat-test-counter)
+
+(defun compat--ought (name compat)
+ "Implementation for the `ought' macro for NAME.
+COMPAT is the name of the compatibility function the behaviour is
+being compared against."
+ (lambda (result &rest args)
+ (let ((real-test (intern (format "%s-%04d-actual/ought" compat
compat-test-counter)))
+ (comp-test (intern (format "%s-%04d-compat/ought" compat
compat-test-counter))))
+ (setq compat-test-counter (1+ compat-test-counter))
+ (macroexp-progn
+ (list (and (fboundp name)
+ (or (not (get compat 'compat-version))
+ (version<= emacs-version (get compat 'compat-version)))
+ `(ert-set-test
+ ',real-test
+ (make-ert-test
+ :name ',real-test
+ :tags '(,name)
+ :body (lambda () (should (equal ,result (,name
,@args)))))))
+ (and (fboundp compat)
+ `(ert-set-test
+ ',comp-test
+ (make-ert-test
+ :name ',comp-test
+ :tags '(,name)
+ :body (lambda () (should (equal ,result (,compat
,@args))))))))))))
+
+(defun compat--expect (name compat)
+ "Implementation for the `expect' macro for NAME.
+COMPAT is the name of the compatibility function the behaviour is
+being compared against."
+ (lambda (error-spec &rest args)
+ (let ((real-test (intern (format "%s-%04d-actual/expect" compat
compat-test-counter)))
+ (comp-test (intern (format "%s-%04d-compat/expect" compat
compat-test-counter)))
+ (error-type (if (consp error-spec) (car error-spec) error-spec)))
+ (setq compat-test-counter (1+ compat-test-counter))
+ (macroexp-progn
+ (list (and (fboundp name)
+ (or (not (get compat 'compat-version))
+ (version<= emacs-version (get compat 'compat-version)))
+ `(ert-set-test
+ ',real-test
+ (make-ert-test
+ :name ',real-test
+ :tags '(,name)
+ :body (lambda ()
+ (should
+ (let ((res (should-error (,name ,@args) :type
',error-type)))
+ (should
+ ,(if (consp error-spec)
+ `(equal res ',error-spec)
+ `(eq (car res) ',error-spec)))))))))
+ (and (fboundp compat)
+ `(ert-set-test
+ ',comp-test
+ (make-ert-test
+ :name ',comp-test
+ :tags '(,name)
+ :body (lambda ()
+ (should
+ (let ((res (should-error (,name ,@args) :type
',error-type)))
+ (should
+ ,(if (consp error-spec)
+ `(equal res ',error-spec)
+ `(eq (car res) ',error-spec))))))))))))))
+
+(defmacro compat-deftests (name &rest body)
+ "Test NAME in BODY."
+ (declare (debug (sexp &rest body))
+ (indent 1))
+ (let* ((compat-test-counter 0)
+ (real-name (if (consp name) (car name) name))
+ (compat-name (if (consp name)
+ (cadr name)
+ (intern (format "compat--%s" real-name))))
+ (env (list
+ (cons 'ought (compat--ought real-name compat-name))
+ (cons 'expect (compat--expect real-name compat-name)))))
+ (and (or (not (get compat-name 'compat-min-version))
+ (version< (get compat-name 'compat-min-version) emacs-version))
+ (or (not (get compat-name 'compat-max-version))
+ (version< emacs-version (get compat-name 'compat-max-version)))
+ (macroexpand-all
+ (macroexp-progn body)
+ (append env macroexpand-all-environment)))))
-(ert-deftest compat-string-search ()
- "Check if `compat--string-search' was implemented correctly."
- (compat-test string-search
- ;; Find needle at the beginning of a haystack:
- (compat--should 0 "a" "abb")
- ;; Find needle at the begining of a haystack, with more potential
- ;; needles that could be found:
- (compat--should 0 "a" "abba")
- ;; Find needle with more than one charachter at the beginning of
- ;; a line:
- (compat--should 0 "aa" "aabbb")
- ;; Find a needle midstring:
- (compat--should 1 "a" "bab")
- ;; Find a needle at the end:
- (compat--should 2 "a" "bba")
- ;; Find a longer needle midstring:
- (compat--should 1 "aa" "baab")
- ;; Find a longer needle at the end:
- (compat--should 2 "aa" "bbaa")
- ;; Find a case-sensitive needle:
- (compat--should 2 "a" "AAa")
- ;; Find another case-sensitive needle:
- (compat--should 2 "aa" "AAaa")
- ;; Test regular expression quoting (1):
- (compat--should 5 "." "abbbb.b")
- ;; Test regular expression quoting (2):
- (compat--should 5 ".*" "abbbb.*b")
- ;; Attempt to find non-existent needle:
- (compat--should nil "a" "bbb")
- ;; Attempt to find non-existent needle that has the form of a
- ;; regular expression:
- (compat--should nil "." "bbb")
- ;; Handle empty string as needle:
- (compat--should 0 "" "abc")
- ;; Handle empty string as haystack:
- (compat--should nil "a" "")
- ;; Handle empty string as needle and haystack:
- (compat--should 0 "" "")
- ;; Handle START argument:
- (compat--should 3 "a" "abba" 1)
- ;; Additional test copied from:
- (compat--should 6 "zot" "foobarzot")
- (compat--should 0 "foo" "foobarzot")
- (compat--should nil "fooz" "foobarzot")
- (compat--should nil "zot" "foobarzo")
- (compat--should 0 "ab" "ab")
- (compat--should nil "ab\0" "ab")
- (compat--should 4 "ab" "abababab" 3)
- (compat--should nil "ab" "ababac" 3)
- (compat--should nil "aaa" "aa")
- ;; The `make-string' calls with three arguments have been replaced
- ;; here with the result of their evaluation, to avoid issues with
- ;; older versions of Emacs that only support two arguments.
- (compat--should 5
- (make-string 2 130)
- ;; Per (concat "helló" (make-string 5 130 t) "bár")
- "hellóbár")
- (compat--should 5
- (make-string 2 127)
- ;; Per (concat "helló" (make-string 5 127 t) "bár")
- "hellóbár")
- (compat--should 1 "\377" "a\377ø")
- (compat--should 1 "\377" "a\377a")
- (compat--should nil (make-string 1 255) "a\377ø")
- (compat--should nil (make-string 1 255) "a\377a")
- (compat--should 3 "fóo" "zotfóo")
- (compat--should nil "\303" "aøb")
- (compat--should nil "\270" "aøb")
- (compat--should nil "ø" "\303\270")
- (compat--should nil "ø" (make-string 32 ?a))
- (compat--should nil "ø" (string-to-multibyte (make-string 32 ?a)))
- (compat--should 14 "o" (string-to-multibyte
- (apply #'string (number-sequence ?a ?z))))
- (compat--should 2 "a\U00010f98z" "a\U00010f98a\U00010f98z")
- (compat--error (args-out-of-range -1) "a" "abc" -1)
- (compat--error (args-out-of-range 4) "a" "abc" 4)
- (compat--error (args-out-of-range 100000000000)
- "a" "abc" 100000000000)
- (compat--should nil "a" "aaa" 3)
- (compat--should nil "aa" "aa" 1)
- (compat--should nil "\0" "")
- (compat--should 0 "" "")
- (compat--error (args-out-of-range 1) "" "" 1)
- (compat--should 0 "" "abc")
- (compat--should 2 "" "abc" 2)
- (compat--should 3 "" "abc" 3)
- (compat--error (args-out-of-range 4) "" "abc" 4)
- (compat--error (args-out-of-range -1) "" "abc" -1)
- (compat--should nil "ø" "foo\303\270")
- (compat--should nil "\303\270" "ø")
- (compat--should nil "\370" "ø")
- (compat--should nil (string-to-multibyte "\370") "ø")
- (compat--should nil "ø" "\370")
- (compat--should nil "ø" (string-to-multibyte "\370"))
- (compat--should nil "\303\270" "\370")
- (compat--should nil (string-to-multibyte "\303\270") "\370")
- (compat--should nil "\303\270" (string-to-multibyte "\370"))
- (compat--should nil
- (string-to-multibyte "\303\270")
- (string-to-multibyte "\370"))
- (compat--should nil "\370" "\303\270")
- (compat--should nil (string-to-multibyte "\370") "\303\270")
- (compat--should nil "\370" (string-to-multibyte "\303\270"))
- (compat--should nil
- (string-to-multibyte "\370")
- (string-to-multibyte "\303\270"))
- (compat--should 3 "\303\270" "foo\303\270")
- (when (version<= "27" emacs-version)
- ;; FIXME The commit a1f76adfb03c23bb4242928e8efe6193c301f0c1 in
- ;; emacs.git fixes the behaviour of regular expressions matching
- ;; raw bytes. The compatibility functions should updated to
- ;; backport this behaviour.
- (compat--should 2 (string-to-multibyte "\377") "ab\377c")
- (compat--should 2
- (string-to-multibyte "o\303\270")
- "foo\303\270"))))
-
-(ert-deftest compat-string-replace ()
- "Check if `compat--string-replace' was implemented correctly."
- (compat-test string-replace
- (compat--should "bba" "aa" "bb" "aaa")
- (compat--should "AAA" "aa" "bb" "AAA")
- ;; Additional test copied from subr-tests.el:
- (compat--should "zot" "foo" "bar" "zot")
- (compat--should "barzot" "foo" "bar" "foozot")
- (compat--should "barbarzot" "foo" "bar" "barfoozot")
- (compat--should "barfoobar" "zot" "bar" "barfoozot")
- (compat--should "barfoobarot" "z" "bar" "barfoozot")
- (compat--should "zat" "zot" "bar" "zat")
- (compat--should "zat" "azot" "bar" "zat")
- (compat--should "bar" "azot" "bar" "azot")
- (compat--should "foozotbar" "azot" "bar" "foozotbar")
- (compat--should "labarbarbarzot" "fo" "bar" "lafofofozot")
- (compat--should "axb" "\377" "x" "a\377b")
- (compat--should "axø" "\377" "x" "a\377ø")
- (when (version<= "27" emacs-version)
- ;; FIXME The commit a1f76adfb03c23bb4242928e8efe6193c301f0c1
- ;; in emacs.git fixes the behaviour of regular
- ;; expressions matching raw bytes. The compatibility
- ;; functions should updated to backport this
- ;; behaviour.
- (compat--should "axb" (string-to-multibyte "\377") "x" "a\377b")
- (compat--should "axø" (string-to-multibyte "\377") "x" "a\377ø"))
- (compat--should "ANAnas" "ana" "ANA" "ananas")
- (compat--should "" "a" "" "")
- (compat--should "" "a" "" "aaaaa")
- (compat--should "" "ab" "" "ababab")
- (compat--should "ccc" "ab" "" "abcabcabc")
- (compat--should "aaaaaa" "a" "aa" "aaa")
- (compat--should "defg" "abc" "defg" "abc")
- (when (version<= "24.4" emacs-version)
- ;; FIXME: Emacs 24.3 do not know of `wrong-length-argument' and
- ;; therefore fail this test, even if the right symbol is being
- ;; thrown.
- (compat--error wrong-length-argument "" "x" "abc"))))
-
-(ert-deftest compat-length= ()
- "Check if `compat--string-length=' was implemented correctly."
- (compat-test length=
- (compat--should t '() 0) ;empty list
- (compat--should t '(1) 1) ;single element
- (compat--should t '(1 2 3) 3) ;multiple elements
- (compat--should nil '(1 2 3) 2) ;less than
- (compat--should nil '(1) 0)
- (compat--should nil '(1 2 3) 4) ;more than
- (compat--should nil '(1) 2)
- (compat--should nil '() 1)
- (compat--should t [] 0) ;empty vector
- (compat--should t [1] 1) ;single element vector
- (compat--should t [1 2 3] 3) ;multiple element vector
- (compat--should nil [1 2 3] 2) ;less than
- (compat--should nil [1 2 3] 4) ;more than
- (compat--error wrong-type-argument 3 nil)))
-
-(ert-deftest compat-length< ()
- "Check if `compat--length<' was implemented correctly."
- (compat-test length<
- (compat--should nil '(1) 0) ;single element
- (compat--should nil '(1 2 3) 2) ;multiple elements
- (compat--should nil '(1 2 3) 3) ;equal length
- (compat--should nil '(1) 1)
- (compat--should t '(1 2 3) 4) ;more than
- (compat--should t '(1) 2)
- (compat--should t '() 1)
- (compat--should nil [1] 0) ;single element vector
- (compat--should nil [1 2 3] 2) ;multiple element vector
- (compat--should nil [1 2 3] 3) ;equal length
- (compat--should t [1 2 3] 4) ;more than
- (compat--error wrong-type-argument 3 nil)))
-
-(ert-deftest compat-length> ()
- "Check if `compat--length>' was implemented correctly."
- (compat-test length>
- (compat--should t '(1) 0) ;single element
- (compat--should t '(1 2 3) 2) ;multiple elements
- (compat--should nil '(1 2 3) 3) ;equal length
- (compat--should nil '(1) 1)
- (compat--should nil '(1 2 3) 4) ;more than
- (compat--should nil '(1) 2)
- (compat--should nil '() 1)
- (compat--should t [1] 0) ;single element vector
- (compat--should t [1 2 3] 2) ;multiple element vector
- (compat--should nil [1 2 3] 3) ;equal length
- (compat--should nil [1 2 3] 4) ;more than
- (compat--error wrong-type-argument 3 nil)))
-
-(ert-deftest compat-always ()
- "Check if `compat--always' was implemented correctly."
- (compat-test always
- (compat--should t) ;no arguments
- (compat--should t 1) ;single argument
- (compat--should t 1 2 3 4))) ;multiple arguments
+(compat-deftests string-search
+ ;; Find needle at the beginning of a haystack:
+ (ought 0 "a" "abb")
+ ;; Find needle at the begining of a haystack, with more potential
+ ;; needles that could be found:
+ (ought 0 "a" "abba")
+ ;; Find needle with more than one charachter at the beginning of
+ ;; a line:
+ (ought 0 "aa" "aabbb")
+ ;; Find a needle midstring:
+ (ought 1 "a" "bab")
+ ;; Find a needle at the end:
+ (ought 2 "a" "bba")
+ ;; Find a longer needle midstring:
+ (ought 1 "aa" "baab")
+ ;; Find a longer needle at the end:
+ (ought 2 "aa" "bbaa")
+ ;; Find a case-sensitive needle:
+ (ought 2 "a" "AAa")
+ ;; Find another case-sensitive needle:
+ (ought 2 "aa" "AAaa")
+ ;; Test regular expression quoting (1):
+ (ought 5 "." "abbbb.b")
+ ;; Test regular expression quoting (2):
+ (ought 5 ".*" "abbbb.*b")
+ ;; Attempt to find non-existent needle:
+ (ought nil "a" "bbb")
+ ;; Attempt to find non-existent needle that has the form of a
+ ;; regular expression:
+ (ought nil "." "bbb")
+ ;; Handle empty string as needle:
+ (ought 0 "" "abc")
+ ;; Handle empty string as haystack:
+ (ought nil "a" "")
+ ;; Handle empty string as needle and haystack:
+ (ought 0 "" "")
+ ;; Handle START argument:
+ (ought 3 "a" "abba" 1)
+ ;; Additional test copied from:
+ (ought 6 "zot" "foobarzot")
+ (ought 0 "foo" "foobarzot")
+ (ought nil "fooz" "foobarzot")
+ (ought nil "zot" "foobarzo")
+ (ought 0 "ab" "ab")
+ (ought nil "ab\0" "ab")
+ (ought 4 "ab" "abababab" 3)
+ (ought nil "ab" "ababac" 3)
+ (ought nil "aaa" "aa")
+ ;; The `make-string' calls with three arguments have been replaced
+ ;; here with the result of their evaluation, to avoid issues with
+ ;; older versions of Emacs that only support two arguments.
+ (ought 5
+ (make-string 2 130)
+ ;; Per (concat "helló" (make-string 5 130 t) "bár")
+ "hellóbár")
+ (ought 5
+ (make-string 2 127)
+ ;; Per (concat "helló" (make-string 5 127 t) "bár")
+ "hellóbár")
+ (ought 1 "\377" "a\377ø")
+ (ought 1 "\377" "a\377a")
+ (ought nil (make-string 1 255) "a\377ø")
+ (ought nil (make-string 1 255) "a\377a")
+ (ought 3 "fóo" "zotfóo")
+ (ought nil "\303" "aøb")
+ (ought nil "\270" "aøb")
+ (ought nil "ø" "\303\270")
+ (ought nil "ø" (make-string 32 ?a))
+ (ought nil "ø" (string-to-multibyte (make-string 32 ?a)))
+ (ought 14 "o" (string-to-multibyte
+ (apply #'string (number-sequence ?a ?z))))
+ (ought 2 "a\U00010f98z" "a\U00010f98a\U00010f98z")
+ (expect (args-out-of-range -1) "a" "abc" -1)
+ (expect (args-out-of-range 4) "a" "abc" 4)
+ (expect (args-out-of-range 100000000000)
+ "a" "abc" 100000000000)
+ (ought nil "a" "aaa" 3)
+ (ought nil "aa" "aa" 1)
+ (ought nil "\0" "")
+ (ought 0 "" "")
+ (expect (args-out-of-range 1) "" "" 1)
+ (ought 0 "" "abc")
+ (ought 2 "" "abc" 2)
+ (ought 3 "" "abc" 3)
+ (expect (args-out-of-range 4) "" "abc" 4)
+ (expect (args-out-of-range -1) "" "abc" -1)
+ (ought nil "ø" "foo\303\270")
+ (ought nil "\303\270" "ø")
+ (ought nil "\370" "ø")
+ (ought nil (string-to-multibyte "\370") "ø")
+ (ought nil "ø" "\370")
+ (ought nil "ø" (string-to-multibyte "\370"))
+ (ought nil "\303\270" "\370")
+ (ought nil (string-to-multibyte "\303\270") "\370")
+ (ought nil "\303\270" (string-to-multibyte "\370"))
+ (ought nil
+ (string-to-multibyte "\303\270")
+ (string-to-multibyte "\370"))
+ (ought nil "\370" "\303\270")
+ (ought nil (string-to-multibyte "\370") "\303\270")
+ (ought nil "\370" (string-to-multibyte "\303\270"))
+ (ought nil
+ (string-to-multibyte "\370")
+ (string-to-multibyte "\303\270"))
+ (ought 3 "\303\270" "foo\303\270")
+ (when (version<= "27" emacs-version)
+ ;; FIXME The commit a1f76adfb03c23bb4242928e8efe6193c301f0c1 in
+ ;; emacs.git fixes the behaviour of regular expressions matching
+ ;; raw bytes. The compatibility functions should updated to
+ ;; backport this behaviour.
+ (ought 2 (string-to-multibyte "\377") "ab\377c")
+ (ought 2
+ (string-to-multibyte "o\303\270")
+ "foo\303\270")))
+
+(compat-deftests string-replace
+ (ought "bba" "aa" "bb" "aaa")
+ (ought "AAA" "aa" "bb" "AAA")
+ ;; Additional test copied from subr-tests.el:
+ (ought "zot" "foo" "bar" "zot")
+ (ought "barzot" "foo" "bar" "foozot")
+ (ought "barbarzot" "foo" "bar" "barfoozot")
+ (ought "barfoobar" "zot" "bar" "barfoozot")
+ (ought "barfoobarot" "z" "bar" "barfoozot")
+ (ought "zat" "zot" "bar" "zat")
+ (ought "zat" "azot" "bar" "zat")
+ (ought "bar" "azot" "bar" "azot")
+ (ought "foozotbar" "azot" "bar" "foozotbar")
+ (ought "labarbarbarzot" "fo" "bar" "lafofofozot")
+ (ought "axb" "\377" "x" "a\377b")
+ (ought "axø" "\377" "x" "a\377ø")
+ (when (version<= "27" emacs-version)
+ ;; FIXME The commit a1f76adfb03c23bb4242928e8efe6193c301f0c1
+ ;; in emacs.git fixes the behaviour of regular
+ ;; expressions matching raw bytes. The compatibility
+ ;; functions should updated to backport this
+ ;; behaviour.
+ (ought "axb" (string-to-multibyte "\377") "x" "a\377b")
+ (ought "axø" (string-to-multibyte "\377") "x" "a\377ø"))
+ (ought "ANAnas" "ana" "ANA" "ananas")
+ (ought "" "a" "" "")
+ (ought "" "a" "" "aaaaa")
+ (ought "" "ab" "" "ababab")
+ (ought "ccc" "ab" "" "abcabcabc")
+ (ought "aaaaaa" "a" "aa" "aaa")
+ (ought "defg" "abc" "defg" "abc")
+ (when (version<= "24.4" emacs-version)
+ ;; FIXME: Emacs 24.3 do not know of `wrong-length-argument' and
+ ;; therefore fail this test, even if the right symbol is being
+ ;; thrown.
+ (expect wrong-length-argument "" "x" "abc")))
+
+(compat-deftests length=
+ (ought t '() 0) ;empty list
+ (ought t '(1) 1) ;single element
+ (ought t '(1 2 3) 3) ;multiple elements
+ (ought nil '(1 2 3) 2) ;less than
+ (ought nil '(1) 0)
+ (ought nil '(1 2 3) 4) ;more than
+ (ought nil '(1) 2)
+ (ought nil '() 1)
+ (ought t [] 0) ;empty vector
+ (ought t [1] 1) ;single element vector
+ (ought t [1 2 3] 3) ;multiple element vector
+ (ought nil [1 2 3] 2) ;less than
+ (ought nil [1 2 3] 4) ;more than
+ (expect wrong-type-argument 3 nil))
+
+(compat-deftests length<
+ (ought nil '(1) 0) ;single element
+ (ought nil '(1 2 3) 2) ;multiple elements
+ (ought nil '(1 2 3) 3) ;equal length
+ (ought nil '(1) 1)
+ (ought t '(1 2 3) 4) ;more than
+ (ought t '(1) 2)
+ (ought t '() 1)
+ (ought nil [1] 0) ;single element vector
+ (ought nil [1 2 3] 2) ;multiple element vector
+ (ought nil [1 2 3] 3) ;equal length
+ (ought t [1 2 3] 4) ;more than
+ (expect wrong-type-argument 3 nil))
+
+(compat-deftests length>
+ (ought t '(1) 0) ;single element
+ (ought t '(1 2 3) 2) ;multiple elements
+ (ought nil '(1 2 3) 3) ;equal length
+ (ought nil '(1) 1)
+ (ought nil '(1 2 3) 4) ;more than
+ (ought nil '(1) 2)
+ (ought nil '() 1)
+ (ought t [1] 0) ;single element vector
+ (ought t [1 2 3] 2) ;multiple element vector
+ (ought nil [1 2 3] 3) ;equal length
+ (ought nil [1 2 3] 4) ;more than
+ (expect wrong-type-argument 3 nil))
+
+(compat-deftests always
+ (ought t) ;no arguments
+ (ought t 1) ;single argument
+ (ought t 1 2 3 4)) ;multiple arguments
(ert-deftest compat-insert-into-buffer ()
"Check if `insert-into-buffer' was implemented correctly."
@@ -385,138 +438,120 @@ the compatibility function."
(insert-into-buffer other 2 3))
(should (string= (buffer-string) "abce"))))))
-(ert-deftest compat-file-name-with-extension ()
- "Check if `compat--file-name-with-extension' was implemented correctly."
- (compat-test file-name-with-extension
- (compat--should "file.ext" "file" "ext")
- (compat--should "file.ext" "file" ".ext")
- (compat--should "file.ext" "file." ".ext")
- (compat--should "file..ext" "file.." ".ext")
- (compat--should "file..ext" "file." "..ext")
- (compat--should "file...ext" "file.." "..ext")
- (compat--should "/abs/file.ext" "/abs/file" "ext")
- (compat--should "/abs/file.ext" "/abs/file" ".ext")
- (compat--should "/abs/file.ext" "/abs/file." ".ext")
- (compat--should "/abs/file..ext" "/abs/file.." ".ext")
- (compat--should "/abs/file..ext" "/abs/file." "..ext")
- (compat--should "/abs/file...ext" "/abs/file.." "..ext")
- (compat--error error "file" "")
- (compat--error error "" "ext")
- (compat--error error "file" "")
- (compat--error error "rel/" "ext")
- (compat--error error "/abs/" "ext")))
-
-(ert-deftest compat-string-width ()
- "Check if `compat--string-width' was implemented correctly."
- (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."
- (compat-test ensure-list
- (compat--should nil nil) ;empty list
- (compat--should '(1) '(1)) ;single element list
- (compat--should '(1 2 3) '(1 2 3)) ;multiple element list
- (compat--should '(1) 1))) ;atom
-
-(ert-deftest compat-proper-list-p-1 ()
- "Check if `compat--proper-list-p' was implemented correctly (>=26.1)."
- (unless (version< emacs-version "26")
- (compat-test (proper-list-p compat--proper-list-p-length-signal)
- (compat--should 0 ()) ;empty list
- (compat--should 1 '(1)) ;single element
- (compat--should 3 '(1 2 3)) ;multiple elements
- (compat--should nil '(1 . 2)) ;cons
- (compat--should nil '(1 2 . 3)) ;dotted
- (compat--should nil (let ((l (list 1 2 3))) ;circular
- (setf (nthcdr 3 l) l)
- l))
- (compat--should nil 1) ;non-lists
- (compat--should nil "")
- (compat--should nil "abc")
- (compat--should nil [])
- (compat--should nil [1 2 3]))))
-
-(ert-deftest compat-proper-list-p-2 ()
- "Check if `compat--proper-list-p' was implemented correctly (<25.3)."
- (compat-test (proper-list-p compat--proper-list-p-tortoise-hare)
- (compat--should 0 ()) ;empty list
- (compat--should 1 '(1)) ;single element
- (compat--should 3 '(1 2 3)) ;multiple elements
- (compat--should nil '(1 . 2)) ;cons
- (compat--should nil '(1 2 . 3)) ;dotted
- (compat--should nil (let ((l (list 1 2 3))) ;circular
- (setf (nthcdr 3 l) l)
- l))
- (compat--should nil 1) ;non-lists
- (compat--should nil "")
- (compat--should nil "abc")
- (compat--should nil [])
- (compat--should nil [1 2 3])))
-
-
-(ert-deftest compat-flatten-tree ()
- "Check if `compat--flatten-tree' was implemented correctly."
- (compat-test flatten-tree
- ;; Example from docstring:
- (compat--should '(1 2 3 4 5 6 7) '(1 (2 . 3) nil (4 5 (6)) 7))
- ;; Trivial example
- (compat--should nil ())
- ;; Simple examples
- (compat--should '(1) '(1))
- (compat--should '(1 2) '(1 2))
- (compat--should '(1 2 3) '(1 2 3))
- ;; Regular sublists
- (compat--should '(1) '((1)))
- (compat--should '(1 2) '((1) (2)))
- (compat--should '(1 2 3) '((1) (2) (3)))
- ;; Complex examples
- (compat--should '(1) '(((((1))))))
- (compat--should '(1 2 3 4) '((1) nil 2 ((3 4))))
- (compat--should '(1 2 3 4) '(((1 nil)) 2 (((3 nil nil) 4))))))
-
-(ert-deftest compat-xor ()
- "Check if `compat--xor' was implemented correctly."
- (compat-test xor
- (compat--should t t nil)
- (compat--should t nil t)
- (compat--should nil nil nil)
- (compat--should nil t t)))
-
-(ert-deftest compat-string-distance ()
- "Check if `compat--string-distance' was implemented correctly."
- (compat-test string-distance
- (compat--should 3 "kitten" "sitting") ;from wikipedia
- (if (version<= "28" emacs-version) ;trivial examples
- (compat--should 0 "" "")
- ;; Up until Emacs 28, `string-distance' had a bug
- ;; when comparing two empty strings. This was fixed
- ;; in the following commit:
- ;; https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=c44190c
- ;;
- ;; Therefore, we must make sure, that the test
- ;; doesn't fail because of this bug:
- (should (= (compat--string-distance "" "") 0)))
- (compat--should 0 "a" "a")
- (compat--should 1 "" "a")
- (compat--should 1 "b" "a")
- (compat--should 2 "aa" "bb")
- (compat--should 2 "aa" "bba")
- (compat--should 2 "aaa" "bba")
- (compat--should 3 "a" "あ" t) ;byte example
- (compat--should 1 "a" "あ")))
+(compat-deftests file-name-with-extension
+ (ought "file.ext" "file" "ext")
+ (ought "file.ext" "file" ".ext")
+ (ought "file.ext" "file." ".ext")
+ (ought "file..ext" "file.." ".ext")
+ (ought "file..ext" "file." "..ext")
+ (ought "file...ext" "file.." "..ext")
+ (ought "/abs/file.ext" "/abs/file" "ext")
+ (ought "/abs/file.ext" "/abs/file" ".ext")
+ (ought "/abs/file.ext" "/abs/file." ".ext")
+ (ought "/abs/file..ext" "/abs/file.." ".ext")
+ (ought "/abs/file..ext" "/abs/file." "..ext")
+ (ought "/abs/file...ext" "/abs/file.." "..ext")
+ (expect error "file" "")
+ (expect error "" "ext")
+ (expect error "file" "")
+ (expect error "rel/" "ext")
+ (expect error "/abs/" "ext"))
+
+(compat-deftests compat-string-width
+ (ought 0 "")
+ (ought 3 "abc") ;no argument
+ (ought 5 "abcあ")
+ (ought (1+ tab-width) "a ")
+ (ought 2 "abc" 1) ;with from
+ (ought 4 "abcあ" 1)
+ (ought tab-width "a " 1)
+ (ought 2 "abc" 0 2) ;with to
+ (ought 3 "abcあ" 0 3)
+ (ought 1 "a " 0 1)
+ (ought 1 "abc" 1 2) ;with from and to
+ (ought 2 "abcあ" 3 4)
+ (ought 0 "a " 1 1))
+
+(compat-deftests ensure-list
+ (ought nil nil) ;empty list
+ (ought '(1) '(1)) ;single element list
+ (ought '(1 2 3) '(1 2 3)) ;multiple element list
+ (ought '(1) 1)) ;atom
+
+(compat-deftests (proper-list-p compat--proper-list-p-length-signal)
+ (ought 0 ()) ;empty list
+ (ought 1 '(1)) ;single element
+ (ought 3 '(1 2 3)) ;multiple elements
+ (ought nil '(1 . 2)) ;cons
+ (ought nil '(1 2 . 3)) ;dotted
+ (ought nil (let ((l (list 1 2 3))) ;circular
+ (setf (nthcdr 3 l) l)
+ l))
+ (ought nil 1) ;non-lists
+ (ought nil "")
+ (ought nil "abc")
+ (ought nil [])
+ (ought nil [1 2 3]))
+
+(compat-deftests (proper-list-p compat--proper-list-p-tortoise-hare)
+ (ought 0 ()) ;empty list
+ (ought 1 '(1)) ;single element
+ (ought 3 '(1 2 3)) ;multiple elements
+ (ought nil '(1 . 2)) ;cons
+ (ought nil '(1 2 . 3)) ;dotted
+ (ought nil (let ((l (list 1 2 3))) ;circular
+ (setf (nthcdr 3 l) l)
+ l))
+ (ought nil 1) ;non-lists
+ (ought nil "")
+ (ought nil "abc")
+ (ought nil [])
+ (ought nil [1 2 3]))
+
+(compat-deftests flatten-tree
+ ;; Example from docstring:
+ (ought '(1 2 3 4 5 6 7) '(1 (2 . 3) nil (4 5 (6)) 7))
+ ;; Trivial example
+ (ought nil ())
+ ;; Simple examples
+ (ought '(1) '(1))
+ (ought '(1 2) '(1 2))
+ (ought '(1 2 3) '(1 2 3))
+ ;; Regular sublists
+ (ought '(1) '((1)))
+ (ought '(1 2) '((1) (2)))
+ (ought '(1 2 3) '((1) (2) (3)))
+ ;; Complex examples
+ (ought '(1) '(((((1))))))
+ (ought '(1 2 3 4) '((1) nil 2 ((3 4))))
+ (ought '(1 2 3 4) '(((1 nil)) 2 (((3 nil nil) 4)))))
+
+(compat-deftests xor
+ (ought t t nil)
+ (ought t nil t)
+ (ought nil nil nil)
+ (ought nil t t))
+
+(compat-deftests string-distance
+ (ought 3 "kitten" "sitting") ;from wikipedia
+ (if (version<= "28" emacs-version) ;trivial examples
+ (ought 0 "" "")
+ ;; Up until Emacs 28, `string-distance' had a bug
+ ;; when comparing two empty strings. This was fixed
+ ;; in the following commit:
+ ;; https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=c44190c
+ ;;
+ ;; Therefore, we must make sure, that the test
+ ;; doesn't fail because of this bug:
+ (should (= (compat--string-distance "" "") 0)))
+ (ought 0 "a" "a")
+ (ought 1 "" "a")
+ (ought 1 "b" "a")
+ (ought 2 "aa" "bb")
+ (ought 2 "aa" "bba")
+ (ought 2 "aaa" "bba")
+ (ought 3 "a" "あ" t) ;byte example
+ (ought 1 "a" "あ"))
(ert-deftest compat-regexp-unmatchable ()
"Check if `compat--string-distance' was implemented correctly."
@@ -528,205 +563,208 @@ the compatibility function."
(when (boundp 'regexp-unmatchable)
(should-not (string-match-p regexp-unmatchable str)))))
+(compat-deftests compat-regexp-opt
+ ;; Ensure `compat--regexp-opt' doesn't change the existing
+ ;; behaviour:
+ (ought (regexp-opt '("a" "b" "c")) '("a" "b" "c"))
+ (ought (regexp-opt '("abc" "def" "ghe")) '("abc" "def" "ghe"))
+ (ought (regexp-opt '("a" "b" "c") 'words) '("a" "b" "c") 'words)
+ ;; Test empty list:
+ (ought "\\(?:\\`a\\`\\)" '())
+ (ought "\\<\\(\\`a\\`\\)\\>" '() 'words))
+
(ert-deftest compat-regexp-opt ()
"Check if `compat--regexp-opt' advice was defined correctly."
- (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 '())))
+ (let ((unmatchable "\\(?:\\`a\\`\\)"))
(dolist (str '("" ;empty string
"a" ;simple string
"aaa" ;longer string
))
(should-not (string-match-p unmatchable str)))))
-(ert-deftest compat-assoc ()
- "Check if `compat--assoc' advice was advised correctly."
- (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)))
- ;; 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"))
- (lambda (s1 s2) (not (string= s1 s2))))
- (compat--should
- '("\\.el\\'" . emacs-lisp-mode)
- "file.el"
- '(("\\.c\\'" . c-mode)
- ("\\.p\\'" . pascal-mode)
- ("\\.el\\'" . emacs-lisp-mode)
- ("\\.awk\\'" . awk-mode))
- #'string-match-p)))
+(compat-deftests compat-assoc
+ ;; Fallback behaviour:
+ (ought nil 1 nil) ;empty list
+ (ought '(1) 1 '((1))) ;single element list
+ (ought nil 1 '(1))
+ (ought '(2) 2 '((1) (2) (3))) ;multiple element list
+ (ought nil 2 '(1 2 3))
+ (ought '(2) 2 '(1 (2) 3))
+ (ought nil 2 '((1) 2 (3)))
+ (ought '(1) 1 '((3) (2) (1)))
+ (ought '("a") "a" '(("a") ("b") ("c"))) ;non-primitive elements
+ (ought '("a" 0) "a" '(("c" . "a") "b" ("a" 0)))
+ ;; With testfn (advised behaviour):
+ (ought '(1) 3 '((10) (4) (1) (9)) #'<)
+ (ought '("a") "b" '(("c") ("a") ("b")) #'string-lessp)
+ (ought '("b") "a" '(("a") ("a") ("b"))
+ (lambda (s1 s2) (not (string= s1 s2))))
+ (ought
+ '("\\.el\\'" . emacs-lisp-mode)
+ "file.el"
+ '(("\\.c\\'" . c-mode)
+ ("\\.p\\'" . pascal-mode)
+ ("\\.el\\'" . emacs-lisp-mode)
+ ("\\.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 compat-alist-get
+;; (compat-deftests 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
+;; (ought nil 1 nil) ;empty list
+;; (ought 'a 1 '((1 . a))) ;single element list
+;; (ought nil 1 '(1))
+;; (ought 'b 2 '((1 . a) (2 . b) (3 . c))) ;multiple element list
+;; (ought nil 2 '(1 2 3))
+;; (ought 'b 2 '(1 (2 . b) 3))
+;; (ought nil 2 '((1 . a) 2 (3 . c)))
+;; (ought 'a 1 '((3 . c) (2 . b) (1 . a)))
+;; (ought 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
+;; (ought 1 "a" '(("a" . 1) ("b" . 2) ("c" . 3)) nil nil #'equal)
+;; (ought 1 3 '((10 . 10) (4 . 4) (1 . 1) (9 . 9)) nil nil #'<)
+;; (ought '(a) "b" '(("c" c) ("a" a) ("b" b)) nil nil #'string-lessp)
+;; (ought 'c "a" '(("a" . a) ("a" . b) ("b" . c)) nil nil
;; (lambda (s1 s2) (not (string= s1 s2))))
-;; (compat--should 'emacs-lisp-mode
+;; (ought '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."
- (compat-test (alist-get compat--alist-get-full-elisp)
- ;; 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
- (compat-test ((and (version<= "26.1" emacs-version) #'alist-get)
- compat--alist-get-full-elisp)
- ;; 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-string-trim-left ()
- "Check if `compat--string-trim-left' was implemented correctly."
- (compat-test string-trim-left'
- (compat--should "" "") ;empty string
- (compat--should "a" "a") ;"full" string
- (compat--should "aaa" "aaa")
- (compat--should "へっろ" "へっろ")
- (compat--should "hello world" "hello world")
- (compat--should "a " "a ") ;right trailing
- (compat--should "aaa " "aaa ")
- (compat--should "a " "a ")
- (compat--should "a\t\t" "a\t\t")
- (compat--should "a\n \t" "a\n \t")
- (compat--should "a" " a") ;left trailing
- (compat--should "aaa" " aaa")
- (compat--should "a" "a")
- (compat--should "a" "\t\ta")
- (compat--should "a" "\n \ta")
- (compat--should "a " " a ") ;both trailing
- (compat--should "aaa " " aaa ")
- (compat--should "a\t\n" "\t\ta\t\n")
- (compat--should "a \n" "\n \ta \n")))
-
-(ert-deftest compat-string-trim-right ()
- "Check if `compat--string-trim-right' was implemented correctly."
- (compat-test string-trim-right
- (compat--should "" "") ;empty string
- (compat--should "a" "a") ;"full" string
- (compat--should "aaa" "aaa")
- (compat--should "へっろ" "へっろ")
- (compat--should "hello world" "hello world")
- (compat--should "a" "a") ;right trailing
- (compat--should "aaa" "aaa")
- (compat--should "a" "a ")
- (compat--should "a" "a\t\t")
- (compat--should "a" "a\n \t")
- (compat--should " a" " a") ;left trailing
- (compat--should " aaa" " aaa")
- (compat--should "a" "a")
- (compat--should "\t\ta" "\t\ta")
- (compat--should "\n \ta" "\n \ta")
- (compat--should " a" " a ") ;both trailing
- (compat--should " aaa" " aaa")
- (compat--should "\t\ta" "\t\ta\t\n")
- (compat--should "\n \ta" "\n \ta \n")))
-
-(ert-deftest compat-string-trim ()
- "Check if `compat--string-trim' was implemented correctly."
- (compat-test string-trim
- (compat--should "" "") ;empty string
- (compat--should "a" "a") ;"full" string
- (compat--should "aaa" "aaa")
- (compat--should "へっろ" "へっろ")
- (compat--should "hello world" "hello world")
- (compat--should "a" "a ") ;right trailing
- (compat--should "aaa" "aaa ")
- (compat--should "a" "a ")
- (compat--should "a" "a\t\t")
- (compat--should "a" "a\n \t")
- (compat--should "a" " a") ;left trailing
- (compat--should "aaa" " aaa")
- (compat--should "a" "a")
- (compat--should "a" "\t\ta")
- (compat--should "a" "\n \ta")
- (compat--should "a" " a ") ;both trailing
- (compat--should "aaa" " aaa ")
- (compat--should "t\ta" "t\ta\t\n")
- (compat--should "a" "\n \ta \n")))
-
-(ert-deftest compat-mapcan ()
- "Check if `compat--mapcan' was implemented correctly."
- (compat-test mapcan
- (compat--should nil #'identity nil)
- (compat--should (list 1)
- #'identity
- (list (list 1)))
- (compat--should (list 1 2 3 4)
- #'identity
- (list (list 1) (list 2 3) (list 4)))
- (compat--should (list (list 1) (list 2 3) (list 4))
- #'list
- (list (list 1) (list 2 3) (list 4)))
- (compat--should (list 1 2 3 4)
- #'identity
- (list (list 1) (list) (list 2 3) (list 4)))
- (compat--should (list (list 1) (list) (list 2 3) (list 4))
- #'list
- (list (list 1) (list) (list 2 3) (list 4)))
- (compat--should (list)
- #'identity
- (list (list) (list) (list) (list)))))
+;; (ought 'd 0 '((1 . a) (2 . b) (3 . c)) 'd) ;default value
+;; (ought 'd 2 '((1 . a) (2 . b) (3 . c)) 'd nil #'ignore))))
+
+(compat-deftests (alist-get compat--alist-get-full-elisp)
+ ;; Fallback behaviour:
+ (ought nil 1 nil) ;empty list
+ (ought 'a 1 '((1 . a))) ;single element list
+ (ought nil 1 '(1))
+ (ought 'b 2 '((1 . a) (2 . b) (3 . c))) ;multiple element list
+ (ought nil 2 '(1 2 3))
+ (ought 'b 2 '(1 (2 . b) 3))
+ (ought nil 2 '((1 . a) 2 (3 . c)))
+ (ought 'a 1 '((3 . c) (2 . b) (1 . a)))
+ (ought nil "a" '(("a" . 1) ("b" . 2) ("c" . 3))) ;non-primitive elements
+ ;; With testfn (advised behaviour):
+ (ought 1 "a" '(("a" . 1) ("b" . 2) ("c" . 3)) nil nil #'equal)
+ (ought 1 3 '((10 . 10) (4 . 4) (1 . 1) (9 . 9)) nil nil #'<)
+ (ought '(a) "b" '(("c" c) ("a" a) ("b" b)) nil nil #'string-lessp)
+ (ought 'c "a" '(("a" . a) ("a" . b) ("b" . c)) nil nil
+ (lambda (s1 s2) (not (string= s1 s2))))
+ (ought 'emacs-lisp-mode
+ "file.el"
+ '(("\\.c\\'" . c-mode)
+ ("\\.p\\'" . pascal-mode)
+ ("\\.el\\'" . emacs-lisp-mode)
+ ("\\.awk\\'" . awk-mode))
+ nil nil #'string-match-p)
+ (ought 'd 0 '((1 . a) (2 . b) (3 . c)) 'd) ;default value
+ (ought 'd 2 '((1 . a) (2 . b) (3 . c)) 'd nil #'ignore))
+
+(ert-deftest compat-alist-get-gv ()
+ "Test if the `compat-alist-get' can be used as a generalised variable."
+ (let ((alist-1 (list (cons 1 "one")
+ (cons 2 "two")
+ (cons 3 "three")))
+ (alist-2 (list (cons "one" 1)
+ (cons "two" 2)
+ (cons "three" 3))))
+ (setf (compat-alist-get 1 alist-1) "eins")
+ (should (equal (compat-alist-get 1 alist-1) "eins"))
+ (setf (compat-alist-get 2 alist-1 nil 'remove) nil)
+ (should (equal alist-1 '((1 . "eins") (3 . "three"))))
+ (setf (compat-alist-get "one" alist-2 nil nil #'string=) "eins")
+ (should (equal (compat-alist-get "one" alist-2 nil nil #'string=)
+ "eins"))))
+
+(compat-deftests string-trim-left
+ (ought "" "") ;empty string
+ (ought "a" "a") ;"full" string
+ (ought "aaa" "aaa")
+ (ought "へっろ" "へっろ")
+ (ought "hello world" "hello world")
+ (ought "a " "a ") ;right trailing
+ (ought "aaa " "aaa ")
+ (ought "a " "a ")
+ (ought "a\t\t" "a\t\t")
+ (ought "a\n \t" "a\n \t")
+ (ought "a" " a") ;left trailing
+ (ought "aaa" " aaa")
+ (ought "a" "a")
+ (ought "a" "\t\ta")
+ (ought "a" "\n \ta")
+ (ought "a " " a ") ;both trailing
+ (ought "aaa " " aaa ")
+ (ought "a\t\n" "\t\ta\t\n")
+ (ought "a \n" "\n \ta \n"))
+
+(compat-deftests string-trim-right
+ (ought "" "") ;empty string
+ (ought "a" "a") ;"full" string
+ (ought "aaa" "aaa")
+ (ought "へっろ" "へっろ")
+ (ought "hello world" "hello world")
+ (ought "a" "a") ;right trailing
+ (ought "aaa" "aaa")
+ (ought "a" "a ")
+ (ought "a" "a\t\t")
+ (ought "a" "a\n \t")
+ (ought " a" " a") ;left trailing
+ (ought " aaa" " aaa")
+ (ought "a" "a")
+ (ought "\t\ta" "\t\ta")
+ (ought "\n \ta" "\n \ta")
+ (ought " a" " a ") ;both trailing
+ (ought " aaa" " aaa")
+ (ought "\t\ta" "\t\ta\t\n")
+ (ought "\n \ta" "\n \ta \n"))
+
+(compat-deftests string-trim
+ (ought "" "") ;empty string
+ (ought "a" "a") ;"full" string
+ (ought "aaa" "aaa")
+ (ought "へっろ" "へっろ")
+ (ought "hello world" "hello world")
+ (ought "a" "a ") ;right trailing
+ (ought "aaa" "aaa ")
+ (ought "a" "a ")
+ (ought "a" "a\t\t")
+ (ought "a" "a\n \t")
+ (ought "a" " a") ;left trailing
+ (ought "aaa" " aaa")
+ (ought "a" "a")
+ (ought "a" "\t\ta")
+ (ought "a" "\n \ta")
+ (ought "a" " a ") ;both trailing
+ (ought "aaa" " aaa ")
+ (ought "t\ta" "t\ta\t\n")
+ (ought "a" "\n \ta \n"))
+
+(compat-deftests mapcan
+ (ought nil #'identity nil)
+ (ought (list 1)
+ #'identity
+ (list (list 1)))
+ (ought (list 1 2 3 4)
+ #'identity
+ (list (list 1) (list 2 3) (list 4)))
+ (ought (list (list 1) (list 2 3) (list 4))
+ #'list
+ (list (list 1) (list 2 3) (list 4)))
+ (ought (list 1 2 3 4)
+ #'identity
+ (list (list 1) (list) (list 2 3) (list 4)))
+ (ought (list (list 1) (list) (list 2 3) (list 4))
+ #'list
+ (list (list 1) (list) (list 2 3) (list 4)))
+ (ought (list)
+ #'identity
+ (list (list) (list) (list) (list))))
;; Note: as the cXXX+r implementations are relatively trivial, their
;; tests are not as extensive.
@@ -740,443 +778,359 @@ the compatibility function."
(((i . j) . (k . l)) . ((m . j) . (o . p))))
"Testcase for cXXXXr functions.")
-(ert-deftest compat-caaar ()
- "Check if `compat--caaar' was implemented correctly."
- (compat-test caaar
- (compat--should nil ())
- (compat--should 'a compat-cXXXr-test)))
-
-(ert-deftest compat-caadr ()
- "Check if `compat--caadr' was implemented correctly."
- (compat-test caadr
- (compat--should nil ())
- (compat--should 'e compat-cXXXr-test)))
-
-(ert-deftest compat-cadar ()
- "Check if `compat--cadar' was implemented correctly."
- (compat-test cadar
- (compat--should nil ())
- (compat--should 'c compat-cXXXr-test)))
-
-(ert-deftest compat-caddr ()
- "Check if `compat--caddr' was implemented correctly."
- (compat-test caddr
- (compat--should nil ())
- (compat--should 'g compat-cXXXr-test)))
-
-(ert-deftest compat-cdaar ()
- "Check if `compat--cdaar' was implemented correctly."
- (compat-test cdaar
- (compat--should nil ())
- (compat--should 'b compat-cXXXr-test)))
-
-(ert-deftest compat-cdadr ()
- "Check if `compat--cdadr' was implemented correctly."
- (compat-test cdadr
- (compat--should nil ())
- (compat--should 'f compat-cXXXr-test)))
-
-(ert-deftest compat-cddar ()
- "Check if `compat--cddar' was implemented correctly."
- (compat-test cddar
- (compat--should nil ())
- (compat--should 'd compat-cXXXr-test)))
-
-(ert-deftest compat-cdddr ()
- "Check if `compat--cdddr' was implemented correctly."
- (compat-test cdddr
- (compat--should nil ())
- (compat--should 'h compat-cXXXr-test)
- #'cdddr))
-
-(ert-deftest compat-caaaar ()
- "Check if `compat--caaaar' was implemented correctly."
- (compat-test caaaar
- (compat--should nil ())
- (compat--should 'a compat-cXXXXr-test)))
-
-(ert-deftest compat-caaadr ()
- "Check if `compat--caaadr' was implemented correctly."
- (compat-test caaadr
- (compat--should nil ())
- (compat--should 'i compat-cXXXXr-test)))
-
-(ert-deftest compat-caadar ()
- "Check if `compat--caadar' was implemented correctly."
- (compat-test caadar
- (compat--should nil ())
- (compat--should 'e compat-cXXXXr-test)))
-
-(ert-deftest compat-caaddr ()
- "Check if `compat--caaddr' was implemented correctly."
- (compat-test caaddr
- (compat--should nil ())
- (compat--should 'm compat-cXXXXr-test)))
-
-(ert-deftest compat-cadaar ()
- "Check if `compat--cadaar' was implemented correctly."
- (compat-test cadaar
- (compat--should nil ())
- (compat--should 'c compat-cXXXXr-test)))
-
-(ert-deftest compat-cadadr ()
- "Check if `compat--cadadr' was implemented correctly."
- (compat-test cadadr
- (compat--should nil ())
- (compat--should 'k compat-cXXXXr-test)))
-
-(ert-deftest compat-caddar ()
- "Check if `compat--caddar' was implemented correctly."
- (compat-test caddar
- (compat--should nil ())
- (compat--should 'g compat-cXXXXr-test)))
-
-(ert-deftest compat-cadddr ()
- "Check if `compat--cadddr' was implemented correctly."
- (compat-test cadddr
- (compat--should nil ())
- (compat--should 'o compat-cXXXXr-test)))
-
-(ert-deftest compat-cdaaar ()
- "Check if `compat--cdaaar' was implemented correctly."
- (compat-test cdaaar
- (compat--should nil ())
- (compat--should 'b compat-cXXXXr-test)))
-
-(ert-deftest compat-cdaadr ()
- "Check if `compat--cdaadr' was implemented correctly."
- (compat-test cdaadr
- (compat--should nil ())
- (compat--should 'j compat-cXXXXr-test)))
-
-(ert-deftest compat-cdadar ()
- "Check if `compat--cdadar' was implemented correctly."
- (compat-test cdadar
- (compat--should nil ())
- (compat--should 'f compat-cXXXXr-test)))
-
-(ert-deftest compat-cdaddr ()
- "Check if `compat--cdaddr' was implemented correctly."
- (compat-test cdaddr
- (compat--should nil ())
- (compat--should 'j compat-cXXXXr-test)))
-
-(ert-deftest compat-cddaar ()
- "Check if `compat--cddaar' was implemented correctly."
- (compat-test cddaar
- (compat--should nil ())
- (compat--should 'd compat-cXXXXr-test)))
-
-(ert-deftest compat-cddadr ()
- "Check if `compat--cddadr' was implemented correctly."
- (compat-test cddadr
- (compat--should nil ())
- (compat--should 'l compat-cXXXXr-test)))
-
-(ert-deftest compat-cdddar ()
- "Check if `compat--cdddar' was implemented correctly."
- (compat-test cdddar
- (compat--should nil ())
- (compat--should 'h compat-cXXXXr-test)))
-
-(ert-deftest compat-string-greaterp ()
- "Check if `compat--string-greaterp' was implemented correctly."
- (compat-test string-greaterp
- (compat--should t "b" "a")
- (compat--should nil "a" "b")
- (compat--should t "aaab" "aaaa")
- (compat--should nil "aaaa" "aaab")))
-
-(ert-deftest compat-sort ()
- "Check if `compat--sort' was advised correctly."
- (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-=
- (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-<
- (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->
- (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-<=
- (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->=
- (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."
- (compat-test special-form-p
- (compat--should t 'if)
- (compat--should t 'cond)
- (compat--should nil 'when)
- (compat--should nil 'defun)
- (compat--should nil '+)
- (compat--should nil nil)
- (compat--should nil "macro")
- (compat--should nil '(macro . +))))
-
-(ert-deftest compat-macrop ()
- "Check if `compat--macrop' was implemented correctly."
- (compat-test macrop
- (compat--should t 'lambda)
- (compat--should t 'defun)
- (compat--should t 'defmacro)
- (compat--should nil 'defalias)
- (compat--should nil 'foobar)
- (compat--should nil 'if)
- (compat--should nil '+)
- (compat--should nil 1)
- (compat--should nil nil)
- (compat--should nil "macro")
- (compat--should t '(macro . +))))
-
-(ert-deftest compat-string-suffix-p ()
- "Check if `compat--string-suffix-p' was implemented correctly."
- (compat-test string-suffix-p
- (compat--should t "a" "abba")
- (compat--should t "ba" "abba")
- (compat--should t "abba" "abba")
- (compat--should nil "a" "ABBA")
- (compat--should nil "bA" "ABBA")
- (compat--should nil "aBBA" "ABBA")
- (compat--should nil "c" "ABBA")
- (compat--should nil "c" "abba")
- (compat--should nil "cddc" "abba")
- (compat--should nil "aabba" "abba")))
-
-(ert-deftest compat-split-string ()
- "Check if `compat--split-string' was advised correctly."
- (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."
- (compat-test delete-consecutive-dups
- (compat--should '(1 2 3 4) '(1 2 3 4))
- (compat--should '(1 2 3 4) '(1 2 2 3 4 4))
- (compat--should '(1 2 3 2 4) '(1 2 2 3 2 4 4))))
-
-(ert-deftest compat-string-clean-whitespace ()
- "Check if `compat--string-clean-whitespace' was implemented correctly."
- (compat-test string-clean-whitespace
- (compat--should "a b c" "a b c")
- (compat--should "a b c" " a b c")
- (compat--should "a b c" "a b c ")
- (compat--should "a b c" "a b c")
- (compat--should "a b c" "a b c")
- (compat--should "a b c" "a b c")
- (compat--should "a b c" " a b c")
- (compat--should "a b c" "a b c ")
- (compat--should "a b c" " a b c ")
- (compat--should "aa bb cc" "aa bb cc")
- (compat--should "aa bb cc" " aa bb cc")
- (compat--should "aa bb cc" "aa bb cc ")
- (compat--should "aa bb cc" "aa bb cc")
- (compat--should "aa bb cc" "aa bb cc")
- (compat--should "aa bb cc" "aa bb cc")
- (compat--should "aa bb cc" " aa bb cc")
- (compat--should "aa bb cc" "aa bb cc ")
- (compat--should "aa bb cc" " aa bb cc ")))
-
-(ert-deftest compat-string-fill ()
- "Check if `compat--string-fill' was implemented correctly."
- (compat-test string-fill
- (compat--should "a a a a a" "a a a a a" 9)
- (compat--should "a a a a a" "a a a a a" 10)
- (compat--should "a a a a\na" "a a a a a" 8)
- (compat--should "a a a a\na" "a a a a a" 8)
- (compat--should "a a\na a\na" "a a a a a" 4)
- (compat--should "a\na\na\na\na" "a a a a a" 2)
- (compat--should "a\na\na\na\na" "a a a a a" 1)))
-
-(ert-deftest compat-string-lines ()
- "Check if `compat--string-lines' was implemented correctly."
- (compat-test string-lines
- (compat--should '("a" "b" "c") "a\nb\nc")
- (compat--should '("a" "b" "c" "") "a\nb\nc\n")
- (compat--should '("a" "b" "c") "a\nb\nc\n" t)
- (compat--should '("abc" "bcd" "cde") "abc\nbcd\ncde")
- (compat--should '(" abc" " bcd " "cde ") " abc\n bcd \ncde ")))
-
-(ert-deftest compat-string-pad ()
- "Check if `compat--string-pad' was implemented correctly."
- (compat-test string-pad
- (compat--should "a " "a" 4)
- (compat--should "aaaa" "aaaa" 4)
- (compat--should "aaaaaa" "aaaaaa" 4)
- (compat--should "a..." "a" 4 ?.)
- (compat--should " a" "a" 4 nil t)
- (compat--should "...a" "a" 4 ?. t)))
-
-(ert-deftest compat-string-chop-newline ()
- "Check if `compat--string-chop-newline' was implemented correctly."
- (compat-test string-chop-newline
- (compat--should "" "")
- (compat--should "" "\n")
- (compat--should "aaa" "aaa")
- (compat--should "aaa" "aaa\n")
- (compat--should "aaa\n" "aaa\n\n")))
-
-(ert-deftest compat-macroexpand-1 ()
- "Check if `compat--macroexpand-1' was implemented correctly."
- (compat-test macroexpand-1
- (compat--should '(if a b c) '(if a b c))
- (compat--should '(if a (progn b)) '(when a b))
- (compat--should '(if a (progn (unless b c))) '(when a (unless b c)))))
-
-(ert-deftest compat-file-size-human-readable ()
- "Check if `compat--file-size-human-readable' was advised properly."
- (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."
- (compat-test format-prompt
- (compat--should "Prompt: " "Prompt" nil)
- (compat--should "Prompt (default 3): " "Prompt" 3)
- (compat--should "Prompt (default abc): " "Prompt" "abc")
- (compat--should "Prompt (default abc def): " "Prompt" "abc def")
- (compat--should "Prompt 10: " "Prompt %d" nil 10)
- (compat--should "Prompt \"abc\" (default 3): " "Prompt %S" 3 "abc")))
+(compat-deftests caaar
+ (ought nil ())
+ (ought 'a compat-cXXXr-test))
+
+(compat-deftests caadr
+ (ought nil ())
+ (ought 'e compat-cXXXr-test))
+
+(compat-deftests cadar
+ (ought nil ())
+ (ought 'c compat-cXXXr-test))
+
+(compat-deftests caddr
+ (ought nil ())
+ (ought 'g compat-cXXXr-test))
+
+(compat-deftests cdaar
+ (ought nil ())
+ (ought 'b compat-cXXXr-test))
+
+(compat-deftests cdadr
+ (ought nil ())
+ (ought 'f compat-cXXXr-test))
+
+(compat-deftests cddar
+ (ought nil ())
+ (ought 'd compat-cXXXr-test))
+
+(compat-deftests cdddr
+ (ought nil ())
+ (ought 'h compat-cXXXr-test)
+ #'cdddr)
+
+(compat-deftests caaaar
+ (ought nil ())
+ (ought 'a compat-cXXXXr-test))
+
+(compat-deftests caaadr
+ (ought nil ())
+ (ought 'i compat-cXXXXr-test))
+
+(compat-deftests caadar
+ (ought nil ())
+ (ought 'e compat-cXXXXr-test))
+
+(compat-deftests caaddr
+ (ought nil ())
+ (ought 'm compat-cXXXXr-test))
+
+(compat-deftests cadaar
+ (ought nil ())
+ (ought 'c compat-cXXXXr-test))
+
+(compat-deftests cadadr
+ (ought nil ())
+ (ought 'k compat-cXXXXr-test))
+
+(compat-deftests caddar
+ (ought nil ())
+ (ought 'g compat-cXXXXr-test))
+
+(compat-deftests cadddr
+ (ought nil ())
+ (ought 'o compat-cXXXXr-test))
+
+(compat-deftests cdaaar
+ (ought nil ())
+ (ought 'b compat-cXXXXr-test))
+
+(compat-deftests cdaadr
+ (ought nil ())
+ (ought 'j compat-cXXXXr-test))
+
+(compat-deftests cdadar
+ (ought nil ())
+ (ought 'f compat-cXXXXr-test))
+
+(compat-deftests cdaddr
+ (ought nil ())
+ (ought 'j compat-cXXXXr-test))
+
+(compat-deftests cddaar
+ (ought nil ())
+ (ought 'd compat-cXXXXr-test))
+
+(compat-deftests cddadr
+ (ought nil ())
+ (ought 'l compat-cXXXXr-test))
+
+(compat-deftests cdddar
+ (ought nil ())
+ (ought 'h compat-cXXXXr-test))
+
+(compat-deftests string-greaterp
+ (ought t "b" "a")
+ (ought nil "a" "b")
+ (ought t "aaab" "aaaa")
+ (ought nil "aaaa" "aaab"))
+
+(compat-deftests compat-sort
+ (ought (list 1 2 3) (list 1 2 3) #'<)
+ (ought (list 1 2 3) (list 3 2 1) #'<)
+ (ought '[1 2 3] '[1 2 3] #'<)
+ (ought '[1 2 3] '[3 2 1] #'<))
+
+(compat-deftests compat-=
+ (ought t 0 0)
+ (ought t 0 0 0)
+ (ought t 0 0 0 0)
+ (ought t 0 0 0 0 0)
+ (ought t 0.0 0.0)
+ (ought t +0.0 -0.0)
+ (ought t 0.0 0.0 0.0)
+ (ought t 0.0 0.0 0.0 0.0)
+ (ought nil 0 1)
+ (ought nil 0 0 1)
+ (ought nil 0 0 0 0 1)
+ (expect wrong-type-argument 0 0 'a)
+ (ought nil 0 1 'a)
+ (ought nil 0.0 0.0 0.0 0.1))
+
+(compat-deftests compat-<
+ (ought nil 0 0)
+ (ought nil 0 0 0)
+ (ought nil 0 0 0 0)
+ (ought nil 0 0 0 0 0)
+ (ought nil 0.0 0.0)
+ (ought nil +0.0 -0.0)
+ (ought nil 0.0 0.0 0.0)
+ (ought nil 0.0 0.0 0.0 0.0)
+ (ought t 0 1)
+ (ought nil 1 0)
+ (ought nil 0 0 1)
+ (ought t 0 1 2)
+ (ought nil 2 1 0)
+ (ought nil 0 0 0 0 1)
+ (ought t 0 1 2 3 4)
+ (expect wrong-type-argument 0 1 'a)
+ (ought nil 0 0 'a)
+ (ought nil 0.0 0.0 0.0 0.1)
+ (ought t -0.1 0.0 0.2 0.4)
+ (ought t -0.1 0 0.2 0.4))
+
+(compat-deftests compat->
+ (ought nil 0 0)
+ (ought nil 0 0 0)
+ (ought nil 0 0 0 0)
+ (ought nil 0 0 0 0 0)
+ (ought nil 0.0 0.0)
+ (ought nil +0.0 -0.0)
+ (ought nil 0.0 0.0 0.0)
+ (ought nil 0.0 0.0 0.0 0.0)
+ (ought t 1 0)
+ (ought nil 1 0 0)
+ (ought nil 0 1 2)
+ (ought t 2 1 0)
+ (ought nil 1 0 0 0 0)
+ (ought t 4 3 2 1 0)
+ (ought nil 4 3 2 1 1)
+ (expect wrong-type-argument 1 0 'a)
+ (ought nil 0 0 'a)
+ (ought nil 0.1 0.0 0.0 0.0)
+ (ought t 0.4 0.2 0.0 -0.1)
+ (ought t 0.4 0.2 0 -0.1))
+
+(compat-deftests compat-<=
+ (ought t 0 0)
+ (ought t 0 0 0)
+ (ought t 0 0 0 0)
+ (ought t 0 0 0 0 0)
+ (ought t 0.0 0.0)
+ (ought t +0.0 -0.0)
+ (ought t 0.0 0.0 0.0)
+ (ought t 0.0 0.0 0.0 0.0)
+ (ought nil 1 0)
+ (ought nil 1 0 0)
+ (ought t 0 1 2)
+ (ought nil 2 1 0)
+ (ought nil 1 0 0 0 0)
+ (ought nil 4 3 2 1 0)
+ (ought nil 4 3 2 1 1)
+ (ought t 0 1 2 3 4)
+ (ought t 1 1 2 3 4)
+ (expect wrong-type-argument 0 0 'a)
+ (expect wrong-type-argument 0 1 'a)
+ (ought nil 1 0 'a)
+ (ought nil 0.1 0.0 0.0 0.0)
+ (ought t 0.0 0.0 0.0 0.1)
+ (ought t -0.1 0.0 0.2 0.4)
+ (ought t -0.1 0.0 0.0 0.2 0.4)
+ (ought t -0.1 0.0 0 0.2 0.4)
+ (ought t -0.1 0 0.2 0.4)
+ (ought nil 0.4 0.2 0.0 -0.1)
+ (ought nil 0.4 0.2 0.0 0.0 -0.1)
+ (ought nil 0.4 0.2 0 0.0 0.0 -0.1)
+ (ought nil 0.4 0.2 0 -0.1))
+
+(compat-deftests compat->=
+ (ought t 0 0)
+ (ought t 0 0 0)
+ (ought t 0 0 0 0)
+ (ought t 0 0 0 0 0)
+ (ought t 0.0 0.0)
+ (ought t +0.0 -0.0)
+ (ought t 0.0 0.0 0.0)
+ (ought t 0.0 0.0 0.0 0.0)
+ (ought t 1 0)
+ (ought t 1 0 0)
+ (ought nil 0 1 2)
+ (ought t 2 1 0)
+ (ought t 1 0 0 0 0)
+ (ought t 4 3 2 1 0)
+ (ought t 4 3 2 1 1)
+ (expect wrong-type-argument 0 0 'a)
+ (expect wrong-type-argument 1 0 'a)
+ (ought nil 0 1 'a)
+ (ought t 0.1 0.0 0.0 0.0)
+ (ought nil 0.0 0.0 0.0 0.1)
+ (ought nil -0.1 0.0 0.2 0.4)
+ (ought nil -0.1 0.0 0.0 0.2 0.4)
+ (ought nil -0.1 0.0 0 0.2 0.4)
+ (ought nil -0.1 0 0.2 0.4)
+ (ought t 0.4 0.2 0.0 -0.1)
+ (ought t 0.4 0.2 0.0 0.0 -0.1)
+ (ought t 0.4 0.2 0 0.0 0.0 -0.1)
+ (ought t 0.4 0.2 0 -0.1))
+
+(compat-deftests special-form-p
+ (ought t 'if)
+ (ought t 'cond)
+ (ought nil 'when)
+ (ought nil 'defun)
+ (ought nil '+)
+ (ought nil nil)
+ (ought nil "macro")
+ (ought nil '(macro . +)))
+
+(compat-deftests macrop
+ (ought t 'lambda)
+ (ought t 'defun)
+ (ought t 'defmacro)
+ (ought nil 'defalias)
+ (ought nil 'foobar)
+ (ought nil 'if)
+ (ought nil '+)
+ (ought nil 1)
+ (ought nil nil)
+ (ought nil "macro")
+ (ought t '(macro . +)))
+
+(compat-deftests string-suffix-p
+ (ought t "a" "abba")
+ (ought t "ba" "abba")
+ (ought t "abba" "abba")
+ (ought nil "a" "ABBA")
+ (ought nil "bA" "ABBA")
+ (ought nil "aBBA" "ABBA")
+ (ought nil "c" "ABBA")
+ (ought nil "c" "abba")
+ (ought nil "cddc" "abba")
+ (ought nil "aabba" "abba"))
+
+(compat-deftests compat-split-string
+ (ought '("a" "b" "c") "a b c")
+ (ought '("..a.." "..b.." "..c..") "..a.. ..b.. ..c..")
+ (ought '("a" "b" "c") "..a.. ..b.. ..c.." nil nil "\\.+"))
+
+(compat-deftests delete-consecutive-dups
+ (ought '(1 2 3 4) '(1 2 3 4))
+ (ought '(1 2 3 4) '(1 2 2 3 4 4))
+ (ought '(1 2 3 2 4) '(1 2 2 3 2 4 4)))
+
+(compat-deftests string-clean-whitespace
+ (ought "a b c" "a b c")
+ (ought "a b c" " a b c")
+ (ought "a b c" "a b c ")
+ (ought "a b c" "a b c")
+ (ought "a b c" "a b c")
+ (ought "a b c" "a b c")
+ (ought "a b c" " a b c")
+ (ought "a b c" "a b c ")
+ (ought "a b c" " a b c ")
+ (ought "aa bb cc" "aa bb cc")
+ (ought "aa bb cc" " aa bb cc")
+ (ought "aa bb cc" "aa bb cc ")
+ (ought "aa bb cc" "aa bb cc")
+ (ought "aa bb cc" "aa bb cc")
+ (ought "aa bb cc" "aa bb cc")
+ (ought "aa bb cc" " aa bb cc")
+ (ought "aa bb cc" "aa bb cc ")
+ (ought "aa bb cc" " aa bb cc "))
+
+(compat-deftests string-fill
+ (ought "a a a a a" "a a a a a" 9)
+ (ought "a a a a a" "a a a a a" 10)
+ (ought "a a a a\na" "a a a a a" 8)
+ (ought "a a a a\na" "a a a a a" 8)
+ (ought "a a\na a\na" "a a a a a" 4)
+ (ought "a\na\na\na\na" "a a a a a" 2)
+ (ought "a\na\na\na\na" "a a a a a" 1))
+
+(compat-deftests string-lines
+ (ought '("a" "b" "c") "a\nb\nc")
+ (ought '("a" "b" "c" "") "a\nb\nc\n")
+ (ought '("a" "b" "c") "a\nb\nc\n" t)
+ (ought '("abc" "bcd" "cde") "abc\nbcd\ncde")
+ (ought '(" abc" " bcd " "cde ") " abc\n bcd \ncde "))
+
+(compat-deftests string-pad
+ (ought "a " "a" 4)
+ (ought "aaaa" "aaaa" 4)
+ (ought "aaaaaa" "aaaaaa" 4)
+ (ought "a..." "a" 4 ?.)
+ (ought " a" "a" 4 nil t)
+ (ought "...a" "a" 4 ?. t))
+
+(compat-deftests string-chop-newline
+ (ought "" "")
+ (ought "" "\n")
+ (ought "aaa" "aaa")
+ (ought "aaa" "aaa\n")
+ (ought "aaa\n" "aaa\n\n"))
+
+(compat-deftests macroexpand-1
+ (ought '(if a b c) '(if a b c))
+ (ought '(if a (progn b)) '(when a b))
+ (ought '(if a (progn (unless b c))) '(when a (unless b c))))
+
+(compat-deftests compat-file-size-human-readable
+ (ought "1000" 1000)
+ (ought "1k" 1024)
+ (ought "1M" (* 1024 1024))
+ (ought "1G" (expt 1024 3))
+ (ought "1T" (expt 1024 4))
+ (ought "1k" 1000 'si)
+ (ought "1KiB" 1024 'iec)
+ (ought "1KiB" 1024 'iec)
+ (ought "1 KiB" 1024 'iec " ")
+ (ought "1KiA" 1024 'iec nil "A")
+ (ought "1 KiA" 1024 'iec " " "A")
+ (ought "1kA" 1000 'si nil "A")
+ (ought "1 k" 1000 'si " ")
+ (ought "1 kA" 1000 'si " " "A"))
+
+(compat-deftests format-prompt
+ (ought "Prompt: " "Prompt" nil)
+ (ought "Prompt: " "Prompt" "")
+ (ought "Prompt (default ): " "Prompt" " ")
+ (ought "Prompt (default 3): " "Prompt" 3)
+ (ought "Prompt (default abc): " "Prompt" "abc")
+ (ought "Prompt (default abc def): " "Prompt" "abc def")
+ (ought "Prompt 10: " "Prompt %d" nil 10)
+ (ought "Prompt \"abc\" (default 3): " "Prompt %S" 3 "abc"))
(ert-deftest compat-named-let ()
"Check if `compat--named-let' was implemented properly."
@@ -1193,65 +1147,59 @@ the compatibility function."
100000))
(should (= (compat--named-let l ((i 0) (x 1)) (if (= i 8) x (l (1+ i) (* x
2))))
(expt 2 8)))
- (should (eq (compat--named-let loop ((x 1))
+ (should (eq (compat--named-let lop ((x 1))
(if (> x 0)
(condition-case nil
- (loop (1- x))
+ (lop (1- x))
(arith-error 'ok))
(/ 1 x)))
'ok))
- (should (eq (compat--named-let loop ((n 10000))
+ (should (eq (compat--named-let lop ((n 10000))
(if (> n 0)
(condition-case nil
(/ n 0)
- (arith-error (loop (1- n))))
+ (arith-error (lop (1- n))))
'ok))
'ok))
- (should (eq (compat--named-let loop ((x nil))
+ (should (eq (compat--named-let lop ((x nil))
(cond (x)
(t 'ok)))
'ok))
- (should (eq (compat--named-let loop ((x 100000))
+ (should (eq (compat--named-let lop ((x 100000))
(cond ((= x 0) 'ok)
- ((loop (1- x)))))
+ ((lop (1- x)))))
'ok))
- (should (eq (compat--named-let loop ((x 100000))
+ (should (eq (compat--named-let lop ((x 100000))
(cond
((= x -1) nil)
((= x 0) 'ok)
- ((loop -1))
- ((loop (1- x)))))
+ ((lop -1))
+ ((lop (1- x)))))
'ok))
- (should (eq (compat--named-let loop ((x 10000))
+ (should (eq (compat--named-let lop ((x 10000))
(cond ((= x 0) 'ok)
- ((and t (loop (1- x))))))
+ ((and t (lop (1- x))))))
'ok))
- (should (eq (eval
- (let ((branch '((loop (and (setq b (not b)) (1+ i))))))
- `(let ((b t))
- (compat--named-let loop ((i 0))
- (cond ((null i) nil)
- ((= i 10000) 'ok)
- ,branch
- ,branch))))
- t)
+ (should (eq (let ((b t))
+ (compat--named-let lop ((i 0))
+ (cond ((null i) nil) ((= i 10000) 'ok)
+ ((lop (and (setq b (not b)) (1+ i))))
+ ((lop (and (setq b (not b)) (1+ i)))))))
'ok)))
-(ert-deftest compat-directory-name-p ()
- "Check if `compat--directory-name-p' was implemented properly."
- (compat-test directory-name-p
- (compat--should t "/")
- (compat--should nil "/file")
- (compat--should nil "/dir/file")
- (compat--should t "/dir/")
- (compat--should nil "/dir")
- (compat--should t "/dir/subdir/")
- (compat--should nil "/dir/subdir")
- (compat--should t "dir/")
- (compat--should nil "file")
- (compat--should nil "dir/file")
- (compat--should t "dir/subdir/")
- (compat--should nil "dir/subdir")))
+(compat-deftests directory-name-p
+ (ought t "/")
+ (ought nil "/file")
+ (ought nil "/dir/file")
+ (ought t "/dir/")
+ (ought nil "/dir")
+ (ought t "/dir/subdir/")
+ (ought nil "/dir/subdir")
+ (ought t "dir/")
+ (ought nil "file")
+ (ought nil "dir/file")
+ (ought t "dir/subdir/")
+ (ought nil "dir/subdir"))
(ert-deftest compat-if-let* ()
"Check if `compat--if-let*' was implemented properly."
@@ -1266,8 +1214,21 @@ the compatibility function."
(should-not
(compat--if-let* (((= 5 6))) t nil)))
+(ert-deftest compat-if-let ()
+ "Check if `compat--if-let' was implemented properly."
+ (should (compat--if-let ((e (memq 0 '(1 2 3 0 5 6))))
+ e))
+ (should-not (compat--if-let ((e (memq 0 '(1 2 3 5 6)))
+ (d (memq 0 '(1 2 3 0 5 6))))
+ t))
+ (should-not (compat--if-let ((d (memq 0 '(1 2 3 0 5 6)))
+ (e (memq 0 '(1 2 3 5 6))))
+ t))
+ (should-not
+ (compat--if-let (((= 5 6))) t nil)))
+
(ert-deftest compat-and-let* ()
- "Check if `compat--if-let*' was implemented properly."
+ "Check if `compat--and-let*' was implemented properly."
(should ;trivial body
(compat--and-let*
((x 3)
@@ -1286,21 +1247,19 @@ the compatibility function."
(should-not
(compat--and-let* (((= 5 6))) t)))
+(compat-deftests compat-json-parse-string
+ (ought 0 "0")
+ (ought 1 "1")
+ (ought 0.5 "0.5")
+ (ought [1 2 3] "[1,2,3]")
+ (ought ["a" 2 3] "[\"a\",2,3]")
+ (ought [["a" 2] 3] "[[\"a\",2],3]")
+ (ought '(("a" 2) 3) "[[\"a\",2],3]" :array-type 'list)
+ (ought 'foo "null" :null-object 'foo)
+ (ought ["false" t] "[false, true]" :false-object "false"))
+
(ert-deftest compat-json-parse-string ()
"Check if `compat--json-parse-string' was implemented properly."
- (compat-test (json-parse-string (if (version<= "28" emacs-version)
- (apply-partially
#'compat--json-parse-string-handle-tlo
- #'json-parse-string)
- #'compat--json-parse-string))
- (compat--should 0 "0")
- (compat--should 1 "1")
- (compat--should 0.5 "0.5")
- (compat--should [1 2 3] "[1,2,3]")
- (compat--should ["a" 2 3] "[\"a\",2,3]")
- (compat--should [["a" 2] 3] "[[\"a\",2],3]")
- (compat--should '(("a" 2) 3) "[[\"a\",2],3]" :array-type 'list)
- (compat--should 'foo "null" :null-object 'foo)
- (compat--should ["false" t] "[false, true]" :false-object "false"))
(let ((input "{\"key\":[\"abc\", 2], \"yek\": null}"))
(let ((obj (compat--json-parse-string input)))
(should (equal (gethash "key" obj) ["abc" 2]))
@@ -1322,17 +1281,558 @@ the compatibility function."
(should (equal (gethash "key" obj) ["abc" 2]))
(should (equal (gethash "yek" obj) :null))))))
-(ert-deftest compat-lookup-key ()
- "Check if `compat-lookup-key' was implemented properly."
+(ert-deftest compat-json-serialize ()
+ "Check if `compat--json-serialize' was implemented properly."
+ (let ((input-1 '((:key . ["abc" 2]) (yek . t)))
+ (input-2 '(:key ["abc" 2] yek t))
+ (input-3 (let ((ht (make-hash-table)))
+ (puthash "key" ["abc" 2] ht)
+ (puthash "yek" t ht)
+ ht)))
+ (should (equal (compat--json-serialize input-1)
+ "{\":key\":[\"abc\",2],\"yek\":true}"))
+ (should (equal (compat--json-serialize input-2)
+ "{\"key\":[\"abc\",2],\"yek\":true}"))
+ (should (member (compat--json-serialize input-2)
+ '("{\"key\":[\"abc\",2],\"yek\":true}"
+ "{\"yek\":true,\"key\":[\"abc\",2]}")))
+ (should-error (compat--json-serialize '(("a" . 1)))
+ :type '(wrong-type-argument symbolp "a"))
+ (should-error (compat--json-serialize '("a" 1))
+ :type '(wrong-type-argument symbolp "a"))
+ (should-error (compat--json-serialize '("a" 1 2))
+ :type '(wrong-type-argument symbolp "a"))
+ (should-error (compat--json-serialize '(:a 1 2))
+ :type '(wrong-type-argument consp nil))
+ (should-error (compat--json-serialize
+ (let ((ht (make-hash-table)))
+ (puthash 'a 1 ht)
+ ht))
+ :type '(wrong-type-argument stringp a))
+ (when (fboundp 'json-serialize)
+ (should (equal (json-serialize input-1)
+ "{\":key\":[\"abc\",2],\"yek\":true}"))
+ (should (equal (json-serialize input-2)
+ "{\"key\":[\"abc\",2],\"yek\":true}"))
+ (should (member (json-serialize input-2)
+ '("{\"key\":[\"abc\",2],\"yek\":true}"
+ "{\"yek\":true,\"key\":[\"abc\",2]}")))
+ (should-error (json-serialize '(("a" . 1)))
+ :type '(wrong-type-argument symbolp "a"))
+ (should-error (json-serialize '("a" 1))
+ :type '(wrong-type-argument symbolp "a"))
+ (should-error (json-serialize '("a" 1 2))
+ :type '(wrong-type-argument symbolp "a"))
+ (should-error (json-serialize '(:a 1 2))
+ :type '(wrong-type-argument consp nil))
+ (should-error (json-serialize
+ (let ((ht (make-hash-table)))
+ (puthash 'a 1 ht)
+ ht))
+ :type '(wrong-type-argument stringp a)))))
+
+(compat-deftests compat-lookup-key
(let ((a-map (make-sparse-keymap))
(b-map (make-sparse-keymap)))
(define-key a-map "x" 'foo)
(define-key b-map "x" 'bar)
- (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"))))
+ (ought 'foo a-map "x")
+ (ought 'bar b-map "x")
+ (ought 'foo (list a-map b-map) "x")
+ (ought 'bar (list b-map a-map) "x")))
+
+(ert-deftest compat-hash-table-keys ()
+ (let ((ht (make-hash-table)))
+ (should (null (compat--hash-table-keys ht)))
+ (puthash 1 'one ht)
+ (should (equal '(1) (compat--hash-table-keys ht)))
+ (puthash 1 'one ht)
+ (should (equal '(1) (compat--hash-table-keys ht)))
+ (puthash 2 'two ht)
+ (should (memq 1 (compat--hash-table-keys ht)))
+ (should (memq 2 (compat--hash-table-keys ht)))
+ (should (= 2 (length (compat--hash-table-keys ht))))
+ (remhash 1 ht)
+ (should (equal '(2) (compat--hash-table-keys ht)))))
+
+(ert-deftest compat-hash-table-values ()
+ (let ((ht (make-hash-table)))
+ (should (null (compat--hash-table-values ht)))
+ (puthash 1 'one ht)
+ (should (equal '(one) (compat--hash-table-values ht)))
+ (puthash 1 'one ht)
+ (should (equal '(one) (compat--hash-table-values ht)))
+ (puthash 2 'two ht)
+ (should (memq 'one (compat--hash-table-values ht)))
+ (should (memq 'two (compat--hash-table-values ht)))
+ (should (= 2 (length (compat--hash-table-values ht))))
+ (remhash 1 ht)
+ (should (equal '(two) (compat--hash-table-values ht)))))
+
+(compat-deftests string-empty-p
+ (ought t "")
+ (ought nil " ")
+ (ought t (make-string 0 ?x))
+ (ought nil (make-string 1 ?x)))
+
+(compat-deftests string-join
+ (ought "" '(""))
+ (ought "" '("") " ")
+ (ought "a" '("a"))
+ (ought "a" '("a") " ")
+ (ought "abc" '("a" "b" "c"))
+ (ought "a b c" '("a" "b" "c") " "))
+
+(compat-deftests string-blank-p
+ (ought 0 "")
+ (ought 0 " ")
+ (ought 0 (make-string 0 ?x))
+ (ought nil (make-string 1 ?x)))
+
+(compat-deftests string-remove-prefix
+ (ought "" "" "")
+ (ought "a" "" "a")
+ (ought "" "a" "")
+ (ought "bc" "a" "abc")
+ (ought "abc" "c" "abc")
+ (ought "bbcc" "aa" "aabbcc")
+ (ought "aabbcc" "bb" "aabbcc")
+ (ought "aabbcc" "cc" "aabbcc")
+ (ought "aabbcc" "dd" "aabbcc"))
+
+(compat-deftests string-remove-suffix
+ (ought "" "" "")
+ (ought "a" "" "a")
+ (ought "" "a" "")
+ (ought "abc" "a" "abc")
+ (ought "ab" "c" "abc")
+ (ought "aabbcc" "aa" "aabbcc")
+ (ought "aabbcc" "bb" "aabbcc")
+ (ought "aabb" "cc" "aabbcc")
+ (ought "aabbcc" "dd" "aabbcc"))
+
+(let ((a (bool-vector t t nil nil))
+ (b (bool-vector t nil t nil)))
+ (compat-deftests bool-vector-exclusive-or
+ (ought (bool-vector nil t t nil) a b)
+ (ought (bool-vector nil t t nil) b a)
+ (ert-deftest compat-bool-vector-exclusive-or-sideeffect ()
+ (let ((c (make-bool-vector 4 nil)))
+ (compat--bool-vector-exclusive-or a b c)
+ (should (equal (bool-vector nil t t nil) c))
+ (should (equal (bool-vector nil t t nil) c))))
+ (when (version<= "24.4" emacs-version)
+ (expect wrong-length-argument a (bool-vector))
+ (expect wrong-length-argument a b (bool-vector)))
+ (expect wrong-type-argument (bool-vector) (vector))
+ (expect wrong-type-argument (vector) (bool-vector))
+ (expect wrong-type-argument (vector) (vector))
+ (expect wrong-type-argument (bool-vector) (bool-vector) (vector))
+ (expect wrong-type-argument (bool-vector) (vector) (vector))
+ (expect wrong-type-argument (vector) (bool-vector) (vector))
+ (expect wrong-type-argument (vector) (vector) (vector))))
+
+(let ((a (bool-vector t t nil nil))
+ (b (bool-vector t nil t nil)))
+ (compat-deftests bool-vector-union
+ (ought (bool-vector t t t nil) a b)
+ (ought (bool-vector t t t nil) b a)
+ (ert-deftest compat-bool-vector-union-sideeffect ()
+ (let ((c (make-bool-vector 4 nil)))
+ (compat--bool-vector-union a b c)
+ (should (equal (bool-vector t t t nil) c))))
+ (when (version<= "24.4" emacs-version)
+ (expect wrong-length-argument a (bool-vector))
+ (expect wrong-length-argument a b (bool-vector)))
+ (expect wrong-type-argument (bool-vector) (vector))
+ (expect wrong-type-argument (vector) (bool-vector))
+ (expect wrong-type-argument (vector) (vector))
+ (expect wrong-type-argument (bool-vector) (bool-vector) (vector))
+ (expect wrong-type-argument (bool-vector) (vector) (vector))
+ (expect wrong-type-argument (vector) (bool-vector) (vector))
+ (expect wrong-type-argument (vector) (vector) (vector))))
+
+(let ((a (bool-vector t t nil nil))
+ (b (bool-vector t nil t nil)))
+ (compat-deftests bool-vector-intersection
+ (ought (bool-vector t nil nil nil) a b)
+ (ought (bool-vector t nil nil nil) b a)
+ (ert-deftest compat-bool-vector-intersection-sideeffect ()
+ (let ((c (make-bool-vector 4 nil)))
+ (compat--bool-vector-intersection a b c)
+ (should (equal (bool-vector t nil nil nil) c))))
+ (when (version<= "24.4" emacs-version)
+ (expect wrong-length-argument a (bool-vector))
+ (expect wrong-length-argument a b (bool-vector)))
+ (expect wrong-type-argument (bool-vector) (vector))
+ (expect wrong-type-argument (vector) (bool-vector))
+ (expect wrong-type-argument (vector) (vector))
+ (expect wrong-type-argument (bool-vector) (bool-vector) (vector))
+ (expect wrong-type-argument (bool-vector) (vector) (vector))
+ (expect wrong-type-argument (vector) (bool-vector) (vector))
+ (expect wrong-type-argument (vector) (vector) (vector))))
+
+(let ((a (bool-vector t t nil nil))
+ (b (bool-vector t nil t nil)))
+ (compat-deftests bool-vector-set-difference
+ (ought (bool-vector nil t nil nil) a b)
+ (ought (bool-vector nil nil t nil) b a)
+ (ert-deftest compat-bool-vector-set-difference-sideeffect ()
+ (let ((c (make-bool-vector 4 nil)))
+ (compat--bool-vector-set-difference a b c)
+ (should (equal (bool-vector nil t nil nil) c)))
+ (let ((c (make-bool-vector 4 nil)))
+ (compat--bool-vector-set-difference b a c)
+ (should (equal (bool-vector nil nil t nil) c))))
+ (when (version<= "24.4" emacs-version)
+ (expect wrong-length-argument a (bool-vector))
+ (expect wrong-length-argument a b (bool-vector)))
+ (expect wrong-type-argument (bool-vector) (vector))
+ (expect wrong-type-argument (vector) (bool-vector))
+ (expect wrong-type-argument (vector) (vector))
+ (expect wrong-type-argument (bool-vector) (bool-vector) (vector))
+ (expect wrong-type-argument (bool-vector) (vector) (vector))
+ (expect wrong-type-argument (vector) (bool-vector) (vector))
+ (expect wrong-type-argument (vector) (vector) (vector))))
+
+(compat-deftests bool-vector-not
+ (ought (bool-vector) (bool-vector))
+ (ought (bool-vector t) (bool-vector nil))
+ (ought (bool-vector nil) (bool-vector t))
+ (ought (bool-vector t t) (bool-vector nil nil))
+ (ought (bool-vector t nil) (bool-vector nil t))
+ (ought (bool-vector nil t) (bool-vector t nil))
+ (ought (bool-vector nil nil) (bool-vector t t))
+ (expect wrong-type-argument (vector))
+ (expect wrong-type-argument (vector) (vector)))
+
+(compat-deftests bool-vector-subsetp
+ (ought t (bool-vector) (bool-vector))
+ (ought t (bool-vector t) (bool-vector t))
+ (ought t (bool-vector nil) (bool-vector t))
+ (ought nil (bool-vector t) (bool-vector nil))
+ (ought t (bool-vector nil) (bool-vector nil))
+ (ought t (bool-vector t t) (bool-vector t t))
+ (ought t (bool-vector nil nil) (bool-vector t t))
+ (ought t (bool-vector nil nil) (bool-vector t nil))
+ (ought t (bool-vector nil nil) (bool-vector nil t))
+ (ought nil (bool-vector t nil) (bool-vector nil nil))
+ (ought nil (bool-vector nil t) (bool-vector nil nil))
+ (when (version<= "24.4" emacs-version)
+ (expect wrong-length-argument (bool-vector nil) (bool-vector nil nil)))
+ (expect wrong-type-argument (bool-vector) (vector))
+ (expect wrong-type-argument (vector) (bool-vector))
+ (expect wrong-type-argument (vector) (vector)))
+
+(compat-deftests bool-vector-count-consecutive
+ (ought 0 (bool-vector nil) (bool-vector nil) 0)
+ (ought 0 (make-bool-vector 10 nil) t 0)
+ (ought 10 (make-bool-vector 10 nil) nil 0)
+ (ought 0 (make-bool-vector 10 nil) t 1)
+ (ought 9 (make-bool-vector 10 nil) nil 1)
+ (ought 0 (make-bool-vector 10 nil) t 1)
+ (ought 9 (make-bool-vector 10 t) t 1)
+ (ought 0 (make-bool-vector 10 nil) t 8)
+ (ought 2 (make-bool-vector 10 nil) nil 8)
+ (ought 2 (make-bool-vector 10 t) t 8)
+ (ought 10 (make-bool-vector 10 t) (make-bool-vector 10 t) 0)
+ (ought 4 (bool-vector t t t t nil t t t t t) t 0)
+ (ought 0 (bool-vector t t t t nil t t t t t) t 4)
+ (ought 5 (bool-vector t t t t nil t t t t t) t 5)
+ (expect wrong-type-argument (vector) nil 0))
+
+(compat-deftests bool-vector-count-population
+ (ought 0 (bool-vector))
+ (ought 0 (make-bool-vector 10 nil))
+ (ought 10 (make-bool-vector 10 t))
+ (ought 1 (bool-vector nil nil t nil))
+ (ought 1 (bool-vector nil nil nil t))
+ (ought 1 (bool-vector t nil nil nil))
+ (ought 2 (bool-vector t nil nil t))
+ (ought 2 (bool-vector t nil t nil))
+ (ought 3 (bool-vector t nil t t))
+ (expect wrong-type-argument (vector)))
+
+(compat-deftests compat-assoc-delete-all
+ (ought (list) 0 (list))
+ ;; Test `eq'
+ (ought '((1 . one)) 0 (list (cons 1 'one)))
+ (ought '((1 . one) a) 0 (list (cons 1 'one) 'a))
+ (ought '((1 . one)) 0 (list (cons 0 'zero) (cons 1 'one)))
+ (ought '((1 . one)) 0 (list (cons 0 'zero) (cons 0 'zero) (cons 1 'one)))
+ (ought '((1 . one)) 0 (list (cons 0 'zero) (cons 1 'one) (cons 0 'zero)))
+ (ought '((1 . one) a) 0 (list (cons 0 'zero) (cons 1 'one) 'a (cons 0
'zero)))
+ (ought '(a (1 . one)) 0 (list 'a (cons 0 'zero) (cons 1 'one) (cons 0
'zero)))
+ ;; Test `equal'
+ (ought '(("one" . one)) "zero" (list (cons "one" 'one)))
+ (ought '(("one" . one) a) "zero" (list (cons "one" 'one) 'a))
+ (ought '(("one" . one)) "zero" (list (cons "zero" 'zero) (cons "one" 'one)))
+ (ought '(("one" . one)) "zero" (list (cons "zero" 'zero) (cons "zero" 'zero)
(cons "one" 'one)))
+ (ought '(("one" . one)) "zero" (list (cons "zero" 'zero) (cons "one" 'one)
(cons "zero" 'zero)))
+ (ought '(("one" . one) a) "zero" (list (cons "zero" 'zero) (cons "one" 'one)
'a (cons "zero" 'zero)))
+ (ought '(a ("one" . one)) "zero" (list 'a (cons "zero" 'zero) (cons "one"
'one) (cons "zero" 'zero)))
+ ;; Test custom predicate
+ (ought '() 0 (list (cons 1 'one)) #'/=)
+ (ought '(a) 0 (list (cons 1 'one) 'a) #'/=)
+ (ought '((0 . zero)) 0 (list (cons 0 'zero) (cons 1 'one)) #'/=)
+ (ought '((0 . zero) (0 . zero)) 0 (list (cons 0 'zero) (cons 0 'zero) (cons
1 'one)) #'/=)
+ (ought '((0 . zero) (0 . zero)) 0 (list (cons 0 'zero) (cons 1 'one) (cons 0
'zero)) #'/=)
+ (ought '((0 . zero) a (0 . zero)) 0 (list (cons 0 'zero) (cons 1 'one) 'a
(cons 0 'zero)) #'/=)
+ (ought '(a (0 . zero) (0 . zero)) 0 (list 'a (cons 0 'zero) (cons 1 'one)
(cons 0 'zero)) #'/=))
+
+(compat-deftests color-values-from-color-spec
+ ;; #RGB notation
+ (ought '(0 0 0) "#000")
+ (ought '(0 0 0) "#000000")
+ (ought '(0 0 0) "#000000000")
+ (ought '(0 0 0) "#000000000000")
+ (ought '(0 0 65535) "#00F")
+ (ought '(0 0 65535) "#0000FF")
+ (ought '(0 0 65535) "#000000FFF")
+ (ought '(0 0 65535) "#00000000FFFF")
+ (ought '(0 0 65535) "#00f")
+ (ought '(0 0 65535) "#0000ff")
+ (ought '(0 0 65535) "#000000fff")
+ (ought '(0 0 65535) "#00000000ffff")
+ (ought '(0 0 65535) "#00000000ffFF")
+ (ought '(#xffff #x0000 #x5555) "#f05")
+ (ought '(#x1f1f #xb0b0 #xc5c5) "#1fb0C5")
+ (ought '(#x1f83 #xb0ad #xc5e2) "#1f83b0ADC5e2")
+ (ought nil "")
+ (ought nil "#")
+ (ought nil "#0")
+ (ought nil "#00")
+ (ought nil "#0000FG")
+ (ought nil "#0000FFF")
+ (ought nil "#0000FFFF")
+ (ought '(0 4080 65535) "#0000FFFFF")
+ (ought nil "#000FF")
+ (ought nil "#0000F")
+ (ought nil " #000000")
+ (ought nil "#000000 ")
+ (ought nil " #000000 ")
+ (ought nil "#1f83b0ADC5e2g")
+ (ought nil "#1f83b0ADC5e20")
+ (ought nil "#12345")
+ ;; rgb: notation
+ (ought '(0 0 0) "rgb:0/0/0")
+ (ought '(0 0 0) "rgb:0/0/00")
+ (ought '(0 0 0) "rgb:0/00/000")
+ (ought '(0 0 0) "rgb:0/000/0000")
+ (ought '(0 0 0) "rgb:000/0000/0")
+ (ought '(0 0 65535) "rgb:000/0000/F")
+ (ought '(65535 0 65535) "rgb:FFF/0000/F")
+ (ought '(65535 0 65535) "rgb:FFFF/0000/FFFF")
+ (ought '(0 255 65535) "rgb:0/00FF/FFFF")
+ (ought '(#xffff #x2323 #x28a2) "rgb:f/23/28a")
+ (ought '(#x1234 #x5678 #x09ab) "rgb:1234/5678/09ab")
+ (ought nil "rgb:/0000/FFFF")
+ (ought nil "rgb:0000/0000/FFFG")
+ (ought nil "rgb:0000/0000/FFFFF")
+ (ought nil "rgb:0000/0000")
+ (ought nil "rg:0000/0000/0000")
+ (ought nil "rgb: 0000/0000/0000")
+ (ought nil "rgbb:0000/0000/0000")
+ (ought nil "rgb:0000/0000/0000 ")
+ (ought nil " rgb:0000/0000/0000 ")
+ (ought nil " rgb:0000/0000/0000")
+ (ought nil "rgb:0000/ 0000 /0000")
+ (ought nil "rgb: 0000 /0000 /0000")
+ (ought nil "rgb:0//0")
+ ;; rgbi: notation
+ (ought '(0 0 0) "rgbi:0/0/0")
+ (ought '(0 0 0) "rgbi:0.0/0.0/0.0")
+ (ought '(0 0 0) "rgbi:0.0/0/0")
+ (ought '(0 0 0) "rgbi:0.0/0/0")
+ (ought '(0 0 0) "rgbi:0/0/0.")
+ (ought '(0 0 0) "rgbi:0/0/0.0000")
+ (ought '(0 0 0) "rgbi:0/0/.0")
+ (ought '(0 0 0) "rgbi:0/0/.0000")
+ (ought '(65535 0 0) "rgbi:1/0/0.0000")
+ (ought '(65535 0 0) "rgbi:1./0/0.0000")
+ (ought '(65535 0 0) "rgbi:1.0/0/0.0000")
+ (ought '(65535 32768 0) "rgbi:1.0/0.5/0.0000")
+ (ought '(6554 21843 65469) "rgbi:0.1/0.3333/0.999")
+ (ought '(0 32768 6554) "rgbi:0/0.5/0.1")
+ (ought '(66 655 65535) "rgbi:1e-3/1.0e-2/1e0")
+ (ought '(6554 21843 65469) "rgbi:1e-1/+0.3333/0.00999e2")
+ (ought nil "rgbi:1.0001/0/0")
+ (ought nil "rgbi:2/0/0")
+ (ought nil "rgbi:0.a/0/0")
+ (ought nil "rgbi:./0/0")
+ (ought nil "rgbi:./0/0")
+ (ought nil " rgbi:0/0/0")
+ (ought nil "rgbi:0/0/0 ")
+ (ought nil " rgbi:0/0/0 ")
+ (ought nil "rgbi:0 /0/ 0")
+ (ought nil "rgbi:0/ 0 /0")
+ (ought nil "rgbii:0/0/0")
+ (ought nil "rgbi :0/0/0")
+ ;; strtod ignores leading whitespace, making these legal colour
+ ;; specifications:
+ ;;
+ ;; (ought nil "rgbi: 0/0/0")
+ ;; (ought nil "rgbi: 0/ 0/ 0")
+ (ought nil "rgbi : 0/0/0")
+ (ought nil "rgbi:0/0.5/10"))
+
+(compat-deftests file-modes-number-to-symbolic
+ (ought "-rwx------" #o700)
+ (ought "-rwxrwx---" #o770)
+ (ought "-rwx---rwx" #o707)
+ (ought "-rw-r-xr--" #o654)
+ (ought "--wx-w---x" #o321)
+ (ought "drwx------" #o700 ?d)
+ (ought "?rwx------" #o700 ??)
+ (ought "lrwx------" #o120700)
+ (ought "prwx------" #o10700)
+ (ought "-rwx------" #o30700))
+
+(compat-deftests file-local-name
+ (ought "" "")
+ (ought "foo" "foo")
+ (ought "/bar/foo" "/bar/foo")
+ ;; These tests fails prior to Emacs 26, because /ssh:foo was a valid
+ ;; TRAMP path back then.
+ ;;
+ ;; (ought "/ssh:foo" "/ssh:foo")
+ ;; (ought "/ssh:/bar/foo" "/ssh:/bar/foo")
+ (ought "foo" "/ssh::foo")
+ (ought "/bar/foo" "/ssh::/bar/foo")
+ (ought ":foo" "/ssh:::foo")
+ (ought ":/bar/foo" "/ssh:::/bar/foo"))
+
+(compat-deftests file-name-quoted-p
+ (ought nil "")
+ (ought t "/:")
+ (ought nil "//:")
+ (ought t "/::")
+ (ought nil "/ssh::")
+ (ought nil "/ssh::a")
+ (ought t "/ssh::/:a")
+ ;; These tests fails prior to Emacs 26, because /ssh:foo was a valid
+ ;; TRAMP path back then.
+ ;;
+ ;; (ought nil "/ssh:/:a")
+ )
+
+(compat-deftests file-name-quote
+ (ought "/:" "")
+ (ought "/::" ":")
+ (ought "/:/" "/")
+ (ought "/:" "/:")
+ (ought "/:a" "a")
+ (ought "/::a" ":a")
+ (ought "/:/a" "/a")
+ (ought "/:a" "/:a")
+ (ought (concat "/ssh:" (system-name) ":/:a") "/ssh::a"))
+
+(compat-deftests make-lock-file-name
+ (ought (expand-file-name ".#") "")
+ (ought (expand-file-name ".#a") "a")
+ (ought (expand-file-name ".#foo") "foo")
+ (ought (expand-file-name ".#.") ".")
+ (ought (expand-file-name ".#.#") ".#")
+ (ought (expand-file-name ".#.a") ".a")
+ (ought (expand-file-name ".#.#") ".#")
+ (ought (expand-file-name "a/.#") "a/")
+ (ought (expand-file-name "a/.#b") "a/b")
+ (ought (expand-file-name "a/.#.#") "a/.#")
+ (ought (expand-file-name "a/.#.") "a/.")
+ (ought (expand-file-name "a/.#.b") "a/.b")
+ (ought (expand-file-name "a/.#foo") "a/foo")
+ (ought (expand-file-name "bar/.#b") "bar/b")
+ (ought (expand-file-name "bar/.#foo") "bar/foo"))
+
+(compat-deftests time-equal-p
+ (ought t nil nil)
+
+ ;; FIXME: Testing these values can be tricky, because the timestamp
+ ;; might change between evaluating (current-time) and evaluating
+ ;; `time-equal-p', especially in the interpreted compatibility
+ ;; version.
+
+ ;; (ought t (current-time) nil)
+ ;; (ought t nil (current-time))
+
+ ;; While `sleep-for' returns nil, indicating the current time, this
+ ;; behaviour seems to be undefined. Relying on it is therefore not
+ ;; advised.
+ (ought nil (current-time) (ignore (sleep-for 0.01)))
+ (ought nil (current-time) (progn
+ (sleep-for 0.01)
+ (current-time)))
+ (ought t '(1 2 3 4) '(1 2 3 4))
+ (ought nil '(1 2 3 4) '(1 2 3 5))
+ (ought nil '(1 2 3 5) '(1 2 3 4))
+ (ought nil '(1 2 3 4) '(1 2 4 4))
+ (ought nil '(1 2 4 4) '(1 2 3 4))
+ (ought nil '(1 2 3 4) '(1 3 3 4))
+ (ought nil '(1 3 3 4) '(1 2 3 4))
+ (ought nil '(1 2 3 4) '(2 2 3 4))
+ (ought nil '(2 2 3 4) '(1 2 3 4)))
+
+(compat-deftests date-days-in-month
+ (ought 31 2020 1)
+ (ought 30 2020 4)
+ (ought 29 2020 2)
+ (ought 28 2021 2))
+
+(compat-deftests decoded-time-period
+ (ought 0 '())
+ (ought 0 '(0))
+ (ought 1 '(1))
+ (ought 0.125 '((1 . 8)))
+
+ (ought 60 '(0 1))
+ (ought 61 '(1 1))
+ (ought -59 '(1 -1))
+
+ (ought (* 60 60) '(0 0 1))
+ (ought (+ (* 60 60) 60) '(0 1 1))
+ (ought (+ (* 60 60) 120 1) '(1 2 1))
+
+ (ought (* 60 60 24) '(0 0 0 1))
+ (ought (+ (* 60 60 24) 1) '(1 0 0 1))
+ (ought (+ (* 60 60 24) (* 60 60) 60 1) '(1 1 1 1))
+ (ought (+ (* 60 60 24) (* 60 60) 120 1) '(1 2 1 1))
+
+ (ought (* 60 60 24 30) '(0 0 0 0 1))
+ (ought (+ (* 60 60 24 30) 1) '(1 0 0 0 1))
+ (ought (+ (* 60 60 24 30) 60 1) '(1 1 0 0 1))
+ (ought (+ (* 60 60 24 30) (* 60 60) 60 1)
+ '(1 1 1 0 1))
+ (ought (+ (* 60 60 24 30) (* 60 60 24) (* 60 60) 120 1)
+ '(1 2 1 1 1))
+
+ (ought (* 60 60 24 365) '(0 0 0 0 0 1))
+ (ought (+ (* 60 60 24 365) 1)
+ '(1 0 0 0 0 1))
+ (ought (+ (* 60 60 24 365) 60 1)
+ '(1 1 0 0 0 1))
+ (ought (+ (* 60 60 24 365) (* 60 60) 60 1)
+ '(1 1 1 0 0 1))
+ (ought (+ (* 60 60 24 365) (* 60 60 24) (* 60 60) 60 1)
+ '(1 1 1 1 0 1))
+ (ought (+ (* 60 60 24 365)
+ (* 60 60 24 30)
+ (* 60 60 24)
+ (* 60 60)
+ 120 1)
+ '(1 2 1 1 1 1))
+
+ (expect wrong-type-argument 'a)
+ (expect wrong-type-argument '(0 a))
+ (expect wrong-type-argument '(0 0 a))
+ (expect wrong-type-argument '(0 0 0 a))
+ (expect wrong-type-argument '(0 0 0 0 a))
+ (expect wrong-type-argument '(0 0 0 0 0 a)))
+
+(compat-deftests subr-primitive-p
+ (ought t (symbol-function 'identity)) ;function from fns.c
+ (ought nil (symbol-function 'match-string)) ;function from subr.el
+ (ought nil (symbol-function 'defun)) ;macro from subr.el
+ (ought nil nil))
(ert-deftest compat-string-limit ()
"Check if `compat-string-limit' was implemented properly."
@@ -1444,5 +1944,20 @@ the compatibility function."
(compat--should nil 5 'bold)
(compat--should nil 8 'width))))
+(compat-deftests file-name-absolute-p ;assuming unix
+ (ought t "/")
+ (ought t "/a")
+ (ought nil "a")
+ (ought nil "a/b")
+ (ought nil "a/b/")
+ (ought t "~")
+ (when (version< "27.1" emacs-version)
+ (ought t "~/foo")
+ (ought nil "~foo")
+ (ought nil "~foo/"))
+ (ought t "~root")
+ (ought t "~root/")
+ (ought t "~root/file"))
+
(provide 'compat-tests)
;;; compat-tests.el ends here
diff --git a/compat.el b/compat.el
index c94a2f15e8..2cfd342057 100644
--- a/compat.el
+++ b/compat.el
@@ -1,12 +1,12 @@
-;;; compat.el --- Compatibility Library -*- lexical-binding: t;
-*-
+;;; compat.el --- Emacs Lisp Compatibility Library -*- lexical-binding: t; -*-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
+;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: 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") (nadvice "0.3"))
+;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
+;; Version: 28.1.2.0
+;; URL: https://sr.ht/~pkal/compat
+;; Package-Requires: ((emacs "24.3") (nadvice "0.3"))
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
@@ -39,145 +39,19 @@
;;; Code:
-(eval-when-compile (require 'compat-macs))
-
-;;;; Core functionality
-
-;; 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)
- "A reimplementation of `func-arity' for FUNC."
- (cond
- ((or (null func) (and (symbolp func) (not (fboundp func))) )
- (signal 'void-function func))
- ((and (symbolp func) (not (null func)))
- (compat-func-arity (symbol-function func)))
- ((eq (car-safe func) 'macro)
- (compat-func-arity (cdr func)))
- ((subrp func)
- (subr-arity func))
- ((memq (car-safe func) '(closure lambda))
- ;; See lambda_arity from eval.c
- (when (eq (car func) 'closure)
- (setq func (cdr func)))
- (let ((syms-left (if (consp func)
- (car func)
- (signal 'invalid-function func)))
- (min-args 0) (max-args 0) optional)
- (catch 'many
- (dolist (next syms-left)
- (cond
- ((not (symbolp next))
- (signal 'invalid-function func))
- ((eq next '&rest)
- (throw 'many (cons min-args 'many)))
- ((eq next '&optional)
- (setq optional t))
- (t (unless optional
- (setq min-args (1+ min-args)))
- (setq max-args (1+ max-args)))))
- (cons min-args max-args))))
- ((and (byte-code-function-p func) (numberp (aref func 0)))
- ;; See get_byte_code_arity from bytecode.c
- (let ((at (aref func 0)))
- (cons (logand at 127)
- (if (= (logand at 128) 0)
- (ash at -8)
- 'many))))
- ((and (byte-code-function-p func) (numberp (aref func 0)))
- ;; See get_byte_code_arity from bytecode.c
- (let ((at (aref func 0)))
- (cons (logand at 127)
- (if (= (logand at 128) 0)
- (ash at -8)
- 'many))))
- ((and (byte-code-function-p func) (listp (aref func 0)))
- ;; Based on `byte-compile-make-args-desc', this is required for
- ;; old versions of Emacs that don't use a integer for the argument
- ;; list description, per e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6.
- (let ((arglist (aref func 0)) (mandatory 0) nonrest)
- (while (and arglist (not (memq (car arglist) '(&optional &rest))))
- (setq mandatory (1+ mandatory))
- (setq arglist (cdr arglist)))
- (setq nonrest mandatory)
- (when (eq (car arglist) '&optional)
- (setq arglist (cdr arglist))
- (while (and arglist (not (eq (car arglist) '&rest)))
- (setq nonrest (1+ nonrest))
- (setq arglist (cdr arglist))))
- (cons mandatory (if arglist 'many nonrest))))
- ((autoloadp func)
- (autoload-do-load func)
- (compat-func-arity func))
- ((signal 'invalid-function func))))
-
-(eval-and-compile
- (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)) n))
- (void-function t))))
-
-;; Load the actual compatibility definitions:
-(require 'compat-24.4)
-(require 'compat-25.1)
-(require 'compat-26.1)
-(require 'compat-27.1)
-(require 'compat-28.1)
-(require 'compat-29.1)
-
-;;;; Etcetera
-
-;; To ensure that compat.el is loaded as soon as possible, a require
-;; 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"))))
+(defvar compat--inhibit-prefixed)
+(let ((compat--inhibit-prefixed (not (bound-and-true-p compat-testing))))
+ ;; Instead of using `require', we manually check `features' and call
+ ;; `load' to avoid the issue of not using `provide' at the end of
+ ;; the file (which is disabled by `compat--inhibit-prefixed', so
+ ;; that the file can be loaded again at some later point when the
+ ;; prefixed definitions are needed).
+ (dolist (vers '(24 25 26 27 28))
+ (unless (memq (intern (format "compat-%d" vers)) features)
+ (load (format "compat-%d%s" vers
+ (if (bound-and-true-p compat-testing)
+ ".el" ""))
+ nil t))))
(provide 'compat)
;;; compat.el ends here
diff --git a/compat.texi b/compat.texi
new file mode 100644
index 0000000000..2335e99721
--- /dev/null
+++ b/compat.texi
@@ -0,0 +1,1163 @@
+\input texinfo @c -*- texinfo -*-
+@c %**start of header
+@setfilename compat.info
+@settitle "Compat" Manual
+@documentencoding UTF-8
+@documentlanguage en
+@c %**end of header
+
+@copying
+Copyright @copyright{} 2022 Free Software Foundation, Inc.
+
+@quotation
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with the Front-Cover Texts being “A GNU Manual,” and
+with the Back-Cover Texts as in (a) below. A copy of the license is
+included in the section entitled “GNU Free Documentation License.”
+
+(a) The FSF’s Back-Cover Text is: “You have the freedom to copy and
+modify this GNU manual.”
+
+@end quotation
+@end copying
+
+@dircategory Emacs
+@direntry
+* Compat: (compat). Compatibility Library for Emacs Lisp.
+@end direntry
+
+@finalout
+@titlepage
+@title "Compat" Manual
+@subtitle For version 28.1.2.0
+@author Philip Kaludercic
+@page
+@vskip 0pt plus 1filll
+@insertcopying
+@end titlepage
+
+@contents
+
+@ifnottex
+@node Top
+@top "Compat" Manual
+
+This manual documents the usage of the "Compat" Emacs lisp library,
+the forward-compatibility library for Emacs Lisp, corresponding to
+version 28.1.2.0.
+
+@insertcopying
+@end ifnottex
+
+@menu
+* Introduction::
+* Support::
+* Development::
+* Function Index::
+* Variable Index::
+
+@detailmenu
+--- The Detailed Node Listing ---
+
+Introduction
+
+* Overview::
+* Usage::
+* Intentions::
+
+Usage
+
+* Additional libraries::
+
+Support
+
+* Emacs 24.4:: Compatibility support for Emacs 24.4
+* Emacs 24.5:: Compatibility support for Emacs 24.5
+* Emacs 25.1:: Compatibility support for Emacs 25.1
+* Emacs 26.1:: Compatibility support for Emacs 26.1
+* Emacs 27.1:: Compatibility support for Emacs 27.1
+* Emacs 28.1:: Compatibility support for Emacs 28.1
+
+@end detailmenu
+@end menu
+
+@node Introduction
+@chapter Introduction
+
+@menu
+* Overview::
+* Usage::
+* Intentions::
+@end menu
+
+@node Overview
+@section Overview
+
+The objective of Compat is to provide "forwards compatibility"
+library for Emacs Lisp. That is to say by using Compat, an Elisp
+package does not have to make the decision to either use new and
+useful functionality or support old versions of Emacs.
+
+Version 24.3 is chosen as the oldest version, because this is the
+newest version on CentOS 7. It is intended to preserve compatibility
+for at least as the Centos 7 reaches
@uref{https://wiki.centos.org/About/Product, EOL}, 2024.
+
+If you are developing a package with Compat in mind, consider 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.
+
+Note that Compat provides a few prefixed function, ie. functions with
+a @code{compat-} prefix. These are used to provide extended functionality
+for commands that are already defined (@code{sort}, @code{assoc}, @code{seq},
@dots{}).
+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.
+
+@node Usage
+@section Usage
+
+The intended use-case for this library is for package developers to
+add as a dependency in the header:
+
+@example
+;; Package-Requires: ((emacs "24.3") (compat "28.1.2.0"))
+@end example
+
+
+and later on a
+
+@example
+(require 'compat)
+@end example
+
+
+This will load all non-prefixed definitions (functions and macros with
+a leading `compat-`). To load these, an additional
+
+@example
+(require 'compat-XY) ; e.g. 26
+@end example
+
+
+will be necessary, to load compatibility code for Emacs version XY@.
+
+It is recommended to subscribe to the
@uref{https://lists.sr.ht/~pkal/compat-announce, compat-announce} mailing list
to
+be notified when new versions are released or relevant changes are
+made.
+
+@menu
+* Additional libraries::
+@end menu
+
+@node Additional libraries
+@subsection Additional libraries
+
+These libraries are packages with Compat, but are disabled by default.
+To use them you can use @code{M-x load-library}:
+
+@table @asis
+@item compat-help
+Add notes to @code{*Help*} buffer, if a compatibility
+definition has something to warn you about.
+@item compat-font-lock
+Highlight functions that are implemented as
+compatibility definitions.
+@end table
+
+@node Intentions
+@section Intentions
+
+The library intends to provide support back until Emacs 24.3. The
+intended audience are package developers that are interested in using
+newer developments, without having to break compatibility.
+
+Sadly, total backwards compatibility cannot be provided for technical
+reasons. These might include:
+
+@itemize
+@item
+An existing function or macro was extended by some new functionality. To
+support these cases, the function or macro would have to be advised.
+As this is usually regarded as invasive and is shown to be a
+significant overhead, even when the new feature is not used, this
+approach is not used.
+
+As a compromise, prefixed functions and macros (starting with a
+@code{compat-} prefix) can be provided.
+
+@item
+New functionality was implemented in the core, and depends on
+external libraries that cannot be reasonably duplicated in the scope
+of a compatibility library.
+
+@item
+New functionality depends on an entire new, non-trivial library.
+Sometimes these are provided via ELPA (xref, project, @dots{}), but other
+times it would be infeasible to duplicate an entire library within
+Compat while also providing the necessary backwards compatibility.
+
+@item
+It just wasn't added, and there is no good reason (though good
+excuses might exist). If you happen to find such a function,
+@ref{Development, , reporting} it would be much appreciated.
+
+Always begin by assuming that this might be the case, unless proven
+otherwise.
+@end itemize
+
+@node Support
+@chapter Support
+
+This section goes into the features that Compat manages and doesn't
+manage to provide for each Emacs version.
+
+@menu
+* Emacs 24.4:: Compatibility support for Emacs 24.4
+* Emacs 24.5:: Compatibility support for Emacs 24.5
+* Emacs 25.1:: Compatibility support for Emacs 25.1
+* Emacs 26.1:: Compatibility support for Emacs 26.1
+* Emacs 27.1:: Compatibility support for Emacs 27.1
+* Emacs 28.1:: Compatibility support for Emacs 28.1
+@end menu
+
+@node Emacs 24.4
+@section Emacs 24.4
+
+The following functions and macros implemented in 24.4, and are
+provided by Compat by default:
+
+@defmac with-eval-after-load
+See @ref{Hooks for Loading,Hooks for Loading,,elisp,}.
+@end defmac
+
+@defun special-form-p
+See @ref{Special Forms,Special Forms,,elisp,}.
+@end defun
+
+@defun macrop
+See @ref{Simple Macro,Simple Macro,,elisp,}.
+@end defun
+
+@defun string-suffix-p
+See @ref{Text Comparison,Text Comparison,,elisp,}.
+@end defun
+
+@defun delete-consecutive-dups
+Defined in @code{subr.el}.
+@end defun
+
+@defun define-error
+See @ref{Error Symbols,Error Symbols,,elisp,}.
+@end defun
+
+@defun bool-vector-exclusive-or
+See @ref{Bool-Vectors,Bool-Vectors,,elisp,}.
+@end defun
+
+@defun bool-vector-union
+See @ref{Bool-Vectors,Bool-Vectors,,elisp,}.
+@end defun
+
+@defun bool-vector-intersection
+See @ref{Bool-Vectors,Bool-Vectors,,elisp,}.
+@end defun
+
+@defun bool-vector-not
+See @ref{Bool-Vectors,Bool-Vectors,,elisp,}.
+@end defun
+
+@defun bool-vector-subsetp
+See @ref{Bool-Vectors,Bool-Vectors,,elisp,}.
+@end defun
+
+@defun bool-vector-count-consecutive
+See @ref{Bool-Vectors,Bool-Vectors,,elisp,}.
+@end defun
+
+@defun bool-vector-count-population
+See @ref{Bool-Vectors,Bool-Vectors,,elisp,}.
+@end defun
+
+@defun completion-table-merge
+See @ref{Basic Completion,Basic Completion,,elisp,}.
+@end defun
+
+@defun completion-table-with-cache
+See @ref{Programmed Completion,Programmed
+ Completion,,elisp,}.
+@end defun
+
+@defun face-spec-set
+See @ref{Defining Faces,Defining Faces,,elisp,}.
+@end defun
+
+These functions are prefixed with @code{compat} prefix, and are only loaded
+when @code{compat-24} is required:
+
+@defun compat-=
+@end defun
+@defun compat-<
+@end defun
+@defun compat->
+@end defun
+@defun compat-<=
+@end defun
+@defun compat->=
+See @ref{Comparison of Numbers,Comparison of Numbers,,elisp,}.
+
+Allows for more than two arguments to be compared.
+@end defun
+
+@defun compat-split-string
+See @ref{Creating Strings,Creating Strings,,elisp,}.
+
+Takes optional argument TRIM@.
+@end defun
+
+Compat does not provide support for the following Lisp features
+implemented in 24.4:
+
+@itemize
+@item
+Allowing the second optional argument to @code{eval} to specify a lexical
+environment.
+@item
+The @code{define-alternatives} macro.
+@item
+Support for the @code{defalias-fset-function} symbol property.
+@item
+The @code{group-gid} and @code{groupd-read-gid} functions.
+@item
+The @code{pre-redisplay-function} hook.
+@item
+Allowing for @code{with-demoted-errors} to take a additional argument
@code{format}.
+@item
+The @code{face-spec-set} function.
+@item
+The @code{add-face-text-property} function.
+@item
+No @code{tty-setup-hook} hook.
+@item
+The @code{get-pos-property} function.
+@item
+The @code{define-advice} macro.
+@item
+Support for generators.
+@item
+The @code{string-trim}, @code{string-trim-left} and @code{string-trim-right}
+functions. These are instead provided as prefixed function as part
+of @ref{Emacs 26.1} support.
+@end itemize
+
+@node Emacs 24.5
+@section Emacs 24.5
+
+No special support for 24.5 was deemed necessary.
+
+@node Emacs 25.1
+@section Emacs 25.1
+
+The following functions and macros implemented in 25.1, and are
+provided by Compat by default:
+
+@defun format-message
+See @ref{Formatting Strings,Formatting Strings,,elisp,}.
+@end defun
+
+@defun directory-name-p
+See @ref{Directory Names,Directory Names,,elisp,}.
+@end defun
+
+@defun string-greaterp
+See @ref{Text Comparison,Text Comparison,,elisp,}.
+@end defun
+
+@defmac with-file-modes
+See @ref{Changing Files,Changing Files,,elisp,}.
+@end defmac
+
+@defun alist-get
+See @ref{Association Lists,Association Lists,,elisp,}.
+@end defun
+
+@defmac if-let
+Defined in @code{subr-x.el}.
+@end defmac
+
+@defmac when-let
+Defined in @code{subr-x.el}.
+@end defmac
+
+@defmac thread-first
+Defined in @code{subr-x.el}.
+@end defmac
+
+@defmac thread-last
+Defined in @code{subr-x.el}.
+@end defmac
+
+@defun macroexpand-1
+See @ref{Expansion,Expansion,,elisp,}.
+@end defun
+
+@defun directory-files-recursively
+See @ref{Contents of Directories,Contents of
+ Directories,,elisp,}.
+@end defun
+
+@defun bool-vector
+See @ref{Bool-Vectors,Bool-Vectors,,elisp,}.
+@end defun
+
+These functions are prefixed with @code{compat} prefix, and are only loaded
+when @code{compat-25} is required:
+
+@defun compat-sort
+See @ref{Sequence Functions,Sequence Functions,,elisp,}.
+
+Adds support for vectors to be sorted, next to just lists.
+@end defun
+
+Compat does not provide support for the following Lisp features
+implemented in 25.1:
+
+@itemize
+@item
+New @code{pcase} patterns.
+@item
+The hook @code{prefix-command-echo-keystrokes-functions} and
+@code{prefix-command-preserve-state-hook}.
+@item
+The hook @code{pre-redisplay-functions}.
+@item
+The function @code{make-process}.
+@item
+Support for the variable @code{inhibit-message}.
+@item
+The @code{define-inline} functionality.
+@item
+The functions @code{string-collate-lessp} and @code{string-collate-equalp}.
+@item
+Support for @code{alist-get} as a generalised variable.
+@item
+The function @code{funcall-interactivly}.
+@item
+The function @code{buffer-substring-with-bidi-context}.
+@item
+The function @code{font-info}.
+@item
+The function @code{default-font-width}.
+@item
+The function @code{window-font-height} and @code{window-font-width}.
+@item
+The function @code{window-max-chars-per-line}.
+@item
+The function @code{set-binary-mode}.
+@item
+The functions @code{bufferpos-to-filepos} and @code{filepos-to-bufferpos}.
+@end itemize
+
+Note that the changes in Emacs 25.2 and 25.3 are also included here,
+for the sake of simplicity.
+
+@node Emacs 26.1
+@section Emacs 26.1
+
+The following functions and macros implemented in 26.1, and are
+provided by Compat by default:
+
+@defun func-arity
+See @ref{What Is a Function,What Is a Function,,elisp,}.
+@end defun
+
+@defun mapcan
+See @ref{Mapping Functions,Mapping Functions,,elisp,}.
+@end defun
+
+@defun cXXXr
+@end defun
+@defun cXXXXr
+See @ref{List Elements,List Elements,,elisp,}.
+@end defun
+
+@defvar gensym-counter
+See @code{gensym}.
+@end defvar
+
+@defun gensym
+See @ref{Creating Symbols,Creating Symbols,,elisp,}.
+@end defun
+
+@defun make-nearby-temp-file
+See @ref{Unique File Names,Unique File Names,,elisp,}.
+@end defun
+
+@defvar mounted-file-systems
+Defined in @code{files.el}.
+@end defvar
+
+@defun temporary-file-directory
+See @ref{Unique File Names,Unique File Names,,elisp,}.
+@end defun
+
+@defmac if-let*
+Defined in @code{subr-x.el}.
+@end defmac
+
+@defmac when-let*
+Defined in @code{subr-x.el}.
+@end defmac
+
+@defmac and-let*
+Defined in @code{subr-x.el}.
+
+@strong{@strong{Please Note:}} The implementation provided by Compat does not
+include a bug that was observed with Emacs 26 (see
@uref{https://debbugs.gnu.org/cgi/bugreport.cgi?bug=31840}).
+@end defmac
+
+@defun file-local-name
+See @ref{Magic File Names,Magic File Names,,elisp,}.
+@end defun
+
+@defun file-name-quoted-p
+See @ref{File Name Expansion,File Name Expansion,,elisp,}.
+@end defun
+
+@defun file-name-quote
+See @ref{File Name Expansion,File Name Expansion,,elisp,}.
+@end defun
+
+@defun image-property
+Defined in @code{image.el}.
+
+This function can also be used as a generalised variable. To use
+this you need to explicitly require @code{compat-26}.
+@end defun
+
+@defun file-attribute-type
+See @ref{File Attributes,File Attributes,,elisp,}.
+@end defun
+
+@defun file-attribute-link-number
+See @ref{File Attributes,File Attributes,,elisp,}.
+@end defun
+
+@defun file-attribute-user-id
+See @ref{File Attributes,File Attributes,,elisp,}.
+@end defun
+
+@defun file-attribute-group-id
+See @ref{File Attributes,File Attributes,,elisp,}.
+@end defun
+
+@defun file-attribute-access-time
+See @ref{File Attributes,File Attributes,,elisp,}.
+@end defun
+
+@defun file-attribute-modification-time
+See @ref{File Attributes,File Attributes,,elisp,}.
+@end defun
+
+@defun file-attribute-status-change-time
+See @ref{File Attributes,File Attributes,,elisp,}.
+@end defun
+
+@defun file-attribute-size
+See @ref{File Attributes,File Attributes,,elisp,}.
+@end defun
+
+@defun file-attribute-modes
+See @ref{File Attributes,File Attributes,,elisp,}.
+@end defun
+
+@defun file-attribute-inode-number
+See @ref{File Attributes,File Attributes,,elisp,}.
+@end defun
+
+@defun file-attribute-device-number
+See @ref{File Attributes,File Attributes,,elisp,}.
+@end defun
+
+@defun file-attribute-collect
+Defined in @code{files.el}.
+@end defun
+
+These functions are prefixed with @code{compat} prefix, and are only loaded
+when @code{compat-26} is required:
+
+@defun compat-assoc
+See @ref{Association Lists,Association Lists,,elisp,}.
+
+Handle the optional argument TESTFN@.
+@end defun
+
+@defun compat-line-number-at-pos
+See @ref{Text Lines,Text Lines,,elisp,}.
+
+Handle the optional argument ABSOLUTE@.
+@end defun
+
+@defun compat-alist-get
+See @ref{Association Lists,Association Lists,,elisp,}.
+
+Handle the optional argument TESTFN@. Can also be used as a
+generalised variable.
+@end defun
+
+@defun compat-string-trim-left
+See @ref{Creating Strings,Creating Strings,,elisp,}.
+
+Handles the optional argument REGEXP@.
+@end defun
+
+@defun compat-string-trim-right
+See @ref{Creating Strings,Creating Strings,,elisp,}.
+
+Handles the optional argument REGEXP@.
+@end defun
+
+@defun compat-string-trim
+See @ref{Creating Strings,Creating Strings,,elisp,}.
+
+Handles the optional arguments TRIM-LEFT and TRIM-RIGHT@.
+@end defun
+
+Compat does not provide support for the following Lisp features
+implemented in 26.1:
+
+@itemize
+@item
+The function @code{secure-hash-algorithms}.
+@item
+The function @code{gnutls-avalaible-p}.
+@item
+Support for records and record functions.
+@item
+The function @code{mapbacktrace}.
+@item
+The function @code{file-name-case-insensitive-p}.
+@item
+The file-attributes constructors.
+@item
+The function @code{read-multiple-choice}.
+@item
+The additional elements of @code{parse-partial-sexp}.
+@item
+The function @code{add-variable-watcher}.
+@item
+The function @code{undo-amalgamate-change-group}.
+@item
+The function @code{char-from-name}
+@item
+Signalling errors when @code{length} or @code{member} deal with list cycles.
+@item
+The function @code{frame-list-z-order}.
+@item
+The function @code{frame-restack}.
+@item
+Support for side windows and atomic windows.
+@item
+All changes related to @code{display-buffer}.
+@item
+The function @code{window-swap-states}.
+@end itemize
+
+Note that the changes in Emacs 26.2 and 26.3 are also included here,
+for the sake of simplicity.
+
+@node Emacs 27.1
+@section Emacs 27.1
+
+The following functions and macros implemented in 27.1, and are
+provided by Compat by default:
+
+@defun proper-list-p
+See @ref{List-related Predicates,List-related Predicates,,elisp,}.
+@end defun
+
+@defun string-distance
+See @ref{Text Comparison,Text Comparison,,elisp,}.
+@end defun
+
+@defun json-serialize
+See @ref{Parsing JSON,Parsing JSON,,elisp,}.
+@end defun
+
+@defun json-insert
+See @ref{Parsing JSON,Parsing JSON,,elisp,}.
+@end defun
+
+@defun json-parse-string
+See @ref{Parsing JSON,Parsing JSON,,elisp,}.
+@end defun
+
+@defun json-parse-buffer
+See @ref{Parsing JSON,Parsing JSON,,elisp,}.
+@end defun
+
+@defmac ignore-error
+See @ref{Handling Errors,Handling Errors,,elisp,}.
+@end defmac
+
+@defmac dolist-with-progress-reporter
+See @ref{Progress,Progress,,elisp,}.
+@end defmac
+
+@defun flatten-tree
+See @ref{Building Lists,Building Lists,,elisp,}.
+@end defun
+
+@defun xor
+See @ref{Combining Conditions,Combining Conditions,,elisp,}.
+@end defun
+
+@defvar regexp-unmatchable
+Defined in @code{subr.el}.
+@end defvar
+
+@defun decoded-time-second
+Defined in @code{simple.el}.
+@end defun
+
+@defun decoded-time-minute
+Defined in @code{simple.el}.
+@end defun
+
+@defun decoded-time-hour
+Defined in @code{simple.el}.
+@end defun
+
+@defun decoded-time-day
+Defined in @code{simple.el}.
+@end defun
+
+@defun decoded-time-month
+Defined in @code{simple.el}.
+@end defun
+
+@defun decoded-time-year
+Defined in @code{simple.el}.
+@end defun
+
+@defun decoded-time-weekday
+Defined in @code{simple.el}.
+@end defun
+
+@defun decoded-time-dst
+Defined in @code{simple.el}.
+@end defun
+
+@defun decoded-time-zone
+Defined in @code{simple.el}.
+@end defun
+
+@defun package-get-version
+Defined in @code{package.el}.
+@end defun
+
+@defun time-equal-p
+See @ref{Time Calculations,Time Calculations,,elisp,}.
+@end defun
+
+@defun date-days-in-month
+See @ref{Time Calculations,Time Calculations,,elisp,}.
+@end defun
+
+@defun exec-path
+See @ref{Subprocess Creation,Subprocess Creation,,elisp,}.
+
+This function requires the @code{time-date} feature to be loaded.
+@end defun
+
+These functions are prefixed with @code{compat} prefix, and are only loaded
+when @code{compat-27} is required:
+
+@defun compat-recenter
+See @ref{Textual Scrolling,Textual Scrolling,,elisp,}.
+
+Adds the optional argument REDISPLAY@.
+@end defun
+
+@defun compat-lookup-key
+See @ref{Low-Level Key Binding,Low-Level Key Binding,,elisp,}.
+
+Allows KEYMAP to be a list of keymaps.
+@end defun
+
+@defmac compat-setq-local
+See @ref{Creating Buffer-Local,Creating Buffer-Local,,elisp,}.
+
+Allow for more than one variable to be set.
+@end defmac
+
+@defun compat-regexp-opt
+See @ref{Regexp Functions,Regexp Functions,,elisp,}.
+
+Handle an empty list of strings.
+@end defun
+
+@defun compat-file-size-human-readable
+Defined in @code{files.el}.
+
+Handle the optional third (SPACE) and forth (UNIT) arguments.
+@end defun
+
+@defun compat-assoc-delete-all
+See @ref{Association Lists,Association Lists,,elisp,}.
+
+Handle the optional third (TESTFN) argument.
+@end defun
+
+@defun compat-executable-find
+@ref{Locating Files,Locating Files,,elisp,}.
+
+Handle the optional second (REMOTE) argument.
+@end defun
+
+@defun compat-dired-get-marked-files
+Defined in @code{dired.el}
+
+Handles the optional fifth (ERROR) argument.
+@end defun
+
+Compat does not provide support for the following Lisp features
+implemented in 27.1:
+
+@itemize
+@item
+Bigint support.
+@item
+The function @code{time-convert}.
+@item
+All @code{iso8601-*} functions.
+@item
+The macro @code{benchmark-progn}.
+@item
+The function @code{read-char-from-minibuffer}.
+@item
+The minor mode @code{reveal-mode}.
+@item
+The macro @code{with-suppressed-warnings}.
+@item
+Support for @code{condition-case} to handle t.
+@item
+The functions @code{major-mode-suspend} and @code{major-mode-restore}.
+@item
+The function @code{provided-mode-derived-p}.
+@item
+The function @code{file-system-info}.
+@item
+The more consistent treatment of NaN values.
+@item
+The function @code{ring-resize}.
+@item
+The function @code{group-name}.
+@item
+Additional @code{format-spec} modifiers.
+@item
+Support for additional body forms for
+@code{define-globalized-minor-mode}.
+@item
+The macro @code{with-connection-local-variables} and related
+functionality.
+@end itemize
+
+Note that the changes in Emacs 27.2 are also included here, for the
+sake of simplicity.
+
+@node Emacs 28.1
+@section Emacs 28.1
+
+The following functions and macros implemented in 28.1, and are
+provided by Compat by default:
+
+@defun string-search
+See @ref{Text Comparison,Text Comparison,,elisp,}.
+@end defun
+
+@defun length=
+See @ref{Sequence Functions,Sequence Functions,,elisp,}.
+@end defun
+
+@defun length<
+See @ref{Sequence Functions,Sequence Functions,,elisp,}.
+@end defun
+
+@defun length>
+See @ref{Sequence Functions,Sequence Functions,,elisp,}.
+@end defun
+
+@defun file-name-concat
+See @ref{Directory Names,Directory Names,,elisp,}.
+@end defun
+
+@defun garbage-collect-maybe
+Defined in @code{alloc.c}.
+@end defun
+
+@defun string-replace
+See @ref{Search and Replace,Search and Replace,,elisp,}.
+@end defun
+
+@defun always
+@ref{Calling Functions,Calling Functions,,elisp,}.
+@end defun
+
+@defun insert-into-buffer
+See @ref{Insertion,Insertion,,elisp,}.
+@end defun
+
+@defun replace-regexp-in-region
+See @ref{Search and Replace,Search and Replace,,elisp,}.
+@end defun
+
+@defun replace-string-in-region
+See @ref{Search and Replace,Search and Replace,,elisp,}.
+@end defun
+
+@defun buffer-local-boundp
+See @ref{Creating Buffer-Local,Creating Buffer-Local,,elisp,}.
+@end defun
+
+@defun with-existing-directory
+See @ref{Testing Accessibility,Testing Accessibility,,elisp,}.
+@end defun
+
+@defmac dlet
+See @ref{Local Variables,Local Variables,,elisp,}.
+@end defmac
+
+@defun ensure-list
+See @ref{Building Lists,Building Lists,,elisp,}.
+@end defun
+
+@defun string-clean-whitespace
+See @ref{Creating Strings,Creating Strings,,elisp,}.
+@end defun
+
+@defun string-fill
+See @ref{Creating Strings,Creating Strings,,elisp,}.
+@end defun
+
+@defun string-lines
+See @ref{Creating Strings,Creating Strings,,elisp,}.
+@end defun
+
+@defun string-pad
+See @ref{Creating Strings,Creating Strings,,elisp,}.
+@end defun
+
+@defun string-chop-newline
+See @ref{Creating Strings,Creating Strings,,elisp,}.
+@end defun
+
+@defmac named-let
+See @ref{Local Variables,Local Variables,,elisp,}.
+@end defmac
+
+@defun file-name-with-extension
+See @ref{File Name Components,File Name
+ Components,,elisp,}.
+@end defun
+
+@defun directory-empty-p
+See @ref{Contents of Directories,Contents of Directories,,elisp,}.
+@end defun
+
+@defun format-prompt
+See @ref{Text from Minibuffer,Text from Minibuffer,,elisp,}.
+@end defun
+
+@defun thing-at-mouse
+Defined in @code{thingatpt.el}.
+@end defun
+
+@defun macroexp-file-name
+Defined in @code{macroexp}.
+@end defun
+
+@defmac with-environment-variables
+See @ref{System Environment,System
+ Environment,,elisp,}.
+@end defmac
+
+@defun button-buttonize
+Defined in @code{button.el}.
+@end defun
+
+@defun make-directory-autoloads
+See @ref{Autoload,Autoload,,elisp,}.
+@end defun
+
+@defun color-values-from-color-spec
+Defined in @code{xfaces.c}.
+@end defun
+
+@defun file-modes-number-to-symbolic
+See @ref{Changing Files,Changing
+ Files,,elisp,}.
+@end defun
+
+@defun file-backup-file-names
+See @ref{Backup Names,Backup Names,,elisp,}.
+@end defun
+
+@defun make-lock-file-name
+Defined in @code{files.el}.
+@end defun
+
+@defun null-device
+Defined in @code{files.el}.
+@end defun
+
+@defun decoded-time-period
+Defined in @code{time-data.el}.
+@end defun
+
+@defun subr-primitive-p
+Defined in @code{subr.el}.
+@end defun
+
+@defun file-name-absolute-p
+See @ref{Absolute and Relative File Names,Relative File Names,,elisp,}.
+@end defun
+
+These functions are prefixed with @code{compat} prefix, and are only loaded
+when @code{compat-28} is required:
+
+@defun compat-unlock-buffer
+See @ref{File Locks,File Locks,,elisp,}.
+
+Handle @code{file-error} conditions.
+@end defun
+
+@defun compat-string-width
+See @ref{Size of Displayed Text,Size of Displayed Text,,elisp,}.
+
+Handle optional arguments FROM and TO@.
+@end defun
+
+@defun compat-json-serialize
+See @ref{Parsing JSON,Parsing JSON,,elisp,}.
+
+Handle primitive, top-level JSON values.
+@end defun
+
+@defun compat-json-insert
+See @ref{Parsing JSON,Parsing JSON,,elisp,}.
+
+Handle primitive, top-level JSON values.
+@end defun
+
+@defun compat-json-parse-string
+See @ref{Parsing JSON,Parsing JSON,,elisp,}.
+
+Handle primitive, top-level JSON values.
+@end defun
+
+@defun compat-json-parse-buffer
+See @ref{Parsing JSON,Parsing JSON,,elisp,}.
+
+Handle primitive, top-level JSON values.
+@end defun
+
+@defun compat-count-windows
+Defined in @code{window.el}.
+
+Handle optional argument ALL-FRAMES@.
+@end defun
+
+Compat does not provide support for the following Lisp features
+implemented in 28.1:
+
+@itemize
+@item
+Support for @code{interactive} or @code{declare} to list applicable modes.
+@item
+Support for @code{:interactive} argument to @code{define-minor-mode} and
+@code{define-derived-mode}.
+@item
+Support for @code{:predicate} argument to @code{define-globalized-minor-mode}.
+@item
+"Success handler" for @code{condition-case}.
+@item
+The function @code{benchmark-call}.
+@item
+Support for the @code{natnum} defcustom type.
+@item
+The function @code{macroexp-compiling-p}.
+@item
+The function @code{macroexp-warn-and-return}.
+@item
+Additional Edebug keywords.
+@item
+Shorthand support.
+@item
+The function @code{custom-add-choice}.
+@item
+The function @code{decoded-time-period}.
+@item
+The function @code{dom-print}.
+@item
+The function @code{dom-remove-attribute}.
+@item
+The function @code{dns-query-asynchronous}.
+@item
+The function @code{get-locale-names}.
+@item
+The function @code{json-avaliable-p}.
+@item
+The function @code{mail-header-parse-addresses-lax}.
+@item
+The function @code{mail-header-parse-address-lax}.
+@item
+The function @code{make-separator-line}.
+@item
+The function @code{num-processors}.
+@item
+The function @code{object-intervals}.
+@item
+The function @code{process-lines-ignore-status}.
+@item
+The function @code{require-theme}.
+@item
+The function @code{syntax-class-to-char}.
+@item
+The function @code{null-device} and @code{path-separator}.
+@end itemize
+
+@node Development
+@chapter Development
+
+Compat is developed on @uref{https://sr.ht/~pkal/compat, SourceHut}. A
restricted @uref{https://github.com/phikal/compat.el, GitHub mirror} is also
+maintained.
+
+Patches and comments can be sent to the
@uref{https://lists.sr.ht/~pkal/compat-devel, development mailing list}
+(@email{~pkal/compat-devel@@lists.sr.ht, ~pkal/compat-devel@@lists.sr.ht}).
Bug reports are best sent to the
+@uref{https://todo.sr.ht/~pkal/compat, issue tracker}
(@email{~pkal/compat@@todo.sr.ht, ~pkal/compat@@todo.sr.ht}). The GitHub
mirror can also
+be used to submit patches. These may include issues in the
+compatibility code, missing definitions or performance issues.
+
+Please note that as a GNU ELPA package, Compat requires contributors
+to have signed the
@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Copyright-Assignment.html,
FSF copyright assignment}, before any non-trivial
+contribution (roughly 15 lines of code) can be applied.
+
+@node Function Index
+@appendix Function Index
+
+@printindex fn
+
+@node Variable Index
+@appendix Variable Index
+
+@printindex vr
+
+@bye
+
+@c Local Variables:
+@c mode: texinfo
+@c TeX-master: t
+@c End:
- [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, 2023/01/03
- [elpa] externals/compat ae2bf0aee5 08/84: Merge branch 'master' into emacs-29.1,
ELPA Syncer <=
- [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
- [elpa] externals/compat 87da1d984d 11/84: Begin documenting Emacs 29 support, ELPA Syncer, 2023/01/03