From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Sat, 2 Jul 2022 10:59:41 +0000 (+0200)
Subject: Add native-compile-prune-cache command
X-Git-Tag: emacs-29.0.90~1447^2~1277
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=05d240997aeb6ffe3db21e7f4c8e2f181edc37b6;p=emacs.git

Add native-compile-prune-cache command

* lisp/emacs-lisp/comp.el (native-compile-prune-cache): New
command (bug#48108).
---

diff --git a/etc/NEWS b/etc/NEWS
index 30404cc13c2..4b3a02b2e00 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 4ce2ce75e10..2109aa9923a 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