diff options
| author | Eli Zaretskii | 2022-02-10 10:34:29 +0200 |
|---|---|---|
| committer | Eli Zaretskii | 2022-02-10 10:34:29 +0200 |
| commit | d3c47011d5ace1e1c3fca830d3ff71d9c693ed5d (patch) | |
| tree | 32525b8338e0417efdf149d75d96d033558b5b28 | |
| parent | 35bf8d4a025baa8da2affa3cff5a0f426889096f (diff) | |
| download | emacs-d3c47011d5ace1e1c3fca830d3ff71d9c693ed5d.tar.gz emacs-d3c47011d5ace1e1c3fca830d3ff71d9c693ed5d.zip | |
Allow customization of the user's eln-cache directory
* lisp/startup.el (startup-redirect-eln-cache)
(startup--update-eln-cache): New functions.
(startup--original-eln-load-path): New defvar.
(normal-top-level): Record the original value of
'native-comp-eln-load-path' in 'startup--original-eln-load-path'.
Do not amend 'native-comp-eln-load-path' here, as that could
overwrite user customizations.
(command-line): Amend 'native-comp-eln-load-path' after loading
the early-init file, and then again after loading the user init
file. (Bug#53891)
* etc/NEWS: Announce 'startup-redirect-eln-cache'.
| -rw-r--r-- | etc/NEWS | 8 | ||||
| -rw-r--r-- | lisp/startup.el | 130 |
2 files changed, 67 insertions, 71 deletions
| @@ -92,6 +92,14 @@ This is run at the end of the Emacs startup process, and it meant to | |||
| 92 | be used to reinitialize structures that would normally be done at load | 92 | be used to reinitialize structures that would normally be done at load |
| 93 | time. | 93 | time. |
| 94 | 94 | ||
| 95 | --- | ||
| 96 | ** New function 'startup-redirect-eln-cache'. | ||
| 97 | This function can be called in your init files to change the | ||
| 98 | user-specific directory where Emacs stores the "*.eln" files produced | ||
| 99 | by native compilation of Lisp packages Emacs loads. The default | ||
| 100 | eln-cache directory is unchanged: it is the 'eln-cache' subdirectory | ||
| 101 | of 'user-emacs-directory'. | ||
| 102 | |||
| 95 | 103 | ||
| 96 | * Incompatible changes in Emacs 29.1 | 104 | * Incompatible changes in Emacs 29.1 |
| 97 | 105 | ||
diff --git a/lisp/startup.el b/lisp/startup.el index d838dd6827c..9a4c3e2d144 100644 --- a/lisp/startup.el +++ b/lisp/startup.el | |||
| @@ -541,6 +541,49 @@ DIRS are relative." | |||
| 541 | (setq comp--compilable t)) | 541 | (setq comp--compilable t)) |
| 542 | 542 | ||
| 543 | (defvar native-comp-eln-load-path) | 543 | (defvar native-comp-eln-load-path) |
| 544 | |||
| 545 | (defvar startup--original-eln-load-path nil | ||
| 546 | "Original value of `native-comp-eln-load-path'.") | ||
| 547 | |||
| 548 | (defun startup-redirect-eln-cache (cache-directory) | ||
| 549 | "Redirect the user's eln-cache directory to CACHE-DIRECTORY. | ||
| 550 | CACHE-DIRECTORY must be a single directory, a string. | ||
| 551 | This function destructively changes `native-comp-eln-load-path' | ||
| 552 | so that its first element is CACHE-DIRECTORY. If CACHE-DIRECTORY | ||
| 553 | is not an absolute file name, it is interpreted relative | ||
| 554 | to `user-emacs-directory'. | ||
| 555 | For best results, call this function in your early-init file, | ||
| 556 | so that the rest of initialization and package loading uses | ||
| 557 | the updated value." | ||
| 558 | (let ((tmp-dir (and (equal (getenv "HOME") "/nonexistent") | ||
| 559 | (file-writable-p (expand-file-name | ||
| 560 | (or temporary-file-directory ""))) | ||
| 561 | (car native-comp-eln-load-path)))) | ||
| 562 | (if tmp-dir | ||
| 563 | (setq native-comp-eln-load-path | ||
| 564 | (cdr native-comp-eln-load-path))) | ||
| 565 | ;; Remove the original eln-cache. | ||
| 566 | (setq native-comp-eln-load-path | ||
| 567 | (cdr native-comp-eln-load-path)) | ||
| 568 | ;; Add the new eln-cache. | ||
| 569 | (push (expand-file-name (file-name-as-directory cache-directory) | ||
| 570 | user-emacs-directory) | ||
| 571 | native-comp-eln-load-path) | ||
| 572 | (when tmp-dir | ||
| 573 | ;; Recompute tmp-dir, in case user-emacs-directory affects it. | ||
| 574 | (setq tmp-dir (make-temp-file "emacs-testsuite-" t)) | ||
| 575 | (add-hook 'kill-emacs-hook (lambda () (delete-directory tmp-dir t))) | ||
| 576 | (push tmp-dir native-comp-eln-load-path)))) | ||
| 577 | |||
| 578 | (defun startup--update-eln-cache () | ||
| 579 | "Update the user eln-cache directory due to user customizations." | ||
| 580 | ;; Don't override user customizations! | ||
| 581 | (when (equal native-comp-eln-load-path | ||
| 582 | startup--original-eln-load-path) | ||
| 583 | (startup-redirect-eln-cache "eln-cache") | ||
| 584 | (setq startup--original-eln-load-path | ||
| 585 | (copy-sequence native-comp-eln-load-path)))) | ||
| 586 | |||
| 544 | (defun normal-top-level () | 587 | (defun normal-top-level () |
| 545 | "Emacs calls this function when it first starts up. | 588 | "Emacs calls this function when it first starts up. |
| 546 | It sets `command-line-processed', processes the command-line, | 589 | It sets `command-line-processed', processes the command-line, |
| @@ -559,7 +602,7 @@ It is the default value of the variable `top-level'." | |||
| 559 | (startup--xdg-or-homedot startup--xdg-config-home-emacs nil)) | 602 | (startup--xdg-or-homedot startup--xdg-config-home-emacs nil)) |
| 560 | 603 | ||
| 561 | (when (featurep 'native-compile) | 604 | (when (featurep 'native-compile) |
| 562 | ;; Form `native-comp-eln-load-path'. | 605 | ;; Form the initial value of `native-comp-eln-load-path'. |
| 563 | (let ((path-env (getenv "EMACSNATIVELOADPATH"))) | 606 | (let ((path-env (getenv "EMACSNATIVELOADPATH"))) |
| 564 | (when path-env | 607 | (when path-env |
| 565 | (dolist (path (split-string path-env path-separator)) | 608 | (dolist (path (split-string path-env path-separator)) |
| @@ -674,7 +717,9 @@ It is the default value of the variable `top-level'." | |||
| 674 | ;; native-comp-eln-load-path. | 717 | ;; native-comp-eln-load-path. |
| 675 | (expand-file-name | 718 | (expand-file-name |
| 676 | (decode-coding-string dir coding t))) | 719 | (decode-coding-string dir coding t))) |
| 677 | npath)))) | 720 | npath))) |
| 721 | (setq startup--original-eln-load-path | ||
| 722 | (copy-sequence native-comp-eln-load-path))) | ||
| 678 | (dolist (filesym '(data-directory doc-directory exec-directory | 723 | (dolist (filesym '(data-directory doc-directory exec-directory |
| 679 | installation-directory | 724 | installation-directory |
| 680 | invocation-directory invocation-name | 725 | invocation-directory invocation-name |
| @@ -725,46 +770,6 @@ It is the default value of the variable `top-level'." | |||
| 725 | (unwind-protect | 770 | (unwind-protect |
| 726 | (command-line) | 771 | (command-line) |
| 727 | 772 | ||
| 728 | ;; Do this after `command-line', since it may alter | ||
| 729 | ;; `user-emacs-directory'. | ||
| 730 | (when (featurep 'native-compile) | ||
| 731 | ;; Form `native-comp-eln-load-path'. | ||
| 732 | (let ((path-env (getenv "EMACSNATIVELOADPATH"))) | ||
| 733 | (when path-env | ||
| 734 | (dolist (path (split-string path-env path-separator)) | ||
| 735 | (unless (string= "" path) | ||
| 736 | (push path native-comp-eln-load-path))))) | ||
| 737 | (push (expand-file-name "eln-cache/" user-emacs-directory) | ||
| 738 | native-comp-eln-load-path) | ||
| 739 | ;; When $HOME is set to '/nonexistent' means we are running the | ||
| 740 | ;; testsuite, add a temporary folder in front to produce there | ||
| 741 | ;; new compilations. | ||
| 742 | (when (and (equal (getenv "HOME") "/nonexistent") | ||
| 743 | ;; We may be running in a chroot environment where we | ||
| 744 | ;; can't write anything. | ||
| 745 | (file-writable-p (expand-file-name | ||
| 746 | (or temporary-file-directory "")))) | ||
| 747 | (let ((tmp-dir (make-temp-file "emacs-testsuite-" t))) | ||
| 748 | (add-hook 'kill-emacs-hook | ||
| 749 | (lambda () | ||
| 750 | (delete-directory tmp-dir t))) | ||
| 751 | (push tmp-dir native-comp-eln-load-path))) | ||
| 752 | (when locale-coding-system | ||
| 753 | (let ((coding (if (eq system-type 'windows-nt) | ||
| 754 | ;; MS-Windows build converts all file names to | ||
| 755 | ;; UTF-8 during startup. | ||
| 756 | 'utf-8 | ||
| 757 | locale-coding-system)) | ||
| 758 | (npath (symbol-value 'native-comp-eln-load-path))) | ||
| 759 | (set 'native-comp-eln-load-path | ||
| 760 | (mapcar (lambda (dir) | ||
| 761 | ;; Call expand-file-name to remove all the | ||
| 762 | ;; pesky ".." from the directyory names in | ||
| 763 | ;; native-comp-eln-load-path. | ||
| 764 | (expand-file-name | ||
| 765 | (decode-coding-string dir coding t))) | ||
| 766 | npath))))) | ||
| 767 | |||
| 768 | ;; Do this again, in case .emacs defined more abbreviations. | 773 | ;; Do this again, in case .emacs defined more abbreviations. |
| 769 | (if default-directory | 774 | (if default-directory |
| 770 | (setq default-directory (abbreviate-file-name default-directory))) | 775 | (setq default-directory (abbreviate-file-name default-directory))) |
| @@ -832,35 +837,6 @@ It is the default value of the variable `top-level'." | |||
| 832 | (unless inhibit-startup-hooks | 837 | (unless inhibit-startup-hooks |
| 833 | (run-hooks 'window-setup-hook)))) | 838 | (run-hooks 'window-setup-hook)))) |
| 834 | 839 | ||
| 835 | ;; Amend `native-comp-eln-load-path' after `command-line', since | ||
| 836 | ;; the latter may have altered `user-emacs-directory'. | ||
| 837 | (when (featurep 'native-compile) | ||
| 838 | (let ((tmp-dir (and (equal (getenv "HOME") "/nonexistent") | ||
| 839 | (file-writable-p (expand-file-name | ||
| 840 | (or temporary-file-directory ""))) | ||
| 841 | (car native-comp-eln-load-path))) | ||
| 842 | (coding (if (eq system-type 'windows-nt) | ||
| 843 | 'utf-8 | ||
| 844 | locale-coding-system))) | ||
| 845 | (if tmp-dir | ||
| 846 | (setq native-comp-eln-load-path | ||
| 847 | (cdr native-comp-eln-load-path))) | ||
| 848 | ;; Remove the original eln-cache. | ||
| 849 | (setq native-comp-eln-load-path | ||
| 850 | (cdr native-comp-eln-load-path)) | ||
| 851 | ;; Add the new eln-cache. | ||
| 852 | (push (expand-file-name "eln-cache/" | ||
| 853 | (if coding | ||
| 854 | (decode-coding-string user-emacs-directory | ||
| 855 | coding t) | ||
| 856 | user-emacs-directory)) | ||
| 857 | native-comp-eln-load-path) | ||
| 858 | (when tmp-dir | ||
| 859 | ;; Recompute tmp-dir, in case user-emacs-directory affects it. | ||
| 860 | (setq tmp-dir (make-temp-file "emacs-testsuite-" t)) | ||
| 861 | (add-hook 'kill-emacs-hook (lambda () (delete-directory tmp-dir t))) | ||
| 862 | (push tmp-dir native-comp-eln-load-path)))) | ||
| 863 | |||
| 864 | ;; Subprocesses of Emacs do not have direct access to the terminal, so | 840 | ;; Subprocesses of Emacs do not have direct access to the terminal, so |
| 865 | ;; unless told otherwise they should only assume a dumb terminal. | 841 | ;; unless told otherwise they should only assume a dumb terminal. |
| 866 | ;; We are careful to do it late (after term-setup-hook), although the | 842 | ;; We are careful to do it late (after term-setup-hook), although the |
| @@ -1362,6 +1338,12 @@ please check its value") | |||
| 1362 | startup-init-directory))) | 1338 | startup-init-directory))) |
| 1363 | (setq early-init-file user-init-file) | 1339 | (setq early-init-file user-init-file) |
| 1364 | 1340 | ||
| 1341 | ;; Amend `native-comp-eln-load-path', since the early-init file may | ||
| 1342 | ;; have altered `user-emacs-directory' and/or changed the eln-cache | ||
| 1343 | ;; directory. | ||
| 1344 | (when (featurep 'native-compile) | ||
| 1345 | (startup--update-eln-cache)) | ||
| 1346 | |||
| 1365 | ;; If any package directory exists, initialize the package system. | 1347 | ;; If any package directory exists, initialize the package system. |
| 1366 | (and user-init-file | 1348 | (and user-init-file |
| 1367 | package-enable-at-startup | 1349 | package-enable-at-startup |
| @@ -1496,6 +1478,12 @@ please check its value") | |||
| 1496 | startup-init-directory)) | 1478 | startup-init-directory)) |
| 1497 | t) | 1479 | t) |
| 1498 | 1480 | ||
| 1481 | ;; Amend `native-comp-eln-load-path' again, since the early-init | ||
| 1482 | ;; file may have altered `user-emacs-directory' and/or changed the | ||
| 1483 | ;; eln-cache directory. | ||
| 1484 | (when (featurep 'native-compile) | ||
| 1485 | (startup--update-eln-cache)) | ||
| 1486 | |||
| 1499 | (when (and deactivate-mark transient-mark-mode) | 1487 | (when (and deactivate-mark transient-mark-mode) |
| 1500 | (with-current-buffer (window-buffer) | 1488 | (with-current-buffer (window-buffer) |
| 1501 | (deactivate-mark))) | 1489 | (deactivate-mark))) |