[elpa] externals/compat ccc8b1fd36 02/10: Compress and merge the compiled result of compat.elc

[ELPA Syncer]

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

    Compress and merge the compiled result of compat.elc
    
    The previous `compat-generate-common' (now `compat--generate-verbose')
    generated a lot of code that was not relevant for 99% of most users,
    and can be stripped away, reducing the size of the resulting program
    and increasing the speed at which compat is loaded.  These factors are
    worth optimising and investing complexity into, as compat autoloads
    itself and therefore shouldn't burden the user unnecessarily.
---
 compat-macs.el  | 90 ++++++++++++++++++++++++++++++++++++++++++++++++++-------
 compat-tests.el |  5 +++-
 compat.el       | 24 +++++++--------
 3 files changed, 94 insertions(+), 25 deletions(-)

diff --git a/compat-macs.el b/compat-macs.el
index 6f3236cf9a..789c5025e7 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-verbose
+  "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).
@@ -64,7 +66,66 @@ attributes are handled, all others are ignored:
 - :notes :: Additional notes that a developer using this
   compatibility function should keep in mind.
 
-TYPE is used to set the symbol property `compat-type' for NAME."
+- :alias :: Force create an alias starting with `compat--' or as
+  defined by :realname.
+
+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
+                 ((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* ((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))))
+
+(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))
@@ -111,6 +172,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 dd5f462f17..00968e2501 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -33,7 +33,10 @@
 ;;; Code:
 
 (require 'ert)
-(require 'compat)
+
+(defvar compat-testing)
+(let ((compat-testing t))
+  (load "compat.el"))
 
 (defvar compat--current-fn nil)
 (defvar compat--compat-fn nil)
diff --git a/compat.el b/compat.el
index 2a71f68902..78cf7487a9 100644
--- a/compat.el
+++ b/compat.el
@@ -142,11 +142,15 @@ advice."
 
 ;; To accelerate the loading process, we insert the contents of
 ;; compat-N.M.el directly into the compat.elc.
-(eval-and-compile
+(eval-when-compile
   (defmacro compat-insert (version)
-    (if (boundp 'compat-testing)
-        (load (format "compat-%s.el" version))
-      (let* ((file (expand-file-name
+    (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)
@@ -163,16 +167,10 @@ advice."
             (while (progn
                      (forward-comment 1)
                      (not (eobp)))
-              (let ((sexp (read (current-buffer))))
-                (push (if (or (eq (car-safe sexp) 'compat-defun)
-                              (eq (car-safe sexp) 'compat-defmacro)
-                              (eq (car-safe sexp) 'compat-advise)
-                              (eq (car-safe sexp) 'compat-defvar))
-                          (macroexpand-all sexp)
-                        sexp)
-                      defs)))
-            (cons 'progn (nreverse defs))))))))
+              (push (read (current-buffer)) defs))
+            (cons 'progn (nreverse defs)))))))))
 
+(setq-default compat--generate-function 'compat--generate-minimal)
 (compat-insert "24.4")
 (compat-insert "25.1")
 (compat-insert "26.1")