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: Sun, 03 Jun 2018 18:48:44 +0100 [thread overview]
Message-ID: <87sh63rcar.fsf@tcd.ie> (raw)
In-Reply-To: <83lgbvdev8.fsf@gnu.org> (Eli Zaretskii's message of "Sun, 3 Jun 2018 19:16:59 +0300")
[-- Attachment #1: Type: text/plain, Size: 2767 bytes --]
Eli Zaretskii <eliz@gnu.org> writes:
>> From: "Basil L. Contovounesios" <contovob@tcd.ie>
>> Cc: <monnier@iro.umontreal.ca>, <emacs-devel@gnu.org>
>> Date: Sun, 03 Jun 2018 17:08:22 +0100
>>
>> So, if we can't load cl-lib at the top-level of custom.el, and we don't
>> load cl-lib in custom-available-themes, then the featurep check says
>> "only call cl-assert if some other library has already loaded cl-lib for
>> us", which doesn't make sense to me. What is the benefit of
>> conditionally calling an assertion at runtime?
>
> In most sessions cl-lib is loaded pretty close to startup, so the
> problem doesn't exist in practice, IMO.
>
>> Why wouldn't we want the assertion to be exercised every time
>> custom-available-themes is called?
>
> Because it's complicated, and I don't see any reason to justify that
> complication?
>
> But this is not a string opinion, so we could just drop the issue and
> move on.
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.
Anyway, I have updated the relevant patch according to your suggestion
(the fboundp check is effectively equivalent to the featurep one, but
additionally silences the byte-compiler) and reattach the set of
patches; let me know if there are any outstanding issues with them.
>> Just to be clear, including any one of the following three top-level
>> forms in custom.el breaks 'make bootstrap', irrespective of the NOERROR
>> argument passed to require, and even when there is no subsequent mention
>> of cl-assert or any other cl-lib feature in custom.el:
>>
>> (require 'cl-lib)
>> (eval-when-compile (require 'cl-lib))
>> (when t (require 'cl-lib))
>>
>> In all three cases, 'make bootstrap' reports the following:
>>
>> Loading custom (source)...
>> Warning: Unknown defun property ‘gv-setter’ in cl-fifth
>> Warning: Unknown defun property ‘gv-setter’ in cl-sixth
>> Warning: Unknown defun property ‘gv-setter’ in cl-seventh
>> Warning: Unknown defun property ‘gv-setter’ in cl-eighth
>> Warning: Unknown defun property ‘gv-setter’ in cl-ninth
>> Warning: Unknown defun property ‘gv-setter’ in cl-tenth
>> Symbol’s function definition is void: gv-define-simple-setter
>> Makefile:745: recipe for target 'bootstrap-emacs' failed
>
> Any reason you require cl-lib and not cl-macs?
I was following the suggestion of (info "(cl) Usage"), which implies
that the internal organisation of cl-lib is a bit of an implementation
detail. I realise now that this suggestion is aimed more at external
packages, not Emacs core, though. Bootstrap fails either way.
Thanks for indulging me,
--
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 ca42eaa51a0e3b2316b9783eb77cab316530c231 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.1
[-- 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 6b509915240fabeeaa4a4aedbad87f146bd61f66 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.1
[-- 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: 6683 bytes --]
From fe9bb45861c8f87cb62f69fb46d81286292352ab 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 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 1fed5dce53..965c817e82 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1299,19 +1299,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))))
+ ;; Can't load `cl-lib' at top-level due to bootstrapping issues.
+ (when (fboundp 'cl-assert)
+ (cl-assert
+ (file-directory-p dir) t
+ "Non-existent directory in `custom-theme-load-path' expansion: %s"))
+ (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.1
[-- 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 f809fccdbd12aea44586b6b1c7b0102648c1351b 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 965c817e82..381636e4c2 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)
@@ -1395,9 +1395,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."
@@ -1409,7 +1409,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)))
@@ -1475,7 +1475,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)
@@ -1516,7 +1516,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.1
[-- 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 d9881e411f2e8d10908d15f25733be189b66721f 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.1
[-- 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 537cfe5702d86eebcfc4909ed93fced71d218bf8 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 381636e4c2..1233e44d05 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.
@@ -1340,8 +1329,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)
@@ -1381,18 +1370,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
@@ -1425,23 +1414,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.1
[-- 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 41e2217167b4186467d75aff7faaeceb34813a5f 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.1
[-- 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: 4709 bytes --]
From 460204efa19cadf5f7d89175125b24ab5fba0ccd Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
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 7fab9083e8..eb3ec85ecc 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")))
+\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.1
next prev parent reply other threads:[~2018-06-03 17: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
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 [this message]
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=87sh63rcar.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).