diff options
| author | Thierry Volpiatto <thievol@posteo.net> | 2023-08-23 13:12:28 +0000 |
|---|---|---|
| committer | Eli Zaretskii <eliz@gnu.org> | 2023-08-26 10:48:24 +0300 |
| commit | b70c71dc318bdae6de397521f76c518b210aab9b (patch) | |
| tree | 546bf3963438325c5c32e4436ea91b09f50276ae /lisp/cus-theme.el | |
| parent | 349798a9b81fb4f7f8e1e1963ea9039a4a68a471 (diff) | |
| download | emacs-b70c71dc318bdae6de397521f76c518b210aab9b.tar.gz | |
Improve 'describe-theme' (bug#65468)
* lisp/cus-theme.el (describe-theme-from-file): New function.
Diffstat (limited to 'lisp/cus-theme.el')
| -rw-r--r-- | lisp/cus-theme.el | 34 |
1 files changed, 25 insertions, 9 deletions
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 5d3f2585976..c6c9d9c892b 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -490,6 +490,29 @@ It includes all faces in list FACES." (with-current-buffer standard-output (describe-theme-1 theme)))) +(defun describe-theme-from-file (&optional file short) + "Describe theme from its file FILE without loading it. + +If FILE is nil try to find the file from the theme name in +`custom-theme-load-path'. +If SHORT is non nil show only the first line of documentation." + (let ((file (or file + (locate-file (concat (symbol-name theme) "-theme.el") + (custom-theme--load-path) + '("" "c"))))) + (with-temp-buffer + (insert-file-contents file) + (catch 'found + (let (sexp) + (while (setq sexp (let ((read-circle nil)) + (condition-case nil + (read (current-buffer)) + (end-of-file nil)))) + (when (eq (car-safe sexp) 'deftheme) + (throw 'found (if short + (car (split-string (nth 2 sexp) "\n")) + (nth 2 sexp)))))))))) + (defun describe-theme-1 (theme) (prin1 theme) (princ " is a custom theme") @@ -510,16 +533,9 @@ It includes all faces in list FACES." (princ "It is loaded but disabled.")) (setq doc (get theme 'theme-documentation))) (princ "It is not loaded.") - ;; Attempt to grab the theme documentation + ;; Attempt to grab the theme documentation from file. (when fn - (with-temp-buffer - (insert-file-contents fn) - (let ((sexp (let ((read-circle nil)) - (condition-case nil - (read (current-buffer)) - (end-of-file nil))))) - (and (eq (car-safe sexp) 'deftheme) - (setq doc (nth 2 sexp))))))) + (setq doc (describe-theme-from-file fn)))) (princ "\n\nDocumentation:\n") (princ (if (stringp doc) (substitute-command-keys doc) |