[elpa] externals/compat 8792ab17be 10/10: Merge branch 'testing'

[ELPA Syncer]

branch: externals/compat
commit 8792ab17be4c2641ebf3450d600996d8258c5e90
Merge: ab08067970 164672060f
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Merge branch 'testing'
---
 compat-25.1.el      |   1 +
 compat-26.1.el      |  12 +++---
 compat-font-lock.el |  48 +++++++++++++++++++++++
 compat-macs.el      | 109 ++++++++++++++++++++++++++++++++++++++++++----------
 compat-tests.el     |  16 +++++---
 compat.el           |  51 +++++++++++++++++++++---
 6 files changed, 199 insertions(+), 38 deletions(-)

diff --git a/compat-25.1.el b/compat-25.1.el
index 2df84e7430..0884950bee 100644
--- a/compat-25.1.el
+++ b/compat-25.1.el
@@ -62,6 +62,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))
             ?\\ ?/))
diff --git a/compat-26.1.el b/compat-26.1.el
index d6b0d33d14..5b9e6fbb43 100644
--- a/compat-26.1.el
+++ b/compat-26.1.el
@@ -82,8 +82,6 @@ from the absolute start of the buffer, disregarding the 
narrowing."
                   (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
@@ -94,6 +92,7 @@ from the absolute start of the buffer, disregarding the 
narrowing."
   "Trim STRING of leading string matching REGEXP.
 
 REGEXP defaults to \"[ \\t\\n\\r]+\"."
+  :realname compat--string-trim-left
   (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string)
       (substring string (match-end 0))
     string))
@@ -102,6 +101,7 @@ REGEXP defaults to \"[ \\t\\n\\r]+\"."
   "Trim STRING of trailing string matching REGEXP.
 
 REGEXP defaults to  \"[ \\t\\n\\r]+\"."
+  :realname compat--string-trim-right
   (let ((i (string-match-p
             (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'")
             string)))
@@ -247,9 +247,9 @@ TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
   "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)))))
+  (let ((num (prog1 gensym-counter
+               (setq gensym-counter
+                     (1+ gensym-counter)))))
     (make-symbol (format "%s%d" (or prefix "g") num))))
 
 ;;;; Defined in files.el
@@ -291,7 +291,7 @@ the variable `temporary-file-directory' is returned."
                   default-directory 'temporary-file-directory)))
     (if handler
         (funcall handler 'temporary-file-directory)
-      (if (string-match compat--mounted-file-systems default-directory)
+      (if (string-match mounted-file-systems default-directory)
           default-directory
         temporary-file-directory))))
 
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 211f3cc5a8..6a9a7b7fb1 100644
--- a/compat-macs.el
+++ b/compat-macs.el
@@ -29,16 +29,18 @@
   "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--generate-function #'compat--generate-minimal
+  "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).
@@ -67,7 +69,72 @@ 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-minimal (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)))))
+         (realname (or (plist-get attr :realname)
+                       (intern (format "compat--%S" name))))
+         (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)
+                  '(progn))
+                 ((and version (version<= version emacs-version))
+                  '(compat--ignore))
+                 (`(when (and ,(if cond cond t)
+                              ,(funcall check-fn)))))))
+    (if (and (not (plist-get attr :prefix))
+             (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-minimal-no-prefix (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."
+  (unless (plist-get attr :prefix)
+    (compat--generate-minimal name def-fn install-fn check-fn attr type)))
+
+(defun compat--generate-verbose (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))
@@ -87,16 +154,11 @@ TYPE is used to set the symbol property `compat-type' for 
NAME."
          (realname (or (plist-get attr :realname)
                        (intern (format "compat--%S" name))))
          (body `(progn
-                  (when (get ',name 'compat-def)
-                    (error "Duplicate compatibility definition: %s" ',name))
+                  (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)
-                  ,(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)
@@ -120,6 +182,13 @@ TYPE is used to set the symbol property `compat-type' for 
NAME."
              `(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."
+  (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.
 TYPE is one of `func', for functions and `macro' for macros, and
diff --git a/compat-tests.el b/compat-tests.el
index 99d5a862b5..9bbd0e4891 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -33,7 +33,16 @@
 ;;; Code:
 
 (require 'ert)
-(require 'compat)
+
+(unless (fboundp 'advice-add)
+  (require 'package)
+  (package-install 'nadvice))
+
+(require 'compat-macs)
+(defvar compat-testing)
+(let ((compat--generate-function #'compat--generate-verbose)
+      (compat-testing t))
+  (load "compat.el"))
 
 (defvar compat--current-fn nil)
 (defvar compat--compat-fn nil)
@@ -121,11 +130,6 @@ the compatibility function."
 
 
 
-(unless (fboundp 'advice-add)
-  (require 'package)
-  (package-initialize)
-  (package-install 'nadvice))
-
 (ert-deftest compat-string-search ()
   "Check if `compat--string-search' was implemented correctly."
   (compat-test string-search
diff --git a/compat.el b/compat.el
index f1eda034e1..dca58424cf 100644
--- a/compat.el
+++ b/compat.el
@@ -118,12 +118,51 @@
         (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)
+;; To accelerate the loading process, we insert the contents of
+;; compat-N.M.el directly into the compat.elc.
+(eval-when-compile
+  (defvar compat--generate-function)
+  (defmacro compat-insert (version)
+    (cond
+     ((bound-and-true-p compat-testing)
+      `(load ,(format "compat-%s.el" version)))
+     ;; ((version<= version emacs-version)
+     ;;  ;; We don't need to do anything.
+     ;;  nil)
+     ((let* ((compat--generate-function 'compat--generate-minimal-no-prefix)
+             (file (expand-file-name
+                    (format "compat-%s.el" version)
+                    (file-name-directory
+                     (or (and (boundp 'byte-compile-current-file) 
byte-compile-current-file)
+                         load-file-name
+                         buffer-file-name))))
+             (byte-compile-current-file file)
+             defs)
+        (unless (file-exists-p file)
+          (error "Cannot load %S" file))
+        (let ((load-file-name file))
+          (with-temp-buffer
+            (insert-file-contents file)
+            (emacs-lisp-mode)
+            (while (progn
+                     (forward-comment 1)
+                     (not (eobp)))
+              (let ((form (read (current-buffer))))
+                (when (memq (car-safe form)
+                            '(declare-function
+                              compat-defun
+                              compat-defmacro
+                              compat-advise
+                              defvar))
+                  (push form defs))))))
+        (macroexpand-all
+         (cons 'progn (nreverse defs))))))))
+
+(compat-insert "24.4")
+(compat-insert "25.1")
+(compat-insert "26.1")
+(compat-insert "27.1")
+(compat-insert "28.1")
 
 (provide 'compat)
 ;;; compat.el ends here