From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: "Basil L. Contovounesios" Newsgroups: gmane.emacs.devel Subject: Re: Byte-compilation of custom themes Date: Tue, 03 Jul 2018 10:57:19 +0300 Message-ID: <87muv8u4yo.fsf@tcd.ie> References: <87efmk2qk0.fsf@tcd.ie> <87po5po7ul.fsf@tcd.ie> <87o9hoxm0w.fsf@tcd.ie> <83fu2ynvda.fsf@gnu.org> <87zi169q9y.fsf@tcd.ie> <83a7t6nlmf.fsf@gnu.org> <877eo9kjnl.fsf@tcd.ie> <831sehnymt.fsf@gnu.org> <874lim2pyi.fsf@tcd.ie> <83d0x9e8iu.fsf@gnu.org> <87vab110mi.fsf@tcd.ie> <83y3fxc7c4.fsf@gnu.org> <87muwc9kv0.fsf@tcd.ie> <83po17dhwe.fsf@gnu.org> <87y3fvua2x.fsf@tcd.ie> <83lgbvdev8.fsf@gnu.org> <87sh63rcar.fsf@tcd.ie> <871sdns5db.fsf@tcd.ie> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1530604582 17105 195.159.176.226 (3 Jul 2018 07:56:22 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 3 Jul 2018 07:56:22 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) Cc: Eli Zaretskii , emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Jul 03 09:56:18 2018 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1faGAa-0004IG-7d for ged-emacs-devel@m.gmane.org; Tue, 03 Jul 2018 09:56:16 +0200 Original-Received: from localhost ([::1]:38717 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1faGCh-0005Kt-KB for ged-emacs-devel@m.gmane.org; Tue, 03 Jul 2018 03:58:27 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:41356) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1faGBt-0004ws-HP for emacs-devel@gnu.org; Tue, 03 Jul 2018 03:57:42 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1faGBo-0000lw-1k for emacs-devel@gnu.org; Tue, 03 Jul 2018 03:57:37 -0400 Original-Received: from mail-wm0-x22b.google.com ([2a00:1450:400c:c09::22b]:52861) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1faGBn-0000kT-1q for emacs-devel@gnu.org; Tue, 03 Jul 2018 03:57:31 -0400 Original-Received: by mail-wm0-x22b.google.com with SMTP id w16-v6so1228175wmc.2 for ; Tue, 03 Jul 2018 00:57:30 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=tcd-ie.20150623.gappssmtp.com; s=20150623; h=from:to:cc:subject:references:date:message-id:user-agent :mime-version; bh=sXKxM2ZNTTEoZXnSWXG8hOx0ay//we9GIFIlKU6ziXE=; b=AdgQUqd57QIeie+yppeljgIg//W0U7qSUcSlV+HREXhTMKw/7iO8bgpA/bDkcGKa2z wkUETCUaG2Dak1jEwSOz9IgTSvQXVwkupOhmfq98V+o8+3O9CgPlUnxW2rDIClp0p8Pq ARPsoATezXP/l0vWjX8+WB6RWlzjhT60pwFf3xOwCRxJZCk5mGHnmdjOR3dNXqDMgAQP 6nzCTps9bVcGbksUwlwxh7BQhdgIECoLBsmlsvXpxeItl9Lp6TnTBnMOncGkqrnTTF2m ibQnvouy2EFvQCs/ctcr5MVSoZEIgEXhvnOwAUvKIcncxVF4DNbMgR+93J0WOy5ZuAS3 sPEg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:message-id :user-agent:mime-version; bh=sXKxM2ZNTTEoZXnSWXG8hOx0ay//we9GIFIlKU6ziXE=; b=DLNgiWWRaH6nfGcK6usetwlymJQT2f0MyUbhmhy0LKDsUYOCBir8LvbJn3ihylgyRc /hRpfXzwdLBGN+E5/YE15UOEwLLseZ+bF37FbpudFtUQjGW37UhTsu+uj3yiNdZ/2uGo YxtCxYlPAplOC2P9csv74UuRtb+0Y3OgzuMpRFMEOZv37PSbApBinZwYi5ANzTyM0iqx /go7fL26iHpdfDi9YZKAIVVm7MnZbJGI7UGXJZ/JUiK5Lk9OV3QoS0neM8Al+D5MGVWB MKDtn9iJBgitkqugmt8H4ndN3PGQIDE2MjlJnoMjh1ywFC8teuEkgoRHbecUVx92or0d LzjQ== X-Gm-Message-State: APt69E2eNCqvKX7GQEbtNGlCM4nM1QVI5L8FgC6bCzyG8KE5U9tg7y8S y2E/09uvGj9LaZsAWVkHdArsqw== X-Google-Smtp-Source: AAOMgpeyR1CVajeRn96Y9nltFvgPSvgS+yMbaAQKnjD7hQYAL3POy3CR8wSakM4nKF6JC87XRfe9+w== X-Received: by 2002:a1c:acc1:: with SMTP id v184-v6mr5057589wme.114.1530604649158; Tue, 03 Jul 2018 00:57:29 -0700 (PDT) Original-Received: from localhost (adsl-133.91.140.88.tellas.gr. [91.140.88.133]) by smtp.gmail.com with ESMTPSA id b16-v6sm543905wrm.15.2018.07.03.00.57.26 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Tue, 03 Jul 2018 00:57:27 -0700 (PDT) X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2a00:1450:400c:c09::22b X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:226898 Archived-At: --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Improve-loading-of-byte-compiled-custom-themes.patch >From d3c87ab44e78c24c7f2e20f343e9df2a92cd3354 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 9 May 2018 22:20:47 +0100 Subject: [PATCH 1/8] Improve loading of byte-compiled custom themes * lisp/custom.el (load-theme): Load byte-compiled file of safe themes when available. https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00614.html https://lists.gnu.org/archive/html/emacs-devel/2018-02/msg00060.html --- lisp/custom.el | 78 ++++++++++++++++++++++++++------------------------ 1 file changed, 41 insertions(+), 37 deletions(-) diff --git a/lisp/custom.el b/lisp/custom.el index 4a778a0573..b8ea8811a2 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1233,43 +1233,47 @@ load-theme (put theme 'theme-settings nil) (put theme 'theme-feature nil) (put theme 'theme-documentation nil)) - (let ((fn (locate-file (concat (symbol-name theme) "-theme.el") - (custom-theme--load-path) - '("" "c")))) - (unless fn - (error "Unable to find theme file for `%s'" theme)) - (with-temp-buffer - (insert-file-contents fn) - ;; Check file safety with `custom-safe-themes', prompting the - ;; user if necessary. - (when (or no-confirm - (eq custom-safe-themes t) - (and (memq 'default custom-safe-themes) - (equal (file-name-directory fn) - (expand-file-name "themes/" data-directory))) - (let ((hash (secure-hash 'sha256 (current-buffer)))) - (or (member hash custom-safe-themes) - (custom-theme-load-confirm hash)))) - (let ((custom--inhibit-theme-enable t) - (buffer-file-name fn)) ;For load-history. - (eval-buffer)) - ;; Optimization: if the theme changes the `default' face, put that - ;; entry first. This avoids some `frame-set-background-mode' rigmarole - ;; by assigning the new background immediately. - (let* ((settings (get theme 'theme-settings)) - (tail settings) - found) - (while (and tail (not found)) - (and (eq (nth 0 (car tail)) 'theme-face) - (eq (nth 1 (car tail)) 'default) - (setq found (car tail))) - (setq tail (cdr tail))) - (if found - (put theme 'theme-settings (cons found (delq found settings))))) - ;; Finally, enable the theme. - (unless no-enable - (enable-theme theme)) - t)))) + (let ((file (locate-file (concat (symbol-name theme) "-theme.el") + (custom-theme--load-path) + '("" "c"))) + (custom--inhibit-theme-enable t)) + ;; Check file safety with `custom-safe-themes', prompting the + ;; user if necessary. + (cond ((not file) + (error "Unable to find theme file for `%s'" theme)) + ((or no-confirm + (eq custom-safe-themes t) + (and (memq 'default custom-safe-themes) + (equal (file-name-directory file) + (expand-file-name "themes/" data-directory)))) + ;; Theme is safe; load byte-compiled version if available. + (load (file-name-sans-extension file) nil t nil t)) + ((with-temp-buffer + (insert-file-contents file) + (let ((hash (secure-hash 'sha256 (current-buffer)))) + (when (or (member hash custom-safe-themes) + (custom-theme-load-confirm hash)) + (eval-buffer nil nil file) + t)))) + (t + (error "Unable to load theme `%s'" theme)))) + ;; Optimization: if the theme changes the `default' face, put that + ;; entry first. This avoids some `frame-set-background-mode' rigmarole + ;; by assigning the new background immediately. + (let* ((settings (get theme 'theme-settings)) + (tail settings) + found) + (while (and tail (not found)) + (and (eq (nth 0 (car tail)) 'theme-face) + (eq (nth 1 (car tail)) 'default) + (setq found (car tail))) + (setq tail (cdr tail))) + (when found + (put theme 'theme-settings (cons found (delq found settings))))) + ;; Finally, enable the theme. + (unless no-enable + (enable-theme theme)) + t) (defun custom-theme-load-confirm (hash) "Query the user about loading a Custom theme that may not be safe. -- 2.18.0 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0002-Disable-no-byte-compile-in-built-in-themes.patch >From 79d06b99e9aedd2bebaa2dff39157f50feacc474 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 9 May 2018 22:30:48 +0100 Subject: [PATCH 2/8] Disable no-byte-compile in built-in themes * etc/themes/adwaita-theme.el: * etc/themes/deeper-blue-theme.el: * etc/themes/dichromacy-theme.el: * etc/themes/leuven-theme.el: * etc/themes/light-blue-theme.el: * etc/themes/manoj-dark-theme.el: * etc/themes/misterioso-theme.el: * etc/themes/tango-dark-theme.el: * etc/themes/tango-theme.el: * etc/themes/tsdh-dark-theme.el: * etc/themes/tsdh-light-theme.el: * etc/themes/wheatgrass-theme.el: * etc/themes/whiteboard-theme.el: * etc/themes/wombat-theme.el: Disable no-byte-compile. https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00614.html https://lists.gnu.org/archive/html/emacs-devel/2018-02/msg00060.html --- etc/themes/adwaita-theme.el | 4 ---- etc/themes/deeper-blue-theme.el | 4 ---- etc/themes/dichromacy-theme.el | 4 ---- etc/themes/leuven-theme.el | 1 - etc/themes/light-blue-theme.el | 4 ---- etc/themes/manoj-dark-theme.el | 4 ---- etc/themes/misterioso-theme.el | 4 ---- etc/themes/tango-dark-theme.el | 4 ---- etc/themes/tango-theme.el | 4 ---- etc/themes/tsdh-dark-theme.el | 4 ---- etc/themes/tsdh-light-theme.el | 5 ----- etc/themes/wheatgrass-theme.el | 4 ---- etc/themes/whiteboard-theme.el | 4 ---- etc/themes/wombat-theme.el | 4 ---- 14 files changed, 54 deletions(-) diff --git a/etc/themes/adwaita-theme.el b/etc/themes/adwaita-theme.el index b376153510..415db8a191 100644 --- a/etc/themes/adwaita-theme.el +++ b/etc/themes/adwaita-theme.el @@ -99,8 +99,4 @@ adwaita `(diff-added ((,class (:bold t :foreground "#4E9A06")))) `(diff-removed ((,class (:bold t :foreground "#F5666D")))))) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; adwaita-theme.el ends here diff --git a/etc/themes/deeper-blue-theme.el b/etc/themes/deeper-blue-theme.el index c6aa1751f4..0700f4f23d 100644 --- a/etc/themes/deeper-blue-theme.el +++ b/etc/themes/deeper-blue-theme.el @@ -110,8 +110,4 @@ deeper-blue (provide-theme 'deeper-blue) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; deeper-blue-theme.el ends here diff --git a/etc/themes/dichromacy-theme.el b/etc/themes/dichromacy-theme.el index 793209c055..bfced43aee 100644 --- a/etc/themes/dichromacy-theme.el +++ b/etc/themes/dichromacy-theme.el @@ -122,8 +122,4 @@ dichromacy (provide-theme 'dichromacy) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; dichromacy-theme.el ends here diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el index 5c0d19ce81..c3c666588b 100644 --- a/etc/themes/leuven-theme.el +++ b/etc/themes/leuven-theme.el @@ -708,7 +708,6 @@ leuven ;; time-stamp-format: "%:y%02m%02d.%02H%02M" ;; time-stamp-start: "Version: " ;; time-stamp-end: "$" -;; no-byte-compile: t ;; End: ;;; leuven-theme.el ends here diff --git a/etc/themes/light-blue-theme.el b/etc/themes/light-blue-theme.el index 9935c565fb..ba00db6a49 100644 --- a/etc/themes/light-blue-theme.el +++ b/etc/themes/light-blue-theme.el @@ -61,8 +61,4 @@ light-blue (provide-theme 'light-blue) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; light-blue-theme.el ends here diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el index fe61441d78..ddcaa0bd99 100644 --- a/etc/themes/manoj-dark-theme.el +++ b/etc/themes/manoj-dark-theme.el @@ -700,8 +700,4 @@ manoj-dark (provide-theme 'manoj-dark) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; manoj-dark.el ends here diff --git a/etc/themes/misterioso-theme.el b/etc/themes/misterioso-theme.el index 42e448d28b..6c1eec0f42 100644 --- a/etc/themes/misterioso-theme.el +++ b/etc/themes/misterioso-theme.el @@ -103,8 +103,4 @@ misterioso (provide-theme 'misterioso) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; misterioso-theme.el ends here diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el index 3b6eeb702e..dae77a5e62 100644 --- a/etc/themes/tango-dark-theme.el +++ b/etc/themes/tango-dark-theme.el @@ -170,8 +170,4 @@ tango-dark (provide-theme 'tango-dark) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; tango-dark-theme.el ends here diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el index a7a79c04ad..4fe2480bc7 100644 --- a/etc/themes/tango-theme.el +++ b/etc/themes/tango-theme.el @@ -154,8 +154,4 @@ tango (provide-theme 'tango) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; tango-theme.el ends here diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el index 287fef8253..c216750cb2 100644 --- a/etc/themes/tsdh-dark-theme.el +++ b/etc/themes/tsdh-dark-theme.el @@ -144,8 +144,4 @@ tsdh-dark (provide-theme 'tsdh-dark) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; tsdh-dark-theme.el ends here diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el index 17a86fdbfe..ce9d1a2c3c 100644 --- a/etc/themes/tsdh-light-theme.el +++ b/etc/themes/tsdh-light-theme.el @@ -106,9 +106,4 @@ tsdh-light (provide-theme 'tsdh-light) - -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; tsdh-light-theme.el ends here diff --git a/etc/themes/wheatgrass-theme.el b/etc/themes/wheatgrass-theme.el index 9585e3aa6e..8d34c28bf4 100644 --- a/etc/themes/wheatgrass-theme.el +++ b/etc/themes/wheatgrass-theme.el @@ -83,8 +83,4 @@ wheatgrass (provide-theme 'wheatgrass) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; wheatgrass-theme.el ends here diff --git a/etc/themes/whiteboard-theme.el b/etc/themes/whiteboard-theme.el index 5db0ddd68d..fe46cb0928 100644 --- a/etc/themes/whiteboard-theme.el +++ b/etc/themes/whiteboard-theme.el @@ -100,8 +100,4 @@ whiteboard (provide-theme 'whiteboard) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; whiteboard-theme.el ends here diff --git a/etc/themes/wombat-theme.el b/etc/themes/wombat-theme.el index 583b8dc3f6..00f29bb9fa 100644 --- a/etc/themes/wombat-theme.el +++ b/etc/themes/wombat-theme.el @@ -102,8 +102,4 @@ wombat (provide-theme 'wombat) -;; Local Variables: -;; no-byte-compile: t -;; End: - ;;; wombat-theme.el ends here -- 2.18.0 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0003-Fix-custom-available-themes-file-expansion.patch >From 6db2601d2082d949e44f15420a016e26f20745dd Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Mon, 4 Jun 2018 02:12:33 +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 file names. (custom-theme--load-path): Document return value. * test/lisp/custom-tests.el: New file. (custom-theme--load-path): New test. --- lisp/custom.el | 26 +++++++----- test/lisp/custom-tests.el | 87 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 103 insertions(+), 10 deletions(-) create mode 100644 test/lisp/custom-tests.el diff --git a/lisp/custom.el b/lisp/custom.el index b8ea8811a2..4536788eb2 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1311,19 +1311,25 @@ 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, but `custom.el' is loaded too early during + ;; bootstrap to use `cl-lib' macros, so guard with + ;; `file-directory-p' instead of calling `cl-assert'. + (dolist (file (and (file-directory-p dir) + (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.18.0 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0004-lisp-custom.el-Use-lexical-binding.patch >From c160ae70cf26be48ff23dc5ebb700eb819df58c9 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Fri, 11 May 2018 16:09:57 +0100 Subject: [PATCH 4/8] * lisp/custom.el: Use lexical-binding Remove duplicate 'Custom Themes' comment heading. (deftheme, custom-declare-theme): Fix advertised calling convention. (custom-enabled-themes): Fix message grammar. --- lisp/custom.el | 50 +++++++++++++++++++++++++------------------------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/lisp/custom.el b/lisp/custom.el index 4536788eb2..1c667c8aa2 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1,4 +1,4 @@ -;;; custom.el --- tools for declaring and initializing options +;;; custom.el --- tools for declaring and initializing options -*- lexical-binding: t -*- ;; ;; Copyright (C) 1996-1997, 1999, 2001-2018 Free Software Foundation, ;; Inc. @@ -150,7 +150,7 @@ custom-declare-variable (put symbol 'force-value nil)) (if (keywordp doc) (error "Doc string is missing")) - (let ((initialize 'custom-initialize-reset) + (let ((initialize #'custom-initialize-reset) (requests nil)) (unless (memq :group args) (custom-add-to-group (custom-current-group) symbol 'custom-variable)) @@ -426,7 +426,7 @@ custom-current-group (defun custom-declare-group (symbol members doc &rest args) "Like `defgroup', but SYMBOL is evaluated as a normal argument." (while members - (apply 'custom-add-to-group symbol (car members)) + (apply #'custom-add-to-group symbol (car members)) (setq members (cdr members))) (when doc ;; This text doesn't get into DOC. @@ -618,11 +618,8 @@ custom-note-var-changed The result is that the change is treated as having been made through Custom." (put variable 'customized-value (list (custom-quote (eval variable))))) - -;;; Custom Themes - -;;; Loading files needed to customize a symbol. -;;; This is in custom.el because menu-bar.el needs it for toggle cmds. +;; Loading files needed to customize a symbol. +;; This is in custom.el because menu-bar.el needs it for toggle cmds. (defvar custom-load-recursion nil "Hack to avoid recursive dependencies.") @@ -715,7 +712,7 @@ customize-mark-to-save Return non-nil if the `saved-value' property actually changed." (custom-load-symbol symbol) - (let* ((get (or (get symbol 'custom-get) 'default-value)) + (let* ((get (or (get symbol 'custom-get) #'default-value)) (value (funcall get symbol)) (saved (get symbol 'saved-value)) (standard (get symbol 'standard-value)) @@ -744,7 +741,7 @@ customize-mark-as-set Return non-nil if the `customized-value' property actually changed." (custom-load-symbol symbol) - (let* ((get (or (get symbol 'custom-get) 'default-value)) + (let* ((get (or (get symbol 'custom-get) #'default-value)) (value (funcall get symbol)) (customized (get symbol 'customized-value)) (old (or (get symbol 'saved-value) (get symbol 'standard-value)))) @@ -776,7 +773,7 @@ custom-reevaluate-setting ;; always do the funcall step, even if symbol was not bound before. (or (default-boundp symbol) (eval `(defvar ,symbol nil))) ; reset below, so any value is fine - (funcall (or (get symbol 'custom-set) 'set-default) + (funcall (or (get symbol 'custom-set) #'set-default) symbol (eval (car (or (get symbol 'saved-value) (get symbol 'standard-value)))))) @@ -946,7 +943,7 @@ custom-set-variables REQUEST is a list of features we must require in order to handle SYMBOL properly. COMMENT is a comment string about SYMBOL." - (apply 'custom-theme-set-variables 'user args)) + (apply #'custom-theme-set-variables 'user args)) (defun custom-theme-set-variables (theme &rest args) "Initialize variables for theme THEME according to settings in ARGS. @@ -994,8 +991,8 @@ custom-theme-set-variables set) (when requests (put symbol 'custom-requests requests) - (mapc 'require requests)) - (setq set (or (get symbol 'custom-set) 'custom-set-default)) + (mapc #'require requests)) + (setq set (or (get symbol 'custom-set) #'custom-set-default)) (put symbol 'saved-value (list value)) (put symbol 'saved-variable-comment comment) ;; Allow for errors in the case where the setter has @@ -1091,26 +1088,29 @@ custom--sort-vars-1 ;; they were used to supply keyword-value pairs like `:immediate', ;; `:variable-reset-string', etc. We don't use any of these, so ignore them. -(defmacro deftheme (theme &optional doc &rest ignored) +(defmacro deftheme (theme &optional doc &rest _ignored) "Declare THEME to be a Custom theme. The optional argument DOC is a doc string describing the theme. Any theme `foo' should be defined in a file called `foo-theme.el'; see `custom-make-theme-feature' for more information." - (declare (doc-string 2)) + (declare (doc-string 2) + (advertised-calling-convention (theme &optional doc) "22.1")) (let ((feature (custom-make-theme-feature theme))) ;; It is better not to use backquote in this file, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. (list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc))) -(defun custom-declare-theme (theme feature &optional doc &rest ignored) +(defun custom-declare-theme (theme feature &optional doc &rest _ignored) "Like `deftheme', but THEME is evaluated as a normal argument. FEATURE is the feature this theme provides. Normally, this is a symbol created from THEME by `custom-make-theme-feature'." + (declare (advertised-calling-convention (theme feature &optional doc) "22.1")) (unless (custom-theme-name-valid-p theme) (error "Custom theme cannot be named %S" theme)) - (add-to-list 'custom-known-themes theme) + (unless (memq theme custom-known-themes) + (push theme custom-known-themes)) (put theme 'theme-feature feature) (when doc (put theme 'theme-documentation doc))) @@ -1218,7 +1218,7 @@ load-theme (interactive (list (intern (completing-read "Load custom theme: " - (mapcar 'symbol-name + (mapcar #'symbol-name (custom-available-themes)))) nil nil)) (unless (custom-theme-name-valid-p theme) @@ -1411,9 +1411,9 @@ custom-enabled-themes themes (delq theme themes))))) (enable-theme 'user) (custom-set-default symbol themes) - (if failures - (message "Failed to enable theme: %s" - (mapconcat 'symbol-name failures ", ")))))) + (when failures + (message "Failed to enable theme(s): %s" + (mapconcat #'symbol-name failures ", ")))))) (defsubst custom-theme-enabled-p (theme) "Return non-nil if THEME is enabled." @@ -1425,7 +1425,7 @@ disable-theme (interactive (list (intern (completing-read "Disable custom theme: " - (mapcar 'symbol-name custom-enabled-themes) + (mapcar #'symbol-name custom-enabled-themes) nil t)))) (when (custom-theme-enabled-p theme) (let ((settings (get theme 'theme-settings))) @@ -1491,7 +1491,7 @@ custom-theme-recalc-variable (if (and valspec (or (get variable 'force-value) (default-boundp variable))) - (funcall (or (get variable 'custom-set) 'set-default) variable + (funcall (or (get variable 'custom-set) #'set-default) variable (eval (car valspec)))))) (defun custom-theme-recalc-face (face) @@ -1532,7 +1532,7 @@ custom-reset-variables (VARIABLE IGNORED) This means reset VARIABLE. (The argument IGNORED is ignored)." - (apply 'custom-theme-reset-variables 'user args)) + (apply #'custom-theme-reset-variables 'user args)) ;;; The End. -- 2.18.0 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0005-lisp-cus-theme.el-Use-lexical-binding.patch >From f0d70f5c4834ba5baff668ea2ee171eed7faea81 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Fri, 11 May 2018 15:35:09 +0100 Subject: [PATCH 5/8] * lisp/cus-theme.el: Use lexical-binding --- lisp/cus-theme.el | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index e5e787771b..53389956ad 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -1,4 +1,4 @@ -;;; cus-theme.el -- custom theme creation user interface +;;; cus-theme.el -- custom theme creation user interface -*- lexical-binding: t -*- ;; ;; Copyright (C) 2001-2018 Free Software Foundation, Inc. ;; @@ -47,7 +47,7 @@ custom-new-theme-mode Do not call this mode function yourself. It is meant for internal use." (use-local-map custom-new-theme-mode-map) (custom--initialize-widget-variables) - (set (make-local-variable 'revert-buffer-function) 'custom-theme-revert)) + (set (make-local-variable 'revert-buffer-function) #'custom-theme-revert)) (put 'custom-new-theme-mode 'mode-class 'special) (defvar custom-theme-name nil) @@ -118,13 +118,13 @@ customize-create-theme :tag " Visit Theme " :help-echo "Insert the settings of a pre-defined theme." :action (lambda (_widget &optional _event) - (call-interactively 'custom-theme-visit-theme))) + (call-interactively #'custom-theme-visit-theme))) (widget-insert " ") (widget-create 'push-button :tag " Merge Theme " :help-echo "Merge in the settings of a pre-defined theme." :action (lambda (_widget &optional _event) - (call-interactively 'custom-theme-merge-theme))) + (call-interactively #'custom-theme-merge-theme))) (widget-insert " ") (widget-create 'push-button :tag " Revert " @@ -142,7 +142,7 @@ customize-create-theme (widget-create 'text :value (format-time-string "Created %Y-%m-%d."))) (widget-create 'push-button - :notify (function custom-theme-write) + :notify #'custom-theme-write " Save Theme ") (when (eq theme 'user) (setq custom-theme--migrate-settings t) @@ -188,7 +188,7 @@ customize-create-theme :mouse-face 'highlight :pressed-face 'highlight :action (lambda (_widget &optional _event) - (call-interactively 'custom-theme-add-face))) + (call-interactively #'custom-theme-add-face))) ;; If THEME is non-nil, insert all of that theme's variables. (widget-insert "\n\n Theme variables:\n ") @@ -207,7 +207,7 @@ customize-create-theme :mouse-face 'highlight :pressed-face 'highlight :action (lambda (_widget &optional _event) - (call-interactively 'custom-theme-add-variable))) + (call-interactively #'custom-theme-add-variable))) (widget-insert ?\n) (widget-setup) (goto-char (point-min)) @@ -254,7 +254,7 @@ custom-theme-add-var-1 :tag (custom-unlispify-tag-name symbol) :value symbol :shown-value (list val) - :notify 'ignore + :notify #'ignore :custom-level 0 :custom-state 'hidden :custom-style 'simple)) @@ -313,7 +313,7 @@ custom-theme-visit-theme (interactive (list (intern (completing-read "Find custom theme: " - (mapcar 'symbol-name + (mapcar #'symbol-name (custom-available-themes)))))) (unless (custom-theme-name-valid-p theme) (error "No valid theme named `%s'" theme)) @@ -328,7 +328,7 @@ custom-theme-merge-theme (interactive (list (intern (completing-read "Merge custom theme: " - (mapcar 'symbol-name + (mapcar #'symbol-name (custom-available-themes)))))) (unless (eq theme 'user) (unless (custom-theme-name-valid-p theme) @@ -343,8 +343,8 @@ custom-theme-merge-theme (memq name '(custom-enabled-themes custom-safe-themes))) (funcall (if option - 'custom-theme-add-variable - 'custom-theme-add-face) + #'custom-theme-add-variable + #'custom-theme-add-face) name value))))) theme) @@ -475,7 +475,7 @@ describe-theme (interactive (list (intern (completing-read "Describe custom theme: " - (mapcar 'symbol-name + (mapcar #'symbol-name (custom-available-themes)))))) (unless (custom-theme-name-valid-p theme) (error "Invalid theme name `%s'" theme)) @@ -616,11 +616,11 @@ customize-themes (widget-create 'push-button :tag " Save Theme Settings " :help-echo "Save the selected themes for future sessions." - :action 'custom-theme-save) + :action #'custom-theme-save) (widget-insert ?\n) (widget-create 'checkbox :value custom-theme-allow-multiple-selections - :action 'custom-theme-selections-toggle) + :action #'custom-theme-selections-toggle) (widget-insert (propertize " Select more than one theme at a time" 'face '(variable-pitch (:height 0.9)))) @@ -632,13 +632,13 @@ customize-themes :value (custom-theme-enabled-p theme) :theme-name theme :help-echo help-echo - :action 'custom-theme-checkbox-toggle)) + :action #'custom-theme-checkbox-toggle)) (push (cons theme widget) custom--listed-themes) (widget-create-child-and-convert widget 'push-button :button-face-get 'ignore :mouse-face-get 'ignore :value (format " %s" theme) - :action 'widget-parent-action + :action #'widget-parent-action :help-echo help-echo) (widget-insert " -- " (propertize (custom-theme-summary theme) -- 2.18.0 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0006-Minor-custom.el-simplifications.patch >From 3ace45ec8797dce64f5bcc33eaeb423c11b0aa71 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Thu, 31 May 2018 18:37:02 +0100 Subject: [PATCH 6/8] Minor custom.el simplifications * lisp/custom.el (custom-quote): Duplicate macroexp-quote. (custom-load-symbol, customize-mark-to-save, customize-mark-as-set) (custom-theme-name-valid-p, enable-theme, custom-enabled-themes) (disable-theme): Simplify logic. --- lisp/custom.el | 103 ++++++++++++++++++++++--------------------------- 1 file changed, 46 insertions(+), 57 deletions(-) diff --git a/lisp/custom.el b/lisp/custom.el index 1c667c8aa2..a08f7fda70 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -630,14 +630,12 @@ custom-load-symbol (let ((custom-load-recursion t)) ;; Load these files if not already done, ;; to make sure we know all the dependencies of SYMBOL. - (condition-case nil - (require 'cus-load) - (error nil)) - (condition-case nil - (require 'cus-start) - (error nil)) + (ignore-errors + (require 'cus-load)) + (ignore-errors + (require 'cus-start)) (dolist (load (get symbol 'custom-loads)) - (cond ((symbolp load) (condition-case nil (require load) (error nil))) + (cond ((symbolp load) (ignore-errors (require load))) ;; This is subsumed by the test below, but it's much faster. ((assoc load load-history)) ;; This was just (assoc (locate-library load) load-history) @@ -655,7 +653,7 @@ custom-load-symbol ;; We are still loading it when we call this, ;; and it is not in load-history yet. ((equal load "cus-edit")) - (t (condition-case nil (load load) (error nil)))))))) + (t (ignore-errors (load load)))))))) (defvar custom-local-buffer nil "Non-nil, in a Customization buffer, means customize a specific buffer. @@ -688,16 +686,12 @@ custom-set-minor-mode (defun custom-quote (sexp) "Quote SEXP if it is not self quoting." - (if (or (memq sexp '(t nil)) - (keywordp sexp) - (and (listp sexp) - (memq (car sexp) '(lambda))) - (stringp sexp) - (numberp sexp) - (vectorp sexp) -;;; (and (fboundp 'characterp) -;;; (characterp sexp)) - ) + ;; Can't use `macroexp-quote' because it is loaded after `custom.el' + ;; during bootstrap. See `loadup.el'. + (if (and (not (consp sexp)) + (or (keywordp sexp) + (not (symbolp sexp)) + (booleanp sexp))) sexp (list 'quote sexp))) @@ -718,12 +712,10 @@ customize-mark-to-save (standard (get symbol 'standard-value)) (comment (get symbol 'customized-variable-comment))) ;; Save default value if different from standard value. - (if (or (null standard) - (not (equal value (condition-case nil - (eval (car standard)) - (error nil))))) - (put symbol 'saved-value (list (custom-quote value))) - (put symbol 'saved-value nil)) + (put symbol 'saved-value + (unless (and standard + (equal value (ignore-errors (eval (car standard))))) + (list (custom-quote value)))) ;; Clear customized information (set, but not saved). (put symbol 'customized-value nil) ;; Save any comment that might have been set. @@ -747,9 +739,8 @@ customize-mark-as-set (old (or (get symbol 'saved-value) (get symbol 'standard-value)))) ;; Mark default value as set if different from old value. (if (not (and old - (equal value (condition-case nil - (eval (car old)) - (error nil))))) + (equal value (ignore-errors + (eval (car old)))))) (progn (put symbol 'customized-value (list (custom-quote value))) (custom-push-theme 'theme-value symbol 'user 'set (custom-quote value))) @@ -1296,11 +1287,9 @@ custom-theme-load-confirm (defun custom-theme-name-valid-p (name) "Return t if NAME is a valid name for a Custom theme, nil otherwise. NAME should be a symbol." - (and (symbolp name) - name - (not (or (zerop (length (symbol-name name))) - (eq name 'user) - (eq name 'changed))))) + (and (not (memq name '(nil user changed))) + (symbolp name) + (not (string= "" (symbol-name name))))) (defun custom-available-themes () "Return a list of Custom themes available for loading. @@ -1356,8 +1345,8 @@ enable-theme (completing-read "Enable custom theme: " obarray (lambda (sym) (get sym 'theme-settings)) t)))) - (if (not (custom-theme-p theme)) - (error "Undefined Custom theme %s" theme)) + (unless (custom-theme-p theme) + (error "Undefined Custom theme %s" theme)) (let ((settings (get theme 'theme-settings))) ;; Loop through theme settings, recalculating vars/faces. (dolist (s settings) @@ -1397,18 +1386,18 @@ custom-enabled-themes (let (failures) (setq themes (delq 'user (delete-dups themes))) ;; Disable all themes not in THEMES. - (if (boundp symbol) - (dolist (theme (symbol-value symbol)) - (if (not (memq theme themes)) - (disable-theme theme)))) + (dolist (theme (and (boundp symbol) + (symbol-value symbol))) + (unless (memq theme themes) + (disable-theme theme))) ;; Call `enable-theme' or `load-theme' on each of THEMES. (dolist (theme (reverse themes)) (condition-case nil (if (custom-theme-p theme) (enable-theme theme) (load-theme theme)) - (error (setq failures (cons theme failures) - themes (delq theme themes))))) + (error (push theme failures) + (setq themes (delq theme themes))))) (enable-theme 'user) (custom-set-default symbol themes) (when failures @@ -1441,23 +1430,23 @@ disable-theme ;; If the face spec specified by this theme is in the ;; saved-face property, reset that property. (when (equal (nth 3 s) (get symbol 'saved-face)) - (put symbol 'saved-face (and val (cadr (car val))))))))) - ;; Recompute faces on all frames. - (dolist (frame (frame-list)) - ;; We must reset the fg and bg color frame parameters, or - ;; `face-set-after-frame-default' will use the existing - ;; parameters, which could be from the disabled theme. - (set-frame-parameter frame 'background-color - (custom--frame-color-default - frame :background "background" "Background" - "unspecified-bg" "white")) - (set-frame-parameter frame 'foreground-color - (custom--frame-color-default - frame :foreground "foreground" "Foreground" - "unspecified-fg" "black")) - (face-set-after-frame-default frame)) - (setq custom-enabled-themes - (delq theme custom-enabled-themes))))) + (put symbol 'saved-face (cadar val)))))))) + ;; Recompute faces on all frames. + (dolist (frame (frame-list)) + ;; We must reset the fg and bg color frame parameters, or + ;; `face-set-after-frame-default' will use the existing + ;; parameters, which could be from the disabled theme. + (set-frame-parameter frame 'background-color + (custom--frame-color-default + frame :background "background" "Background" + "unspecified-bg" "white")) + (set-frame-parameter frame 'foreground-color + (custom--frame-color-default + frame :foreground "foreground" "Foreground" + "unspecified-fg" "black")) + (face-set-after-frame-default frame)) + (setq custom-enabled-themes + (delq theme custom-enabled-themes)))) ;; Only used if window-system not null. (declare-function x-get-resource "frame.c" -- 2.18.0 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0007-Minor-cus-theme.el-simplifications.patch >From b7a38177595b54b5312078df9f99eacf29572421 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Thu, 10 May 2018 03:08:10 +0100 Subject: [PATCH 7/8] Minor cus-theme.el simplifications * lisp/cus-theme.el (custom-new-theme-mode, customize-themes) (custom-theme-choose-mode): Use setq-local. (customize-create-theme): Ditto. Use delete-all-overlays. (describe-theme-1, custom-theme-summary): Simplify logic. --- lisp/cus-theme.el | 31 ++++++++++++++----------------- 1 file changed, 14 insertions(+), 17 deletions(-) diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 53389956ad..995c55b2b2 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -47,7 +47,7 @@ custom-new-theme-mode Do not call this mode function yourself. It is meant for internal use." (use-local-map custom-new-theme-mode-map) (custom--initialize-widget-variables) - (set (make-local-variable 'revert-buffer-function) #'custom-theme-revert)) + (setq-local revert-buffer-function #'custom-theme-revert)) (put 'custom-new-theme-mode 'mode-class 'special) (defvar custom-theme-name nil) @@ -93,15 +93,14 @@ customize-create-theme (switch-to-buffer (get-buffer-create (or buffer "*Custom Theme*"))) (let ((inhibit-read-only t)) (erase-buffer) - (dolist (ov (overlays-in (point-min) (point-max))) - (delete-overlay ov))) + (delete-all-overlays)) (custom-new-theme-mode) (make-local-variable 'custom-theme-name) - (set (make-local-variable 'custom-theme--save-name) theme) - (set (make-local-variable 'custom-theme-faces) nil) - (set (make-local-variable 'custom-theme-variables) nil) - (set (make-local-variable 'custom-theme-description) "") - (set (make-local-variable 'custom-theme--migrate-settings) nil) + (setq-local custom-theme--save-name theme) + (setq-local custom-theme-faces nil) + (setq-local custom-theme-variables nil) + (setq-local custom-theme-description "") + (setq-local custom-theme--migrate-settings nil) (make-local-variable 'custom-theme-insert-face-marker) (make-local-variable 'custom-theme-insert-variable-marker) (make-local-variable 'custom-theme--listed-faces) @@ -513,8 +512,7 @@ describe-theme-1 (condition-case nil (read (current-buffer)) (end-of-file nil))))) - (and sexp (listp sexp) - (eq (car sexp) 'deftheme) + (and (eq (car-safe sexp) 'deftheme) (setq doc (nth 2 sexp))))))) (princ "\n\nDocumentation:\n") (princ (if (stringp doc) @@ -552,10 +550,10 @@ custom-theme-choose-mode Do not call this mode function yourself. It is meant for internal use." (use-local-map custom-theme-choose-mode-map) (custom--initialize-widget-variables) - (set (make-local-variable 'revert-buffer-function) - (lambda (_ignore-auto noconfirm) - (when (or noconfirm (y-or-n-p "Discard current choices? ")) - (customize-themes (current-buffer)))))) + (setq-local revert-buffer-function + (lambda (_ignore-auto noconfirm) + (when (or noconfirm (y-or-n-p "Discard current choices? ")) + (customize-themes (current-buffer)))))) (put 'custom-theme-choose-mode 'mode-class 'special) ;;;###autoload @@ -568,7 +566,7 @@ customize-themes (let ((inhibit-read-only t)) (erase-buffer)) (custom-theme-choose-mode) - (set (make-local-variable 'custom--listed-themes) nil) + (setq-local custom--listed-themes nil) (make-local-variable 'custom-theme-allow-multiple-selections) (and (null custom-theme-allow-multiple-selections) (> (length custom-enabled-themes) 1) @@ -662,8 +660,7 @@ custom-theme-summary (condition-case nil (read (current-buffer)) (end-of-file nil))))) - (and sexp (listp sexp) - (eq (car sexp) 'deftheme) + (and (eq (car-safe sexp) 'deftheme) (setq doc (nth 2 sexp)))))))) (cond ((null doc) "(no documentation available)") -- 2.18.0 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0008-Tweak-subr-x.el-substring-functions.patch >From 93f87046bddff2023550b4a9977a46cea86050e6 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Fri, 1 Jun 2018 21:58:10 +0100 Subject: [PATCH 8/8] Tweak subr-x.el substring functions * lisp/emacs-lisp/subr-x.el (string-join): #'-quote function symbol. (string-trim-left, string-trim-right): Make better use of substring for minor speedup. * test/lisp/emacs-lisp/subr-x-tests.el (subr-x-test-string-trim-left, subr-x-test-string-trim-right) (subr-x-test-string-remove-prefix) (subr-x-test-string-remove-suffix): New tests. --- lisp/emacs-lisp/subr-x.el | 12 +++---- test/lisp/emacs-lisp/subr-x-tests.el | 47 ++++++++++++++++++++++++++++ 2 files changed, 53 insertions(+), 6 deletions(-) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index e03a81c892..20eb0d5d05 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -211,7 +211,7 @@ string-empty-p (defsubst string-join (strings &optional separator) "Join all STRINGS using SEPARATOR." - (mapconcat 'identity strings separator)) + (mapconcat #'identity strings separator)) (define-obsolete-function-alias 'string-reverse 'reverse "25.1") @@ -219,17 +219,17 @@ string-trim-left "Trim STRING of leading string matching REGEXP. REGEXP defaults to \"[ \\t\\n\\r]+\"." - (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+")"\\)") string) - (replace-match "" t t string) + (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string) + (substring string (match-end 0)) string)) (defsubst string-trim-right (string &optional regexp) "Trim STRING of trailing string matching REGEXP. REGEXP defaults to \"[ \\t\\n\\r]+\"." - (if (string-match (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") string) - (replace-match "" t t string) - string)) + (let ((i (string-match-p (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") + string))) + (if i (substring string 0 i) string))) (defsubst string-trim (string &optional trim-left trim-right) "Trim STRING of leading and trailing strings matching TRIM-LEFT and TRIM-RIGHT. diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index f7f0ef384f..81467bab2d 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -532,6 +532,53 @@ (format "abs sum is: %s")) "abs sum is: 15"))) + +;; Substring tests + +(ert-deftest subr-x-test-string-trim-left () + "Test `string-trim-left' behavior." + (should (equal (string-trim-left "") "")) + (should (equal (string-trim-left " \t\n\r") "")) + (should (equal (string-trim-left " \t\n\ra") "a")) + (should (equal (string-trim-left "a \t\n\r") "a \t\n\r")) + (should (equal (string-trim-left "" "") "")) + (should (equal (string-trim-left "a" "") "a")) + (should (equal (string-trim-left "aa" "a*") "")) + (should (equal (string-trim-left "ba" "a*") "ba")) + (should (equal (string-trim-left "aa" "a*?") "aa")) + (should (equal (string-trim-left "aa" "a+?") "a"))) + +(ert-deftest subr-x-test-string-trim-right () + "Test `string-trim-right' behavior." + (should (equal (string-trim-right "") "")) + (should (equal (string-trim-right " \t\n\r") "")) + (should (equal (string-trim-right " \t\n\ra") " \t\n\ra")) + (should (equal (string-trim-right "a \t\n\r") "a")) + (should (equal (string-trim-right "" "") "")) + (should (equal (string-trim-right "a" "") "a")) + (should (equal (string-trim-right "aa" "a*") "")) + (should (equal (string-trim-right "ab" "a*") "ab")) + (should (equal (string-trim-right "aa" "a*?") ""))) + +(ert-deftest subr-x-test-string-remove-prefix () + "Test `string-remove-prefix' behavior." + (should (equal (string-remove-prefix "" "") "")) + (should (equal (string-remove-prefix "" "a") "a")) + (should (equal (string-remove-prefix "a" "") "")) + (should (equal (string-remove-prefix "a" "b") "b")) + (should (equal (string-remove-prefix "a" "a") "")) + (should (equal (string-remove-prefix "a" "aa") "a")) + (should (equal (string-remove-prefix "a" "ab") "b"))) + +(ert-deftest subr-x-test-string-remove-suffix () + "Test `string-remove-suffix' behavior." + (should (equal (string-remove-suffix "" "") "")) + (should (equal (string-remove-suffix "" "a") "a")) + (should (equal (string-remove-suffix "a" "") "")) + (should (equal (string-remove-suffix "a" "b") "b")) + (should (equal (string-remove-suffix "a" "a") "")) + (should (equal (string-remove-suffix "a" "aa") "a")) + (should (equal (string-remove-suffix "a" "ba") "b"))) (provide 'subr-x-tests) ;;; subr-x-tests.el ends here -- 2.18.0 --=-=-= Content-Type: text/plain "Basil L. Contovounesios" writes: > Stefan Monnier writes: > >>> Fair enough, though it's looking like the simplest solution is to keep >>> the original (when (file-directory-p dir) ...) check and avoid cl-lib >>> altogether. >> >> Agreed, with a comment explaining that cl-lib macros can't be used at >> this point for bootstrap reasons. > > How's the attached (see [PATCH 3/8])? Too verbose? Anything holding this up on my end? I reattach the patches for convenience. Thanks, -- Basil --=-=-=--