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.
This commit is contained in:
Basil L. Contovounesios
parent
358c6c9b95
commit
8e759d60cc
6 changed files with 144 additions and 84 deletions
|
|
@ -1474,7 +1474,7 @@ To protect against loading themes containing malicious code, Emacs
|
|||
displays the source file and asks for confirmation from the user
|
||||
before loading any non-built-in theme for the first time. As
|
||||
such, themes are not ordinarily byte-compiled, and source files
|
||||
always take precedence when Emacs is looking for a theme to load.
|
||||
usually take precedence when Emacs is looking for a theme to load.
|
||||
|
||||
The following functions are useful for programmatically enabling and
|
||||
disabling themes:
|
||||
|
|
@ -1508,6 +1508,30 @@ confirmation before loading the theme, unless the optional argument
|
|||
@var{no-confirm} is non-@code{nil}.
|
||||
@end deffn
|
||||
|
||||
@defun require-theme feature &optional noerror
|
||||
This function searches @code{custom-theme-load-path} for a file that
|
||||
provides @var{feature} and then loads it. This is like the function
|
||||
@code{require} (@pxref{Named Features}), except it searches
|
||||
@code{custom-theme-load-path} instead of @code{load-path}
|
||||
(@pxref{Library Search}). This can be useful in Custom themes that
|
||||
need to load supporting Lisp files when @code{require} is unsuitable
|
||||
for that.
|
||||
|
||||
If @var{feature}, which should be a symbol, is not already present in
|
||||
the current Emacs session according to @code{featurep}, then
|
||||
@code{require-theme} searches for a file named @var{feature} with an
|
||||
added @samp{.elc} or @samp{.el} suffix, in that order, in the
|
||||
directories specified by @code{custom-theme-load-path}.
|
||||
|
||||
If a file providing @var{feature} is successfully found and loaded,
|
||||
then @code{require-theme} returns @var{feature}. The optional
|
||||
argument @var{noerror} determines what happens if the search or
|
||||
loading fails. If it is @code{nil}, the function signals an error;
|
||||
otherwise, it returns @code{nil}. If the file loads successfully but
|
||||
does not provide @var{feature}, then @code{require-theme} signals an
|
||||
error; this cannot be suppressed.
|
||||
@end defun
|
||||
|
||||
@deffn Command enable-theme theme
|
||||
This function enables the Custom theme named @var{theme}. It signals
|
||||
an error if no such theme has been loaded.
|
||||
|
|
|
|||
8
etc/NEWS
8
etc/NEWS
|
|
@ -2528,11 +2528,11 @@ region's (or buffer's) end.
|
|||
This function can be used by modes to add elements to the
|
||||
'choice' customization type of a variable.
|
||||
|
||||
---
|
||||
+++
|
||||
** New function 'require-theme'.
|
||||
This function is used to load a theme or library stored in the
|
||||
'custom-theme-load-path'. It is intended to work as a substitute for
|
||||
'require' in those cases where that cannot be used.
|
||||
This function is like 'require', but searches 'custom-theme-load-path'
|
||||
instead of 'load-path'. It can be used by Custom themes to load
|
||||
supporting Lisp files when 'require' is unsuitable.
|
||||
|
||||
+++
|
||||
** New function 'file-modes-number-to-symbolic' to convert a numeric
|
||||
|
|
|
|||
|
|
@ -4661,6 +4661,4 @@ Also bind `class' to ((class color) (min-colors 89))."
|
|||
|
||||
(provide-theme 'modus-operandi)
|
||||
|
||||
(provide 'modus-operandi-theme)
|
||||
|
||||
;;; modus-operandi-theme.el ends here
|
||||
|
|
|
|||
|
|
@ -4661,6 +4661,4 @@ Also bind `class' to ((class color) (min-colors 89))."
|
|||
|
||||
(provide-theme 'modus-vivendi)
|
||||
|
||||
(provide 'modus-vivendi-theme)
|
||||
|
||||
;;; modus-vivendi-theme.el ends here
|
||||
|
|
|
|||
|
|
@ -1200,29 +1200,31 @@ property `theme-feature' (which is usually a symbol created by
|
|||
(custom-check-theme theme)
|
||||
(provide (get theme 'theme-feature)))
|
||||
|
||||
(defun require-theme (theme &optional path)
|
||||
"Load THEME stored in `custom-theme-load-path'.
|
||||
(defun require-theme (feature &optional noerror)
|
||||
"Load FEATURE from a file along `custom-theme-load-path'.
|
||||
|
||||
THEME is a symbol that corresponds to the file name without its file
|
||||
type extension. That is assumed to be either '.el' or '.elc'.
|
||||
This function is like `require', but searches along
|
||||
`custom-theme-load-path' instead of `load-path'. It can be used
|
||||
by Custom themes to load supporting Lisp files when `require' is
|
||||
unsuitable.
|
||||
|
||||
When THEME is an element of `custom-available-themes', load it and ask
|
||||
for confirmation if it is not considered safe by `custom-safe-themes'.
|
||||
Otherwise load the file indicated by THEME, if present. In the latter
|
||||
case, the file is intended to work as the basis of a theme declared
|
||||
with `deftheme'.
|
||||
If FEATURE is not already loaded, search for a file named FEATURE
|
||||
with an added `.elc' or `.el' suffix, in that order, in the
|
||||
directories specified by `custom-theme-load-path'.
|
||||
|
||||
If optional PATH is non-nil, it should be a list of directories
|
||||
to search for THEME in, instead of `custom-theme-load-path'.
|
||||
PATH should have the same form as `load-path' or `exec-path'."
|
||||
Return FEATURE if the file is successfully found and loaded, or
|
||||
if FEATURE was already loaded. If the file fails to load, signal
|
||||
an error. If optional argument NOERROR is non-nil, return nil
|
||||
instead of signaling an error. If the file loads but does not
|
||||
provide FEATURE, signal an error. This cannot be suppressed."
|
||||
(cond
|
||||
((memq theme (custom-available-themes))
|
||||
(load-theme theme))
|
||||
((let* ((dirs (or path (custom-theme--load-path)))
|
||||
(file (unless (featurep theme)
|
||||
(locate-file (symbol-name theme) dirs '(".el" ".elc")))))
|
||||
(when file
|
||||
(load-file file))))))
|
||||
((featurep feature) feature)
|
||||
((let* ((path (custom-theme--load-path))
|
||||
(file (locate-file (symbol-name feature) path '(".elc" ".el"))))
|
||||
(and file (require feature (file-name-sans-extension file) noerror))))
|
||||
((not noerror)
|
||||
(let (load-path)
|
||||
(require feature)))))
|
||||
|
||||
(defcustom custom-safe-themes '(default)
|
||||
"Themes that are considered safe to load.
|
||||
|
|
|
|||
|
|
@ -24,70 +24,108 @@
|
|||
|
||||
(require 'wid-edit)
|
||||
(require 'cus-edit)
|
||||
(require 'seq) ; For `seq-find'.
|
||||
|
||||
(defmacro custom-tests--with-temp-dir (&rest body)
|
||||
"Eval BODY with `temporary-file-directory' bound to a fresh directory.
|
||||
Ensure the directory is recursively deleted after the fact."
|
||||
(declare (debug t) (indent 0))
|
||||
(let ((dir (make-symbol "dir")))
|
||||
`(let ((,dir (file-name-as-directory (make-temp-file "custom-tests-" t))))
|
||||
(unwind-protect
|
||||
(let ((temporary-file-directory ,dir))
|
||||
,@body)
|
||||
(delete-directory ,dir t)))))
|
||||
|
||||
(ert-deftest custom-theme--load-path ()
|
||||
"Test `custom-theme--load-path' behavior."
|
||||
(let ((tmpdir (file-name-as-directory (make-temp-file "custom-tests-" t))))
|
||||
(unwind-protect
|
||||
;; Create all temporary files under the same deletable parent.
|
||||
(let ((temporary-file-directory tmpdir))
|
||||
;; Path is empty.
|
||||
(let ((custom-theme-load-path ()))
|
||||
(should (null (custom-theme--load-path))))
|
||||
(custom-tests--with-temp-dir
|
||||
;; Path is empty.
|
||||
(let ((custom-theme-load-path ()))
|
||||
(should (null (custom-theme--load-path))))
|
||||
|
||||
;; Path comprises non-existent file.
|
||||
(let* ((name (make-temp-name tmpdir))
|
||||
(custom-theme-load-path (list name)))
|
||||
(should (not (file-exists-p name)))
|
||||
(should (null (custom-theme--load-path))))
|
||||
;; Path comprises non-existent file.
|
||||
(let* ((name (make-temp-name temporary-file-directory))
|
||||
(custom-theme-load-path (list name)))
|
||||
(should (not (file-exists-p name)))
|
||||
(should (null (custom-theme--load-path))))
|
||||
|
||||
;; Path comprises existing file.
|
||||
(let* ((file (make-temp-file "file"))
|
||||
(custom-theme-load-path (list file)))
|
||||
(should (file-exists-p file))
|
||||
(should (not (file-directory-p file)))
|
||||
(should (null (custom-theme--load-path))))
|
||||
;; Path comprises existing file.
|
||||
(let* ((file (make-temp-file "file"))
|
||||
(custom-theme-load-path (list file)))
|
||||
(should (file-exists-p file))
|
||||
(should (not (file-directory-p file)))
|
||||
(should (null (custom-theme--load-path))))
|
||||
|
||||
;; Path comprises existing directory.
|
||||
(let* ((dir (make-temp-file "dir" t))
|
||||
(custom-theme-load-path (list dir)))
|
||||
(should (file-directory-p dir))
|
||||
(should (equal (custom-theme--load-path) custom-theme-load-path)))
|
||||
;; Path comprises existing directory.
|
||||
(let* ((dir (make-temp-file "dir" t))
|
||||
(custom-theme-load-path (list dir)))
|
||||
(should (file-directory-p dir))
|
||||
(should (equal (custom-theme--load-path) custom-theme-load-path)))
|
||||
|
||||
;; Expand `custom-theme-directory' path element.
|
||||
(let ((custom-theme-load-path '(custom-theme-directory)))
|
||||
(let ((custom-theme-directory (make-temp-name tmpdir)))
|
||||
(should (not (file-exists-p custom-theme-directory)))
|
||||
(should (null (custom-theme--load-path))))
|
||||
(let ((custom-theme-directory (make-temp-file "file")))
|
||||
(should (file-exists-p custom-theme-directory))
|
||||
(should (not (file-directory-p custom-theme-directory)))
|
||||
(should (null (custom-theme--load-path))))
|
||||
(let ((custom-theme-directory (make-temp-file "dir" t)))
|
||||
(should (file-directory-p custom-theme-directory))
|
||||
(should (equal (custom-theme--load-path)
|
||||
(list custom-theme-directory)))))
|
||||
;; Expand `custom-theme-directory' path element.
|
||||
(let ((custom-theme-load-path '(custom-theme-directory)))
|
||||
(let ((custom-theme-directory (make-temp-name temporary-file-directory)))
|
||||
(should (not (file-exists-p custom-theme-directory)))
|
||||
(should (null (custom-theme--load-path))))
|
||||
(let ((custom-theme-directory (make-temp-file "file")))
|
||||
(should (file-exists-p custom-theme-directory))
|
||||
(should (not (file-directory-p custom-theme-directory)))
|
||||
(should (null (custom-theme--load-path))))
|
||||
(let ((custom-theme-directory (make-temp-file "dir" t)))
|
||||
(should (file-directory-p custom-theme-directory))
|
||||
(should (equal (custom-theme--load-path)
|
||||
(list custom-theme-directory)))))
|
||||
|
||||
;; Expand t path element.
|
||||
(let ((custom-theme-load-path '(t)))
|
||||
(let ((data-directory (make-temp-name tmpdir)))
|
||||
(should (not (file-exists-p data-directory)))
|
||||
(should (null (custom-theme--load-path))))
|
||||
(let ((data-directory tmpdir)
|
||||
(themedir (expand-file-name "themes" tmpdir)))
|
||||
(should (not (file-exists-p themedir)))
|
||||
(should (null (custom-theme--load-path)))
|
||||
(with-temp-file themedir)
|
||||
(should (file-exists-p themedir))
|
||||
(should (not (file-directory-p themedir)))
|
||||
(should (null (custom-theme--load-path)))
|
||||
(delete-file themedir)
|
||||
(make-directory themedir)
|
||||
(should (file-directory-p themedir))
|
||||
(should (equal (custom-theme--load-path) (list themedir))))))
|
||||
(when (file-directory-p tmpdir)
|
||||
(delete-directory tmpdir t)))))
|
||||
;; Expand t path element.
|
||||
(let ((custom-theme-load-path '(t)))
|
||||
(let ((data-directory (make-temp-name temporary-file-directory)))
|
||||
(should (not (file-exists-p data-directory)))
|
||||
(should (null (custom-theme--load-path))))
|
||||
(let ((data-directory temporary-file-directory)
|
||||
(themedir (expand-file-name "themes" temporary-file-directory)))
|
||||
(should (not (file-exists-p themedir)))
|
||||
(should (null (custom-theme--load-path)))
|
||||
(with-temp-file themedir)
|
||||
(should (file-exists-p themedir))
|
||||
(should (not (file-directory-p themedir)))
|
||||
(should (null (custom-theme--load-path)))
|
||||
(delete-file themedir)
|
||||
(make-directory themedir)
|
||||
(should (file-directory-p themedir))
|
||||
(should (equal (custom-theme--load-path) (list themedir)))))))
|
||||
|
||||
(ert-deftest custom-tests-require-theme ()
|
||||
"Test `require-theme'."
|
||||
(custom-tests--with-temp-dir
|
||||
(let* ((default-directory temporary-file-directory)
|
||||
(custom-theme-load-path (list default-directory))
|
||||
(load-path ()))
|
||||
;; Generate some `.el' and `.elc' files.
|
||||
(with-temp-file "custom-tests--a.el"
|
||||
(insert "(provide 'custom-tests--a)"))
|
||||
(make-empty-file "custom-tests--b.el")
|
||||
(with-temp-file "custom-tests--b.elc"
|
||||
(byte-compile-insert-header nil (current-buffer))
|
||||
(insert "(provide 'custom-tests--b)"))
|
||||
(make-empty-file "custom-tests--c.el")
|
||||
(with-temp-file "custom-tests--d.elc"
|
||||
(byte-compile-insert-header nil (current-buffer)))
|
||||
;; Load them.
|
||||
(dolist (feature '(a b c d e))
|
||||
(should-not (featurep (intern (format "custom-tests--%s" feature)))))
|
||||
(should (eq (require-theme 'custom-tests--a) 'custom-tests--a))
|
||||
(delete-file "custom-tests--a.el")
|
||||
(dolist (feature '(custom-tests--a custom-tests--b))
|
||||
(should (eq (require-theme feature) feature))
|
||||
(should (featurep feature)))
|
||||
(dolist (feature '(custom-tests--c custom-tests--d))
|
||||
(dolist (noerror '(nil t))
|
||||
(let ((err (should-error (require-theme feature noerror))))
|
||||
(should (string-search "failed to provide feature" (cadr err))))))
|
||||
(should-error (require-theme 'custom-tests--e) :type 'file-missing)
|
||||
(should-not (require-theme 'custom-tests--e t))
|
||||
(dolist (feature '(custom-tests--c custom-tests--d custom-tests--e))
|
||||
(should-not (featurep feature))))))
|
||||
|
||||
(defcustom custom--test-user-option 'foo
|
||||
"User option for test."
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue