diff options
| author | Basil L. Contovounesios | 2018-06-04 02:12:33 +0100 |
|---|---|---|
| committer | Stefan Monnier | 2018-07-13 11:28:16 -0400 |
| commit | 70d702d3b1c40f72059bb5694bd805b1c65d141d (patch) | |
| tree | cb59139dbdde17172e36b649a598db478829a498 | |
| parent | 530aa469a4de7b4800557ae783f6c450df59a5b4 (diff) | |
| download | emacs-70d702d3b1c40f72059bb5694bd805b1c65d141d.tar.gz emacs-70d702d3b1c40f72059bb5694bd805b1c65d141d.zip | |
Fix custom-available-themes file expansion
For discussion, see thread starting at
https://lists.gnu.org/archive/html/emacs-devel/2018-05/msg00222.html.
* lisp/custom.el: (custom-available-themes): Use directory-files
instead of performing arbitrary wildcard expansion in file names.
(custom-theme--load-path): Document return value.
* test/lisp/custom-tests.el: New file.
(custom-theme--load-path): New test.
| -rw-r--r-- | lisp/custom.el | 26 | ||||
| -rw-r--r-- | test/lisp/custom-tests.el | 87 |
2 files changed, 103 insertions, 10 deletions
diff --git a/lisp/custom.el b/lisp/custom.el index b8ea8811a2a..4536788eb20 100644 --- a/lisp/custom.el +++ b/lisp/custom.el | |||
| @@ -1311,19 +1311,25 @@ The returned symbols may not correspond to themes that have been | |||
| 1311 | loaded, and no effort is made to check that the files contain | 1311 | loaded, and no effort is made to check that the files contain |
| 1312 | valid Custom themes. For a list of loaded themes, check the | 1312 | valid Custom themes. For a list of loaded themes, check the |
| 1313 | variable `custom-known-themes'." | 1313 | variable `custom-known-themes'." |
| 1314 | (let (sym themes) | 1314 | (let ((suffix "-theme\\.el\\'") |
| 1315 | themes) | ||
| 1315 | (dolist (dir (custom-theme--load-path)) | 1316 | (dolist (dir (custom-theme--load-path)) |
| 1316 | (when (file-directory-p dir) | 1317 | ;; `custom-theme--load-path' promises DIR exists and is a |
| 1317 | (dolist (file (file-expand-wildcards | 1318 | ;; directory, but `custom.el' is loaded too early during |
| 1318 | (expand-file-name "*-theme.el" dir) t)) | 1319 | ;; bootstrap to use `cl-lib' macros, so guard with |
| 1319 | (setq file (file-name-nondirectory file)) | 1320 | ;; `file-directory-p' instead of calling `cl-assert'. |
| 1320 | (and (string-match "\\`\\(.+\\)-theme.el\\'" file) | 1321 | (dolist (file (and (file-directory-p dir) |
| 1321 | (setq sym (intern (match-string 1 file))) | 1322 | (directory-files dir nil suffix))) |
| 1322 | (custom-theme-name-valid-p sym) | 1323 | (let ((theme (intern (substring file 0 (string-match-p suffix file))))) |
| 1323 | (push sym themes))))) | 1324 | (and (custom-theme-name-valid-p theme) |
| 1324 | (nreverse (delete-dups themes)))) | 1325 | (not (memq theme themes)) |
| 1326 | (push theme themes))))) | ||
| 1327 | (nreverse themes))) | ||
| 1325 | 1328 | ||
| 1326 | (defun custom-theme--load-path () | 1329 | (defun custom-theme--load-path () |
| 1330 | "Expand `custom-theme-load-path' into a list of directories. | ||
| 1331 | Members of `custom-theme-load-path' that either don't exist or | ||
| 1332 | are not directories are omitted from the expansion." | ||
| 1327 | (let (lpath) | 1333 | (let (lpath) |
| 1328 | (dolist (f custom-theme-load-path) | 1334 | (dolist (f custom-theme-load-path) |
| 1329 | (cond ((eq f 'custom-theme-directory) | 1335 | (cond ((eq f 'custom-theme-directory) |
diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el new file mode 100644 index 00000000000..96887f8f5fe --- /dev/null +++ b/test/lisp/custom-tests.el | |||
| @@ -0,0 +1,87 @@ | |||
| 1 | ;;; custom-tests.el --- tests for custom.el -*- lexical-binding: t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2018 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; This file is part of GNU Emacs. | ||
| 6 | |||
| 7 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 8 | ;; it under the terms of the GNU General Public License as published by | ||
| 9 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 10 | ;; (at your option) any later version. | ||
| 11 | |||
| 12 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 | ;; GNU General Public License for more details. | ||
| 16 | |||
| 17 | ;; You should have received a copy of the GNU General Public License | ||
| 18 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
| 19 | |||
| 20 | ;;; Code: | ||
| 21 | |||
| 22 | (require 'ert) | ||
| 23 | |||
| 24 | (ert-deftest custom-theme--load-path () | ||
| 25 | "Test `custom-theme--load-path' behavior." | ||
| 26 | (let ((tmpdir (file-name-as-directory (make-temp-file "custom-tests-" t)))) | ||
| 27 | (unwind-protect | ||
| 28 | ;; Create all temporary files under the same deletable parent. | ||
| 29 | (let ((temporary-file-directory tmpdir)) | ||
| 30 | ;; Path is empty. | ||
| 31 | (let ((custom-theme-load-path ())) | ||
| 32 | (should (null (custom-theme--load-path)))) | ||
| 33 | |||
| 34 | ;; Path comprises non-existent file. | ||
| 35 | (let* ((name (make-temp-name tmpdir)) | ||
| 36 | (custom-theme-load-path (list name))) | ||
| 37 | (should (not (file-exists-p name))) | ||
| 38 | (should (null (custom-theme--load-path)))) | ||
| 39 | |||
| 40 | ;; Path comprises existing file. | ||
| 41 | (let* ((file (make-temp-file "file")) | ||
| 42 | (custom-theme-load-path (list file))) | ||
| 43 | (should (file-exists-p file)) | ||
| 44 | (should (not (file-directory-p file))) | ||
| 45 | (should (null (custom-theme--load-path)))) | ||
| 46 | |||
| 47 | ;; Path comprises existing directory. | ||
| 48 | (let* ((dir (make-temp-file "dir" t)) | ||
| 49 | (custom-theme-load-path (list dir))) | ||
| 50 | (should (file-directory-p dir)) | ||
| 51 | (should (equal (custom-theme--load-path) custom-theme-load-path))) | ||
| 52 | |||
| 53 | ;; Expand `custom-theme-directory' path element. | ||
| 54 | (let ((custom-theme-load-path '(custom-theme-directory))) | ||
| 55 | (let ((custom-theme-directory (make-temp-name tmpdir))) | ||
| 56 | (should (not (file-exists-p custom-theme-directory))) | ||
| 57 | (should (null (custom-theme--load-path)))) | ||
| 58 | (let ((custom-theme-directory (make-temp-file "file"))) | ||
| 59 | (should (file-exists-p custom-theme-directory)) | ||
| 60 | (should (not (file-directory-p custom-theme-directory))) | ||
| 61 | (should (null (custom-theme--load-path)))) | ||
| 62 | (let ((custom-theme-directory (make-temp-file "dir" t))) | ||
| 63 | (should (file-directory-p custom-theme-directory)) | ||
| 64 | (should (equal (custom-theme--load-path) | ||
| 65 | (list custom-theme-directory))))) | ||
| 66 | |||
| 67 | ;; Expand t path element. | ||
| 68 | (let ((custom-theme-load-path '(t))) | ||
| 69 | (let ((data-directory (make-temp-name tmpdir))) | ||
| 70 | (should (not (file-exists-p data-directory))) | ||
| 71 | (should (null (custom-theme--load-path)))) | ||
| 72 | (let ((data-directory tmpdir) | ||
| 73 | (themedir (expand-file-name "themes" tmpdir))) | ||
| 74 | (should (not (file-exists-p themedir))) | ||
| 75 | (should (null (custom-theme--load-path))) | ||
| 76 | (with-temp-file themedir) | ||
| 77 | (should (file-exists-p themedir)) | ||
| 78 | (should (not (file-directory-p themedir))) | ||
| 79 | (should (null (custom-theme--load-path))) | ||
| 80 | (delete-file themedir) | ||
| 81 | (make-directory themedir) | ||
| 82 | (should (file-directory-p themedir)) | ||
| 83 | (should (equal (custom-theme--load-path) (list themedir)))))) | ||
| 84 | (when (file-directory-p tmpdir) | ||
| 85 | (delete-directory tmpdir t))))) | ||
| 86 | |||
| 87 | ;;; custom-tests.el ends here | ||