[elpa] externals/compat 164672060f 09/10: Only generate verbose expansions when testing

[ELPA Syncer]

branch: externals/compat
commit 164672060f54ea27742d9d59347c0816d56cabc3
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Only generate verbose expansions when testing
---
 compat-25.1.el  |  1 +
 compat-26.1.el  | 12 +++----
 compat-macs.el  | 99 ++++++++++++++++++++++++++++++---------------------------
 compat-tests.el |  4 ++-
 compat.el       | 64 ++++++++++++++++++++-----------------
 5 files changed, 97 insertions(+), 83 deletions(-)

diff --git a/compat-25.1.el b/compat-25.1.el
index 9d2859dc40..1caab939d8 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-macs.el b/compat-macs.el
index 35d0b55b8e..6a9a7b7fb1 100644
--- a/compat-macs.el
+++ b/compat-macs.el
@@ -29,7 +29,7 @@
   "Ignore all arguments."
   nil)
 
-(defvar compat--generate-function #'compat--generate-verbose
+(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
@@ -66,9 +66,6 @@ ignored:
 - :notes :: Additional notes that a developer using this
   compatibility function should keep in mind.
 
-- :alias :: Force create an alias starting with `compat--' or as
-  defined by :realname.
-
 - :prefix :: Add a `compat-' prefix to the name, and define the
   compatibility code unconditionally.
 
@@ -78,53 +75,61 @@ TYPE is used to set the symbol property `compat-type' for 
NAME.")
   "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)
-    (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
-                   ((and (or (not version)
-                             (version< emacs-version version))
-                         (or (not min-version)
-                             (version<= min-version emacs-version))
-                         (or (not max-version)
-                             (version<= emacs-version max-version)))
-                    `(when (and ,(if cond cond t)
-                                ,(funcall check-fn))))
-                   ('(compat--ignore))) ))
+  (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))))
-             (body1 (if feature
-                        ;; See https://nullprogram.com/blog/2018/02/22/:
-                        `(eval-after-load ',feature `(funcall ',(lambda () 
,body)))
-                      body)))
-        (if (plist-get attr :alias)
-            `(progn
-               ,body1
-               ,(cond
-                 ((memq type '(func advice macro))
-                  `(defalias ',realname #',name))
-                 ((memq type '(variable))
-                  `(defvaralias ',realname ',name))
-                 ((error "Unknown type %s" type))))
-          body1)))))
+                     `(,@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.
diff --git a/compat-tests.el b/compat-tests.el
index 8b7da1e614..c12d78fd43 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -38,8 +38,10 @@
   (require 'package)
   (package-install 'nadvice))
 
+(require 'compat-macs)
 (defvar compat-testing)
-(let ((compat-testing t))
+(let ((compat--generate-function #'compat--generate-verbose)
+      (compat-testing t))
   (load "compat.el"))
 
 (defvar compat--current-fn nil)
diff --git a/compat.el b/compat.el
index 57ecd9144e..2157dae4be 100644
--- a/compat.el
+++ b/compat.el
@@ -121,36 +121,42 @@
 ;; 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)
-    (let ((compat--generate-function
-           (if (eq compat--generate-function 'compat--generate-verbose)
-               'compat--generate-minimal
-             compat--generate-function)))
-      (cond
-       ((bound-and-true-p compat-testing)
-        `(load ,(format "compat-%s" version)))
-       ((version<= version emacs-version)
-        ;; We don't need to do anything.
-        nil)
-       ((let* ((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)))
-                (push (read (current-buffer)) defs))
-              (cons 'progn (nreverse defs))))))))))
+    (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")