From: "Basil L. Contovounesios" <contovob@tcd.ie>
To: Eli Zaretskii <eliz@gnu.org>
Cc: monnier@IRO.UMontreal.CA, emacs-devel@gnu.org
Subject: Re: Byte-compilation of custom themes
Date: Fri, 01 Jun 2018 21:48:21 +0100 [thread overview]
Message-ID: <874lim2pyi.fsf@tcd.ie> (raw)
In-Reply-To: 831sehnymt.fsf@gnu.org
[-- Attachment #1: Type: text/plain, Size: 3464 bytes --]
I realise this is low priority stuff, but I'm nonetheless sorry for
taking so long to respond.
Eli Zaretskii <eliz@gnu.org> writes:
>> From: "Basil L. Contovounesios" <contovob@tcd.ie>
>> Cc: <monnier@IRO.UMontreal.CA>, <emacs-devel@gnu.org>
>> Date: Fri, 11 May 2018 21:43:42 +0100
>>
>> > We should at least have a comment there that we are relying on
>> > custom-theme--load-path to do the test, and perhaps also an assertion.
>>
>> Do you mean a cl-assertion, or an emulation thereof?
>
> I meant cl-assert.
Unless I (being unfamiliar with the subtleties of the build and
bootstrap process) am missing something, I think it's too early to load
cl-lib here; at least 'make bootstrap' fails for me when I add
(eval-when-compile (require 'cl-lib)) to custom.el. Is there a way
around this? Is the (unless DIRP (signal 'file-missing ...)) spiel from
my last email a suitable alternative? Would doing that be overkill?
>> Either way, what is the benefit of barfing before directory-files does?
>
> That you can control the text of the error message, and make it more
> user-friendly. Also, an assertion clearly means we intended this not
> to happen, rather than that the code failed to handle some valid
> situation.
Understood. I've noticed, however, that many, if not most, uses of
cl-assert don't specify a custom error message. For future reference,
is this acceptable practice, or would we rather see consistent use of
more informative messages?
> Once again, the minimum I requested was a comment; it's up to you
> whether to use cl-assert. But see below.
>
>> Wouldn't a docstring for custom-theme--load-path and a comment in
>> custom-available-themes suffice for the reader (they do for me)?
>
> We've seen many situations where code guidelines are violated, for
> whatever reasons, so just documenting stuff is not enough. Moreover,
> custom-theme--load-path might some day change and invalidate our
> assumption. The way to prevent that from happening could be either
> having the assertion in the caller, or by adding a test to the test
> suite that makes sure the list returned by custom-theme--load-path
> never includes anything but existing directories.
A limitation (which does not apply in this case) of having the assertion
in the caller is that this doesn't necessarily cover future callers, and
even if it does, then there are multiple callers checking the same
thing. Either way, I think adding a regression test is a good idea.
>> (dolist (dir (custom-theme--load-path))
>> + ;; `custom-theme--load-path' promises DIR exists.
>
> "promises DIR exists and is a directory", I think.
Right, I was being lazy and imprecise by relying on the name DIR to
convey its being a directory.
>> (defun custom-theme--load-path ()
>> + "Expand `custom-theme-load-path' into list of directories.
>> +Only existing directories are included in the path returned."
>
> I'd find this text a bit of a riddle. How about this instead:
>
> "Expand `custom-theme-load-path' into list of directories.
> Members of `custom-theme-load-path' that either don't exist or are not
> directories are omitted from the expansion."
SGTM, thanks.
I reattach the eight patches, updated for the feedback above.
The third patch has been updated to include the aforementioned
custom-theme-load-path documentation and tests.
The eighth patch now touches two more subr-x.el functions and adds tests
for its changes.
Thanks,
--
Basil
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Improve-loading-of-byte-compiled-custom-themes.patch --]
[-- Type: text/x-diff, Size: 4290 bytes --]
From d4a711a775649c50e36e4bdc244c79f51ae7a7bc Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
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 b7539685a8..1fed5dce53 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1221,43 +1221,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.17.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Disable-no-byte-compile-in-built-in-themes.patch --]
[-- Type: text/x-diff, Size: 6291 bytes --]
From f625cbdc4dbbcfa59a5773f193e4048bbb024191 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
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.17.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Fix-custom-available-themes-file-expansion.patch --]
[-- Type: text/x-diff, Size: 6515 bytes --]
From 5368d8697d49ae8fb493031be22dee2dbe76624c Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
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 <https://www.gnu.org/licenses/>.
+
+;;; 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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-lisp-custom.el-Use-lexical-binding.patch --]
[-- Type: text/x-diff, Size: 7797 bytes --]
From bc839204dfa54de338f33f2814a144fd91ac20ef Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
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 157bb318e3..7ca71dd895 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)))))
-\f
-;;; 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))))))
@@ -941,7 +938,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.
@@ -989,8 +986,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
@@ -1086,26 +1083,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)))
@@ -1206,7 +1206,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)
@@ -1391,9 +1391,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."
@@ -1405,7 +1405,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)))
@@ -1471,7 +1471,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)
@@ -1512,7 +1512,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.17.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0005-lisp-cus-theme.el-Use-lexical-binding.patch --]
[-- Type: text/x-diff, Size: 5907 bytes --]
From d850fa0df54be25d31b69273722754c3f27e28e5 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
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.17.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0006-Minor-custom.el-simplifications.patch --]
[-- Type: text/x-diff, Size: 7892 bytes --]
From 531b5169240c4f7a39a3eabfec78154789d48fdc Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
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 7ca71dd895..076790b661 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))))))))
\f
(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)))
@@ -1284,11 +1275,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.
@@ -1336,8 +1325,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)
@@ -1377,18 +1366,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
@@ -1421,23 +1410,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.17.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #8: 0007-Minor-cus-theme.el-simplifications.patch --]
[-- Type: text/x-diff, Size: 3932 bytes --]
From b3d9b63c36f30d6e1feb44d14c608551ccc8665f Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
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.17.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #9: 0008-Tweak-subr-x.el-substring-functions.patch --]
[-- Type: text/x-diff, Size: 5051 bytes --]
From a25af43b28e8a54d5f390c8c13c94609d5cb97e5 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Thu, 3 May 2018 16:12:56 +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, string-remove-suffix):
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 | 14 ++++-----
test/lisp/emacs-lisp/subr-x-tests.el | 47 ++++++++++++++++++++++++++++
2 files changed, 54 insertions(+), 7 deletions(-)
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 7fab9083e8..e89b5503a0 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.
@@ -250,7 +250,7 @@ string-remove-prefix
(defsubst string-remove-suffix (suffix string)
"Remove SUFFIX from STRING if present."
(if (string-suffix-p suffix string)
- (substring string 0 (- (length string) (length suffix)))
+ (substring string 0 (- (length suffix)))
string))
(provide 'subr-x)
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")))
+\f
+;; 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.17.0
next prev parent reply other threads:[~2018-06-01 20:48 UTC|newest]
Thread overview: 33+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-01-20 21:01 Byte-compilation of custom themes Basil L. Contovounesios
2018-01-24 16:16 ` Stefan Monnier
2018-01-30 22:16 ` Basil L. Contovounesios
2018-01-31 2:26 ` Stefan Monnier
2018-02-01 0:45 ` Basil L. Contovounesios
2018-02-02 14:25 ` Stefan Monnier
2018-05-10 2:49 ` Basil L. Contovounesios
2018-05-10 2:54 ` Basil L. Contovounesios
2018-05-11 14:07 ` Eli Zaretskii
2018-05-11 14:02 ` Eli Zaretskii
2018-05-11 15:16 ` Basil L. Contovounesios
2018-05-11 16:03 ` Stefan Monnier
2018-05-11 20:03 ` Basil L. Contovounesios
2018-05-11 17:32 ` Eli Zaretskii
2018-05-11 20:43 ` Basil L. Contovounesios
2018-05-12 7:04 ` Eli Zaretskii
2018-06-01 20:48 ` Basil L. Contovounesios [this message]
2018-06-01 21:07 ` Basil L. Contovounesios
2018-06-02 11:24 ` Eli Zaretskii
2018-06-02 18:53 ` Basil L. Contovounesios
2018-06-02 19:32 ` Eli Zaretskii
2018-06-02 20:02 ` Basil L. Contovounesios
2018-06-03 3:52 ` Stefan Monnier
2018-06-03 11:21 ` Basil L. Contovounesios
2018-06-03 15:11 ` Eli Zaretskii
2018-06-03 16:08 ` Basil L. Contovounesios
2018-06-03 16:16 ` Eli Zaretskii
2018-06-03 17:48 ` Basil L. Contovounesios
2018-06-03 20:22 ` Stefan Monnier
2018-06-04 1:33 ` Basil L. Contovounesios
2018-07-03 7:57 ` Basil L. Contovounesios
2018-07-11 1:40 ` Stefan Monnier
2018-07-11 6:05 ` Basil L. Contovounesios
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=874lim2pyi.fsf@tcd.ie \
--to=contovob@tcd.ie \
--cc=eliz@gnu.org \
--cc=emacs-devel@gnu.org \
--cc=monnier@IRO.UMontreal.CA \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).