diff options
| author | Basil L. Contovounesios | 2021-03-02 14:35:50 +0000 |
|---|---|---|
| committer | Basil L. Contovounesios | 2021-03-04 15:40:35 +0000 |
| commit | 8e759d60cc234d4beb471dbb46f91d8ca3a20066 (patch) | |
| tree | 812b6f56f6d5c1b14e83223f875fbaf58a076fcc | |
| parent | 358c6c9b95a5fd77edb1538f5fec5021a03de94a (diff) | |
| download | emacs-8e759d60cc234d4beb471dbb46f91d8ca3a20066.tar.gz emacs-8e759d60cc234d4beb471dbb46f91d8ca3a20066.zip | |
Decouple require-theme from load-theme
* lisp/custom.el (require-theme): Refashion after 'require', as a
function for loading only named features. Do not call
load-theme (bug#45068).
* etc/NEWS: Update its announcement accordingly.
* doc/lispref/customize.texi (Custom Themes): Document it.
* etc/themes/modus-operandi-theme.el:
* etc/themes/modus-vivendi-theme.el: Remove redundant calls to
'provide'.
* test/lisp/custom-tests.el (custom-tests--with-temp-dir): New
macro.
(custom-theme--load-path): Use it.
(custom-tests-require-theme): New test.
| -rw-r--r-- | doc/lispref/customize.texi | 26 | ||||
| -rw-r--r-- | etc/NEWS | 8 | ||||
| -rw-r--r-- | etc/themes/modus-operandi-theme.el | 2 | ||||
| -rw-r--r-- | etc/themes/modus-vivendi-theme.el | 2 | ||||
| -rw-r--r-- | lisp/custom.el | 46 | ||||
| -rw-r--r-- | test/lisp/custom-tests.el | 160 |
6 files changed, 152 insertions, 92 deletions
diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index 8fd12f79026..bc35982c172 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi | |||
| @@ -1474,7 +1474,7 @@ To protect against loading themes containing malicious code, Emacs | |||
| 1474 | displays the source file and asks for confirmation from the user | 1474 | displays the source file and asks for confirmation from the user |
| 1475 | before loading any non-built-in theme for the first time. As | 1475 | before loading any non-built-in theme for the first time. As |
| 1476 | such, themes are not ordinarily byte-compiled, and source files | 1476 | such, themes are not ordinarily byte-compiled, and source files |
| 1477 | always take precedence when Emacs is looking for a theme to load. | 1477 | usually take precedence when Emacs is looking for a theme to load. |
| 1478 | 1478 | ||
| 1479 | The following functions are useful for programmatically enabling and | 1479 | The following functions are useful for programmatically enabling and |
| 1480 | disabling themes: | 1480 | disabling themes: |
| @@ -1508,6 +1508,30 @@ confirmation before loading the theme, unless the optional argument | |||
| 1508 | @var{no-confirm} is non-@code{nil}. | 1508 | @var{no-confirm} is non-@code{nil}. |
| 1509 | @end deffn | 1509 | @end deffn |
| 1510 | 1510 | ||
| 1511 | @defun require-theme feature &optional noerror | ||
| 1512 | This function searches @code{custom-theme-load-path} for a file that | ||
| 1513 | provides @var{feature} and then loads it. This is like the function | ||
| 1514 | @code{require} (@pxref{Named Features}), except it searches | ||
| 1515 | @code{custom-theme-load-path} instead of @code{load-path} | ||
| 1516 | (@pxref{Library Search}). This can be useful in Custom themes that | ||
| 1517 | need to load supporting Lisp files when @code{require} is unsuitable | ||
| 1518 | for that. | ||
| 1519 | |||
| 1520 | If @var{feature}, which should be a symbol, is not already present in | ||
| 1521 | the current Emacs session according to @code{featurep}, then | ||
| 1522 | @code{require-theme} searches for a file named @var{feature} with an | ||
| 1523 | added @samp{.elc} or @samp{.el} suffix, in that order, in the | ||
| 1524 | directories specified by @code{custom-theme-load-path}. | ||
| 1525 | |||
| 1526 | If a file providing @var{feature} is successfully found and loaded, | ||
| 1527 | then @code{require-theme} returns @var{feature}. The optional | ||
| 1528 | argument @var{noerror} determines what happens if the search or | ||
| 1529 | loading fails. If it is @code{nil}, the function signals an error; | ||
| 1530 | otherwise, it returns @code{nil}. If the file loads successfully but | ||
| 1531 | does not provide @var{feature}, then @code{require-theme} signals an | ||
| 1532 | error; this cannot be suppressed. | ||
| 1533 | @end defun | ||
| 1534 | |||
| 1511 | @deffn Command enable-theme theme | 1535 | @deffn Command enable-theme theme |
| 1512 | This function enables the Custom theme named @var{theme}. It signals | 1536 | This function enables the Custom theme named @var{theme}. It signals |
| 1513 | an error if no such theme has been loaded. | 1537 | an error if no such theme has been loaded. |
| @@ -2528,11 +2528,11 @@ region's (or buffer's) end. | |||
| 2528 | This function can be used by modes to add elements to the | 2528 | This function can be used by modes to add elements to the |
| 2529 | 'choice' customization type of a variable. | 2529 | 'choice' customization type of a variable. |
| 2530 | 2530 | ||
| 2531 | --- | 2531 | +++ |
| 2532 | ** New function 'require-theme'. | 2532 | ** New function 'require-theme'. |
| 2533 | This function is used to load a theme or library stored in the | 2533 | This function is like 'require', but searches 'custom-theme-load-path' |
| 2534 | 'custom-theme-load-path'. It is intended to work as a substitute for | 2534 | instead of 'load-path'. It can be used by Custom themes to load |
| 2535 | 'require' in those cases where that cannot be used. | 2535 | supporting Lisp files when 'require' is unsuitable. |
| 2536 | 2536 | ||
| 2537 | +++ | 2537 | +++ |
| 2538 | ** New function 'file-modes-number-to-symbolic' to convert a numeric | 2538 | ** New function 'file-modes-number-to-symbolic' to convert a numeric |
diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el index 346000a0935..9d6e9ad50fd 100644 --- a/etc/themes/modus-operandi-theme.el +++ b/etc/themes/modus-operandi-theme.el | |||
| @@ -4661,6 +4661,4 @@ Also bind `class' to ((class color) (min-colors 89))." | |||
| 4661 | 4661 | ||
| 4662 | (provide-theme 'modus-operandi) | 4662 | (provide-theme 'modus-operandi) |
| 4663 | 4663 | ||
| 4664 | (provide 'modus-operandi-theme) | ||
| 4665 | |||
| 4666 | ;;; modus-operandi-theme.el ends here | 4664 | ;;; modus-operandi-theme.el ends here |
diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el index 73f07d644b7..171313244b5 100644 --- a/etc/themes/modus-vivendi-theme.el +++ b/etc/themes/modus-vivendi-theme.el | |||
| @@ -4661,6 +4661,4 @@ Also bind `class' to ((class color) (min-colors 89))." | |||
| 4661 | 4661 | ||
| 4662 | (provide-theme 'modus-vivendi) | 4662 | (provide-theme 'modus-vivendi) |
| 4663 | 4663 | ||
| 4664 | (provide 'modus-vivendi-theme) | ||
| 4665 | |||
| 4666 | ;;; modus-vivendi-theme.el ends here | 4664 | ;;; modus-vivendi-theme.el ends here |
diff --git a/lisp/custom.el b/lisp/custom.el index 35ac4d8564a..b9fccce5833 100644 --- a/lisp/custom.el +++ b/lisp/custom.el | |||
| @@ -1200,29 +1200,31 @@ property `theme-feature' (which is usually a symbol created by | |||
| 1200 | (custom-check-theme theme) | 1200 | (custom-check-theme theme) |
| 1201 | (provide (get theme 'theme-feature))) | 1201 | (provide (get theme 'theme-feature))) |
| 1202 | 1202 | ||
| 1203 | (defun require-theme (theme &optional path) | 1203 | (defun require-theme (feature &optional noerror) |
| 1204 | "Load THEME stored in `custom-theme-load-path'. | 1204 | "Load FEATURE from a file along `custom-theme-load-path'. |
| 1205 | 1205 | ||
| 1206 | THEME is a symbol that corresponds to the file name without its file | 1206 | This function is like `require', but searches along |
| 1207 | type extension. That is assumed to be either '.el' or '.elc'. | 1207 | `custom-theme-load-path' instead of `load-path'. It can be used |
| 1208 | 1208 | by Custom themes to load supporting Lisp files when `require' is | |
| 1209 | When THEME is an element of `custom-available-themes', load it and ask | 1209 | unsuitable. |
| 1210 | for confirmation if it is not considered safe by `custom-safe-themes'. | 1210 | |
| 1211 | Otherwise load the file indicated by THEME, if present. In the latter | 1211 | If FEATURE is not already loaded, search for a file named FEATURE |
| 1212 | case, the file is intended to work as the basis of a theme declared | 1212 | with an added `.elc' or `.el' suffix, in that order, in the |
| 1213 | with `deftheme'. | 1213 | directories specified by `custom-theme-load-path'. |
| 1214 | 1214 | ||
| 1215 | If optional PATH is non-nil, it should be a list of directories | 1215 | Return FEATURE if the file is successfully found and loaded, or |
| 1216 | to search for THEME in, instead of `custom-theme-load-path'. | 1216 | if FEATURE was already loaded. If the file fails to load, signal |
| 1217 | PATH should have the same form as `load-path' or `exec-path'." | 1217 | an error. If optional argument NOERROR is non-nil, return nil |
| 1218 | instead of signaling an error. If the file loads but does not | ||
| 1219 | provide FEATURE, signal an error. This cannot be suppressed." | ||
| 1218 | (cond | 1220 | (cond |
| 1219 | ((memq theme (custom-available-themes)) | 1221 | ((featurep feature) feature) |
| 1220 | (load-theme theme)) | 1222 | ((let* ((path (custom-theme--load-path)) |
| 1221 | ((let* ((dirs (or path (custom-theme--load-path))) | 1223 | (file (locate-file (symbol-name feature) path '(".elc" ".el")))) |
| 1222 | (file (unless (featurep theme) | 1224 | (and file (require feature (file-name-sans-extension file) noerror)))) |
| 1223 | (locate-file (symbol-name theme) dirs '(".el" ".elc"))))) | 1225 | ((not noerror) |
| 1224 | (when file | 1226 | (let (load-path) |
| 1225 | (load-file file)))))) | 1227 | (require feature))))) |
| 1226 | 1228 | ||
| 1227 | (defcustom custom-safe-themes '(default) | 1229 | (defcustom custom-safe-themes '(default) |
| 1228 | "Themes that are considered safe to load. | 1230 | "Themes that are considered safe to load. |
diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el index 09f79c1a089..02a9239824d 100644 --- a/test/lisp/custom-tests.el +++ b/test/lisp/custom-tests.el | |||
| @@ -24,70 +24,108 @@ | |||
| 24 | 24 | ||
| 25 | (require 'wid-edit) | 25 | (require 'wid-edit) |
| 26 | (require 'cus-edit) | 26 | (require 'cus-edit) |
| 27 | (require 'seq) ; For `seq-find'. | 27 | |
| 28 | (defmacro custom-tests--with-temp-dir (&rest body) | ||
| 29 | "Eval BODY with `temporary-file-directory' bound to a fresh directory. | ||
| 30 | Ensure the directory is recursively deleted after the fact." | ||
| 31 | (declare (debug t) (indent 0)) | ||
| 32 | (let ((dir (make-symbol "dir"))) | ||
| 33 | `(let ((,dir (file-name-as-directory (make-temp-file "custom-tests-" t)))) | ||
| 34 | (unwind-protect | ||
| 35 | (let ((temporary-file-directory ,dir)) | ||
| 36 | ,@body) | ||
| 37 | (delete-directory ,dir t))))) | ||
| 28 | 38 | ||
| 29 | (ert-deftest custom-theme--load-path () | 39 | (ert-deftest custom-theme--load-path () |
| 30 | "Test `custom-theme--load-path' behavior." | 40 | "Test `custom-theme--load-path' behavior." |
| 31 | (let ((tmpdir (file-name-as-directory (make-temp-file "custom-tests-" t)))) | 41 | (custom-tests--with-temp-dir |
| 32 | (unwind-protect | 42 | ;; Path is empty. |
| 33 | ;; Create all temporary files under the same deletable parent. | 43 | (let ((custom-theme-load-path ())) |
| 34 | (let ((temporary-file-directory tmpdir)) | 44 | (should (null (custom-theme--load-path)))) |
| 35 | ;; Path is empty. | 45 | |
| 36 | (let ((custom-theme-load-path ())) | 46 | ;; Path comprises non-existent file. |
| 37 | (should (null (custom-theme--load-path)))) | 47 | (let* ((name (make-temp-name temporary-file-directory)) |
| 38 | 48 | (custom-theme-load-path (list name))) | |
| 39 | ;; Path comprises non-existent file. | 49 | (should (not (file-exists-p name))) |
| 40 | (let* ((name (make-temp-name tmpdir)) | 50 | (should (null (custom-theme--load-path)))) |
| 41 | (custom-theme-load-path (list name))) | 51 | |
| 42 | (should (not (file-exists-p name))) | 52 | ;; Path comprises existing file. |
| 43 | (should (null (custom-theme--load-path)))) | 53 | (let* ((file (make-temp-file "file")) |
| 44 | 54 | (custom-theme-load-path (list file))) | |
| 45 | ;; Path comprises existing file. | 55 | (should (file-exists-p file)) |
| 46 | (let* ((file (make-temp-file "file")) | 56 | (should (not (file-directory-p file))) |
| 47 | (custom-theme-load-path (list file))) | 57 | (should (null (custom-theme--load-path)))) |
| 48 | (should (file-exists-p file)) | 58 | |
| 49 | (should (not (file-directory-p file))) | 59 | ;; Path comprises existing directory. |
| 50 | (should (null (custom-theme--load-path)))) | 60 | (let* ((dir (make-temp-file "dir" t)) |
| 51 | 61 | (custom-theme-load-path (list dir))) | |
| 52 | ;; Path comprises existing directory. | 62 | (should (file-directory-p dir)) |
| 53 | (let* ((dir (make-temp-file "dir" t)) | 63 | (should (equal (custom-theme--load-path) custom-theme-load-path))) |
| 54 | (custom-theme-load-path (list dir))) | 64 | |
| 55 | (should (file-directory-p dir)) | 65 | ;; Expand `custom-theme-directory' path element. |
| 56 | (should (equal (custom-theme--load-path) custom-theme-load-path))) | 66 | (let ((custom-theme-load-path '(custom-theme-directory))) |
| 57 | 67 | (let ((custom-theme-directory (make-temp-name temporary-file-directory))) | |
| 58 | ;; Expand `custom-theme-directory' path element. | 68 | (should (not (file-exists-p custom-theme-directory))) |
| 59 | (let ((custom-theme-load-path '(custom-theme-directory))) | 69 | (should (null (custom-theme--load-path)))) |
| 60 | (let ((custom-theme-directory (make-temp-name tmpdir))) | 70 | (let ((custom-theme-directory (make-temp-file "file"))) |
| 61 | (should (not (file-exists-p custom-theme-directory))) | 71 | (should (file-exists-p custom-theme-directory)) |
| 62 | (should (null (custom-theme--load-path)))) | 72 | (should (not (file-directory-p custom-theme-directory))) |
| 63 | (let ((custom-theme-directory (make-temp-file "file"))) | 73 | (should (null (custom-theme--load-path)))) |
| 64 | (should (file-exists-p custom-theme-directory)) | 74 | (let ((custom-theme-directory (make-temp-file "dir" t))) |
| 65 | (should (not (file-directory-p custom-theme-directory))) | 75 | (should (file-directory-p custom-theme-directory)) |
| 66 | (should (null (custom-theme--load-path)))) | 76 | (should (equal (custom-theme--load-path) |
| 67 | (let ((custom-theme-directory (make-temp-file "dir" t))) | 77 | (list custom-theme-directory))))) |
| 68 | (should (file-directory-p custom-theme-directory)) | 78 | |
| 69 | (should (equal (custom-theme--load-path) | 79 | ;; Expand t path element. |
| 70 | (list custom-theme-directory))))) | 80 | (let ((custom-theme-load-path '(t))) |
| 71 | 81 | (let ((data-directory (make-temp-name temporary-file-directory))) | |
| 72 | ;; Expand t path element. | 82 | (should (not (file-exists-p data-directory))) |
| 73 | (let ((custom-theme-load-path '(t))) | 83 | (should (null (custom-theme--load-path)))) |
| 74 | (let ((data-directory (make-temp-name tmpdir))) | 84 | (let ((data-directory temporary-file-directory) |
| 75 | (should (not (file-exists-p data-directory))) | 85 | (themedir (expand-file-name "themes" temporary-file-directory))) |
| 76 | (should (null (custom-theme--load-path)))) | 86 | (should (not (file-exists-p themedir))) |
| 77 | (let ((data-directory tmpdir) | 87 | (should (null (custom-theme--load-path))) |
| 78 | (themedir (expand-file-name "themes" tmpdir))) | 88 | (with-temp-file themedir) |
| 79 | (should (not (file-exists-p themedir))) | 89 | (should (file-exists-p themedir)) |
| 80 | (should (null (custom-theme--load-path))) | 90 | (should (not (file-directory-p themedir))) |
| 81 | (with-temp-file themedir) | 91 | (should (null (custom-theme--load-path))) |
| 82 | (should (file-exists-p themedir)) | 92 | (delete-file themedir) |
| 83 | (should (not (file-directory-p themedir))) | 93 | (make-directory themedir) |
| 84 | (should (null (custom-theme--load-path))) | 94 | (should (file-directory-p themedir)) |
| 85 | (delete-file themedir) | 95 | (should (equal (custom-theme--load-path) (list themedir))))))) |
| 86 | (make-directory themedir) | 96 | |
| 87 | (should (file-directory-p themedir)) | 97 | (ert-deftest custom-tests-require-theme () |
| 88 | (should (equal (custom-theme--load-path) (list themedir)))))) | 98 | "Test `require-theme'." |
| 89 | (when (file-directory-p tmpdir) | 99 | (custom-tests--with-temp-dir |
| 90 | (delete-directory tmpdir t))))) | 100 | (let* ((default-directory temporary-file-directory) |
| 101 | (custom-theme-load-path (list default-directory)) | ||
| 102 | (load-path ())) | ||
| 103 | ;; Generate some `.el' and `.elc' files. | ||
| 104 | (with-temp-file "custom-tests--a.el" | ||
| 105 | (insert "(provide 'custom-tests--a)")) | ||
| 106 | (make-empty-file "custom-tests--b.el") | ||
| 107 | (with-temp-file "custom-tests--b.elc" | ||
| 108 | (byte-compile-insert-header nil (current-buffer)) | ||
| 109 | (insert "(provide 'custom-tests--b)")) | ||
| 110 | (make-empty-file "custom-tests--c.el") | ||
| 111 | (with-temp-file "custom-tests--d.elc" | ||
| 112 | (byte-compile-insert-header nil (current-buffer))) | ||
| 113 | ;; Load them. | ||
| 114 | (dolist (feature '(a b c d e)) | ||
| 115 | (should-not (featurep (intern (format "custom-tests--%s" feature))))) | ||
| 116 | (should (eq (require-theme 'custom-tests--a) 'custom-tests--a)) | ||
| 117 | (delete-file "custom-tests--a.el") | ||
| 118 | (dolist (feature '(custom-tests--a custom-tests--b)) | ||
| 119 | (should (eq (require-theme feature) feature)) | ||
| 120 | (should (featurep feature))) | ||
| 121 | (dolist (feature '(custom-tests--c custom-tests--d)) | ||
| 122 | (dolist (noerror '(nil t)) | ||
| 123 | (let ((err (should-error (require-theme feature noerror)))) | ||
| 124 | (should (string-search "failed to provide feature" (cadr err)))))) | ||
| 125 | (should-error (require-theme 'custom-tests--e) :type 'file-missing) | ||
| 126 | (should-not (require-theme 'custom-tests--e t)) | ||
| 127 | (dolist (feature '(custom-tests--c custom-tests--d custom-tests--e)) | ||
| 128 | (should-not (featurep feature)))))) | ||
| 91 | 129 | ||
| 92 | (defcustom custom--test-user-option 'foo | 130 | (defcustom custom--test-user-option 'foo |
| 93 | "User option for test." | 131 | "User option for test." |