master 05d240997a 2/2: Add native-compile-prune-cache command

[Lars Ingebrigtsen]

branch: master
commit 05d240997aeb6ffe3db21e7f4c8e2f181edc37b6
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Add native-compile-prune-cache command
    
    * lisp/emacs-lisp/comp.el (native-compile-prune-cache): New
    command (bug#48108).
---
 etc/NEWS                |  9 ++++++++-
 lisp/emacs-lisp/comp.el | 24 ++++++++++++++++++++++++
 2 files changed, 32 insertions(+), 1 deletion(-)

diff --git a/etc/NEWS b/etc/NEWS
index 30404cc13c..4b3a02b2e0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -148,8 +148,15 @@ This is run at the end of the Emacs startup process, and 
is meant to
 be used to reinitialize structures that would normally be done at load
 time.
 
+** Native Compilation
+
+---
+*** New command 'native-compile-prune-cache'.
+This command deletes older .eln cache entries (but not the ones for
+the current Emacs version).
+
 ---
-** New function 'startup-redirect-eln-cache'.
+*** New function 'startup-redirect-eln-cache'.
 This function can be called in your init files to change the
 user-specific directory where Emacs stores the "*.eln" files produced
 by native compilation of Lisp packages Emacs loads.  The default
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 4ce2ce75e1..2109aa9923 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -4288,6 +4288,30 @@ of (commands) to run simultaneously."
   (let ((load (not (not load))))
     (native--compile-async files recursively load selector)))
 
+(defun native-compile-prune-cache ()
+  "Remove .eln files that aren't applicable to the current Emacs invocation."
+  (interactive)
+  (dolist (dir native-comp-eln-load-path)
+    ;; If a directory is non absolute it is assumed to be relative to
+    ;; `invocation-directory'.
+    (setq dir (expand-file-name dir invocation-directory))
+    (when (file-exists-p dir)
+      (dolist (subdir (directory-files dir t))
+        (when (and (file-directory-p subdir)
+                   (file-writable-p subdir)
+                   (not (equal (file-name-nondirectory
+                                (directory-file-name subdir))
+                               comp-native-version-dir)))
+          (message "Deleting %s..." subdir)
+          ;; We're being overly cautious here -- there shouldn't be
+          ;; anything but .eln files in these directories.
+          (dolist (eln (directory-files subdir t "\\.eln\\(\\.tmp\\)?\\'"))
+            (when (file-writable-p eln)
+              (delete-file eln)))
+          (when (directory-empty-p subdir)
+            (delete-directory subdir))))))
+  (message "Cache cleared"))
+
 (provide 'comp)
 
 ;; LocalWords: limplified limplified limplification limplify Limple LIMPLE 
libgccjit elc eln