emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 8e759d6: Decouple require-theme from load-theme


From: Basil L. Contovounesios
Subject: master 8e759d6: Decouple require-theme from load-theme
Date: Thu, 4 Mar 2021 10:46:52 -0500 (EST)

branch: master
commit 8e759d60cc234d4beb471dbb46f91d8ca3a20066
Author: Basil L. Contovounesios <contovob@tcd.ie>
Commit: Basil L. Contovounesios <contovob@tcd.ie>

    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.
---
 doc/lispref/customize.texi         |  26 +++++-
 etc/NEWS                           |   8 +-
 etc/themes/modus-operandi-theme.el |   2 -
 etc/themes/modus-vivendi-theme.el  |   2 -
 lisp/custom.el                     |  46 ++++++-----
 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 8fd12f7..bc35982 100644
--- a/doc/lispref/customize.texi
+++ b/doc/lispref/customize.texi
@@ -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.
diff --git a/etc/NEWS b/etc/NEWS
index b8413ae..b7799e7 100644
--- 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
diff --git a/etc/themes/modus-operandi-theme.el 
b/etc/themes/modus-operandi-theme.el
index 346000a..9d6e9ad 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))."
 
 (provide-theme 'modus-operandi)
 
-(provide 'modus-operandi-theme)
-
 ;;; modus-operandi-theme.el ends here
diff --git a/etc/themes/modus-vivendi-theme.el 
b/etc/themes/modus-vivendi-theme.el
index 73f07d6..1713132 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))."
 
 (provide-theme 'modus-vivendi)
 
-(provide 'modus-vivendi-theme)
-
 ;;; modus-vivendi-theme.el ends here
diff --git a/lisp/custom.el b/lisp/custom.el
index 35ac4d8..b9fccce 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -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.
diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el
index 09f79c1..02a9239 100644
--- a/test/lisp/custom-tests.el
+++ b/test/lisp/custom-tests.el
@@ -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))))
-
-          ;; 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."



reply via email to

[Prev in Thread] Current Thread [Next in Thread]