From 5368d8697d49ae8fb493031be22dee2dbe76624c Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 2 May 2018 21:18:24 +0100 Subject: [PATCH 3/8] 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 filenames. (custom-theme--load-path): Document return value. * test/lisp/custom-tests.el: New file. (custom-theme--load-path): New test. --- lisp/custom.el | 22 +++++----- test/lisp/custom-tests.el | 87 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 99 insertions(+), 10 deletions(-) create mode 100644 test/lisp/custom-tests.el diff --git a/lisp/custom.el b/lisp/custom.el index 1fed5dce53..157bb318e3 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1299,19 +1299,21 @@ custom-available-themes loaded, and no effort is made to check that the files contain valid Custom themes. For a list of loaded themes, check the variable `custom-known-themes'." - (let (sym themes) + (let ((suffix "-theme\\.el\\'") + themes) (dolist (dir (custom-theme--load-path)) - (when (file-directory-p dir) - (dolist (file (file-expand-wildcards - (expand-file-name "*-theme.el" dir) t)) - (setq file (file-name-nondirectory file)) - (and (string-match "\\`\\(.+\\)-theme.el\\'" file) - (setq sym (intern (match-string 1 file))) - (custom-theme-name-valid-p sym) - (push sym themes))))) - (nreverse (delete-dups themes)))) + ;; `custom-theme--load-path' promises DIR exists and is a directory. + (dolist (file (directory-files dir nil suffix)) + (let ((theme (intern (substring file 0 (string-match-p suffix file))))) + (and (custom-theme-name-valid-p theme) + (not (memq theme themes)) + (push theme themes))))) + (nreverse themes))) (defun custom-theme--load-path () + "Expand `custom-theme-load-path' into a list of directories. +Members of `custom-theme-load-path' that either don't exist or +are not directories are omitted from the expansion." (let (lpath) (dolist (f custom-theme-load-path) (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 0000000000..96887f8f5f --- /dev/null +++ b/test/lisp/custom-tests.el @@ -0,0 +1,87 @@ +;;; custom-tests.el --- tests for custom.el -*- lexical-binding: t -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'ert) + +(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.el ends here -- 2.17.0