]> git.eshelyaron.com Git - emacs.git/commitdiff
Decouple require-theme from load-theme
authorBasil L. Contovounesios <contovob@tcd.ie>
Tue, 2 Mar 2021 14:35:50 +0000 (14:35 +0000)
committerBasil L. Contovounesios <contovob@tcd.ie>
Thu, 4 Mar 2021 15:40:35 +0000 (15:40 +0000)
* 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.

doc/lispref/customize.texi
etc/NEWS
etc/themes/modus-operandi-theme.el
etc/themes/modus-vivendi-theme.el
lisp/custom.el
test/lisp/custom-tests.el

index 8fd12f790264cc906bb093966e0eefea210f1f5a..bc35982c172c682c985fa0cfc48766fc41b372a4 100644 (file)
@@ -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.
index b8413ae080486e9a491c81494fbbeb5a1f71dd36..b7799e728e7cb7a35aa53e66b3a6714ca85d8e13 100644 (file)
--- a/etc/NEWS
+++ b/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
index 346000a09355cd6840c298987eb75db2129c31f3..9d6e9ad50fdfa450b1f6272907f5d0d37fd6ebcc 100644 (file)
@@ -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
index 73f07d644b73f0c84baa2f1918231a495bf090fc..171313244b50dadc34d71cdcf32a0354e45eb352 100644 (file)
@@ -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
index 35ac4d8564aa3110cbd5b469318901cfeccca91d..b9fccce583340975dfb0ac72965a2a8397d206ad 100644 (file)
@@ -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'.
-
-THEME is a symbol that corresponds to the file name without its file
-type extension.  That is assumed to be either '.el' or '.elc'.
-
-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 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'."
+(defun require-theme (feature &optional noerror)
+  "Load FEATURE from a file along `custom-theme-load-path'.
+
+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.
+
+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'.
+
+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.
index 09f79c1a089dfcb29d36141ec4c79fc887c224fd..02a9239824dc344558a40e51e09b086eed92f61e 100644 (file)
 
 (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))))
-
-          ;; 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 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)))
-
-          ;; 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 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)))))
+  (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 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 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 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 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."