commit ea685170063b59855322ceffdeaaab4acaf8e388 (HEAD, refs/remotes/origin/master) Author: Jim Porter Date: Sun Oct 27 21:13:56 2024 -0700 Fix definitions of Eshell "xtra" functions * lisp/eshell/em-xtra.el (eshell-parse-command): Remove unnecessary autoload. (eshell/substitute): Pass the correct number of arguments to 'cl-substitute'. (eshell/count, eshell/union, eshell/mismatch, eshell/intersection) (eshell/set-difference, eshell/set-exclusive-or): Use named arguments for the required arguments (bug#73738). diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el index 0a032395fd3..263ec37a720 100644 --- a/lisp/eshell/em-xtra.el +++ b/lisp/eshell/em-xtra.el @@ -40,46 +40,37 @@ naturally accessible within Emacs." ;;; Functions: -(autoload 'eshell-parse-command "esh-cmd") - (defun eshell/expr (&rest args) "Implementation of expr, using the calc package." (calc-eval (eshell-flatten-and-stringify args))) -(defun eshell/substitute (&rest args) +(defun eshell/substitute (new old seq &rest args) "Easy front-end to `cl-substitute', for comparing lists of strings." - (apply #'cl-substitute (car args) (cadr args) :test #'equal - (cddr args))) + (apply #'cl-substitute new old seq :test #'equal args)) -(defun eshell/count (&rest args) +(defun eshell/count (item seq &rest args) "Easy front-end to `cl-count', for comparing lists of strings." - (apply #'cl-count (car args) (cadr args) :test #'equal - (cddr args))) + (apply #'cl-count item seq :test #'equal args)) -(defun eshell/mismatch (&rest args) +(defun eshell/mismatch (seq1 seq2 &rest args) "Easy front-end to `cl-mismatch', for comparing lists of strings." - (apply #'cl-mismatch (car args) (cadr args) :test #'equal - (cddr args))) + (apply #'cl-mismatch seq1 seq2 :test #'equal args)) -(defun eshell/union (&rest args) +(defun eshell/union (list1 list2 &rest args) "Easy front-end to `cl-union', for comparing lists of strings." - (apply #'cl-union (car args) (cadr args) :test #'equal - (cddr args))) + (apply #'cl-union list1 list2 :test #'equal args)) -(defun eshell/intersection (&rest args) +(defun eshell/intersection (list1 list2 &rest args) "Easy front-end to `cl-intersection', for comparing lists of strings." - (apply #'cl-intersection (car args) (cadr args) :test #'equal - (cddr args))) + (apply #'cl-intersection list1 list2 :test #'equal args)) -(defun eshell/set-difference (&rest args) +(defun eshell/set-difference (list1 list2 &rest args) "Easy front-end to `cl-set-difference', for comparing lists of strings." - (apply #'cl-set-difference (car args) (cadr args) :test #'equal - (cddr args))) + (apply #'cl-set-difference list1 list2 :test #'equal args)) -(defun eshell/set-exclusive-or (&rest args) +(defun eshell/set-exclusive-or (list1 list2 &rest args) "Easy front-end to `cl-set-exclusive-or', for comparing lists of strings." - (apply #'cl-set-exclusive-or (car args) (cadr args) :test #'equal - (cddr args))) + (apply #'cl-set-exclusive-or list1 list2 :test #'equal args)) (defalias 'eshell/ff #'find-name-dired) (defalias 'eshell/gf #'find-grep-dired) commit 29b30eb49f8bd8bad4f9e24dd56f32d62bf70121 Author: Dmitry Gutov Date: Mon Oct 28 05:53:16 2024 +0200 project-try-vc: Fix the "sometimes wrong cache" issue * lisp/progmodes/project.el (project-try-vc--search): Extract from 'project-try-vc'. (project-try-vc): Use it. (project-try-vc--search): Call itself recursively directly, to avoid creating invalid cache entry (bug#73801). diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 4a8afb80b25..000506f58cb 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -548,61 +548,64 @@ project backend implementation of `project-external-roots'.") See `project-vc-extra-root-markers' for the marker value format.") (defun project-try-vc (dir) - ;; FIXME: Learn to invalidate when the value of - ;; `project-vc-merge-submodules' or `project-vc-extra-root-markers' - ;; changes. + ;; FIXME: Learn to invalidate when the value changes: + ;; `project-vc-merge-submodules' or `project-vc-extra-root-markers'. (or (vc-file-getprop dir 'project-vc) - (let* ((backend-markers - (delete - nil - (mapcar - (lambda (b) (assoc-default b project-vc-backend-markers-alist)) - vc-handled-backends))) - (marker-re - (concat - "\\`" - (mapconcat - (lambda (m) (format "\\(%s\\)" (wildcard-to-regexp m))) - (append backend-markers - (project--value-in-dir 'project-vc-extra-root-markers dir)) - "\\|") - "\\'")) - (locate-dominating-stop-dir-regexp - (or vc-ignore-dir-regexp locate-dominating-stop-dir-regexp)) - last-matches - (root - (locate-dominating-file - dir - (lambda (d) - ;; Maybe limit count to 100 when we can drop Emacs < 28. - (setq last-matches - (condition-case nil - (directory-files d nil marker-re t) - (file-missing nil)))))) - (backend - (cl-find-if - (lambda (b) - (member (assoc-default b project-vc-backend-markers-alist) - last-matches)) - vc-handled-backends)) - project) - (when (and - (eq backend 'Git) - (project--vc-merge-submodules-p root) - (project--submodule-p root)) - (let* ((parent (file-name-directory (directory-file-name root)))) - (setq root (vc-call-backend 'Git 'root parent)))) - (when root - (when (not backend) - (let* ((project-vc-extra-root-markers nil) - ;; Avoid submodules scan. - (enable-dir-local-variables nil) - (parent (project-try-vc root))) - (and parent (setq backend (nth 1 parent))))) - (setq project (list 'vc backend root)) - ;; FIXME: Cache for a shorter time. - (vc-file-setprop dir 'project-vc project) - project)))) + ;; FIXME: Cache for a shorter time. + (let ((res (project-try-vc--search dir))) + (and res (vc-file-setprop dir 'project-vc res)) + res))) + +(defun project-try-vc--search (dir) + (let* ((backend-markers + (delete + nil + (mapcar + (lambda (b) (assoc-default b project-vc-backend-markers-alist)) + vc-handled-backends))) + (marker-re + (concat + "\\`" + (mapconcat + (lambda (m) (format "\\(%s\\)" (wildcard-to-regexp m))) + (append backend-markers + (project--value-in-dir 'project-vc-extra-root-markers dir)) + "\\|") + "\\'")) + (locate-dominating-stop-dir-regexp + (or vc-ignore-dir-regexp locate-dominating-stop-dir-regexp)) + last-matches + (root + (locate-dominating-file + dir + (lambda (d) + ;; Maybe limit count to 100 when we can drop Emacs < 28. + (setq last-matches + (condition-case nil + (directory-files d nil marker-re t) + (file-missing nil)))))) + (backend + (cl-find-if + (lambda (b) + (member (assoc-default b project-vc-backend-markers-alist) + last-matches)) + vc-handled-backends)) + project) + (when (and + (eq backend 'Git) + (project--vc-merge-submodules-p root) + (project--submodule-p root)) + (let* ((parent (file-name-directory (directory-file-name root)))) + (setq root (vc-call-backend 'Git 'root parent)))) + (when root + (when (not backend) + (let* ((project-vc-extra-root-markers nil) + ;; Avoid submodules scan. + (enable-dir-local-variables nil) + (parent (project-try-vc--search root))) + (and parent (setq backend (nth 1 parent))))) + (setq project (list 'vc backend root)) + project))) (defun project--submodule-p (root) ;; XXX: We only support Git submodules for now. commit ebf3fb9a2295520ef8ce1756086fd9bbd3d04e9e Author: Paul Eggert Date: Sun Oct 27 17:21:23 2024 -0700 Work around GDB bug 32313 when debugging Emacs internals Problem reported by Eli Zaretskii in: https://lists.gnu.org/r/emacs-devel/2024-10/msg00653.html * src/eval.c (backtrace_function_body): Rename from backtrace_function, and make it static. (GDB_FUNCPTR): New macro. (backtrace_function): New function pointer, for GDB only. diff --git a/src/eval.c b/src/eval.c index 874cf6d868c..3c4999d818c 100644 --- a/src/eval.c +++ b/src/eval.c @@ -51,7 +51,6 @@ Lisp_Object Vsignaling_function; /* These would ordinarily be static, but they need to be visible to GDB. */ bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE; Lisp_Object *backtrace_args (union specbinding *) EXTERNALLY_VISIBLE; -Lisp_Object backtrace_function (union specbinding *) EXTERNALLY_VISIBLE; union specbinding *backtrace_next (union specbinding *) EXTERNALLY_VISIBLE; union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE; @@ -108,12 +107,21 @@ specpdl_arg (union specbinding *pdl) return pdl->unwind.arg; } -Lisp_Object -backtrace_function (union specbinding *pdl) +static Lisp_Object +backtrace_function_body (union specbinding *pdl) { eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->bt.function; } +/* To work around GDB bug 32313 + + make backtrace_function a visible-to-GDB pointer instead of merely + being an externally visible function itself. Declare the pointer + first to pacify gcc -Wmissing-variable-declarations. */ +#define GDB_FUNCPTR(func, resulttype, params) \ + extern resulttype (*const func) params EXTERNALLY_VISIBLE; \ + resulttype (*const func) params = func##_body +GDB_FUNCPTR (backtrace_function, Lisp_Object, (union specbinding *)); static ptrdiff_t backtrace_nargs (union specbinding *pdl) commit 9e40d3f2a1c2b5388a4eab72dbe506a21816f69b Author: Protesilaos Stavrou Date: Sun Oct 27 18:04:31 2024 +0200 Update modus-themes to their version 4.6.0 * doc/misc/modus-themes.org (Differences between loading and enabling) (Option for which themes to toggle) (Option for which themes to rotate, DIY Palette override presets) (DIY Add padding to the mode line) (DIY Remap face with local value): Fix typos. (DIY Add support for solaire-mode): Fix some symbols. (Full support for packages or face groups) (Indirectly covered packages): Add newly supported packages. (DIY Add support for combobulate):, (DIY Add support for engrave-faces, DIY Add support for howm) (DIY Add support for meow-mode): Document how to style those packages. (Acknowledgements): Update names of people who have in one way or another contributed to the project. * etc/themes/modus-operandi-deuteranopia-theme.el: * etc/themes/modus-operandi-theme.el: * etc/themes/modus-operandi-tinted-theme.el: * etc/themes/modus-operandi-tritanopia-theme.el: * etc/themes/modus-vivendi-deuteranopia-theme.el: * etc/themes/modus-vivendi-theme.el: * etc/themes/modus-vivendi-tinted-theme.el: * etc/themes/modus-vivendi-tritanopia-theme.el: * etc/themes/modus-themes.el: Make refinements to supported faces, add support for more faces, and tweak palette entries. Release notes: . diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org index c02da3fbad1..76379d1a168 100644 --- a/doc/misc/modus-themes.org +++ b/doc/misc/modus-themes.org @@ -4,9 +4,9 @@ #+language: en #+options: ':t toc:nil author:t email:t num:t #+startup: content -#+macro: stable-version 4.5.0 -#+macro: release-date 2024-08-21 -#+macro: development-version 4.6.0-dev +#+macro: stable-version 4.6.0 +#+macro: release-date 2024-10-27 +#+macro: development-version 4.7.0-dev #+macro: file @@texinfo:@file{@@$1@@texinfo:}@@ #+macro: space @@texinfo:@: @@ #+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@ @@ -50,7 +50,7 @@ Current development target is {{{development-version}}}. :custom_id: h:b14c3fcb-13dd-4144-9d92-2c58b3ed16d3 :end: -Copyright (C) 2020-2023 Free Software Foundation, Inc. +Copyright (C) 2020-2024 Free Software Foundation, Inc. #+begin_quote Permission is granted to copy, distribute and/or modify this document @@ -486,7 +486,7 @@ The reason we recommend ~load-theme~ instead of the other option of ~enable-theme~ is that the former does a kind of "reset" on the face specs. It quite literally loads (or reloads) the theme. Whereas the ~enable-theme~ function simply puts an already loaded theme to the top -of the list of enabled items, re-using whatever state was last loaded. +of the list of enabled items, reusing whatever state was last loaded. As such, ~load-theme~ reads all customizations that may happen during any given Emacs session: even after the initial setup of a theme. @@ -707,10 +707,12 @@ Advanced users may also want to configure the exact attributes of the :PROPERTIES: :CUSTOM_ID: h:4fbfed66-5a89-447a-a07d-a03f6819c5bd :END: -#+vindex: modus-themes-to-toggle -Brief: Choose to Modus themes to toggle between +#+findex: modus-themes-toggle +Brief: Specify which two themes to toggle between when using the command +~modus-themes-toggle~. +#+vindex: modus-themes-to-toggle Symbol: ~modus-themes-to-toggle~ (=list= type) Default value: ='(modus-operandi modus-vivendi)= @@ -718,16 +720,38 @@ Default value: ='(modus-operandi modus-vivendi)= Possible values: - ~modus-operandi~ -- ~modus-vivendi~ - ~modus-operandi-tinted~ -- ~modus-vivendi-tinted~ - ~modus-operandi-deuteranopia~ -- ~modus-vivendi-deuteranopia~ - ~modus-operandi-tritanopia~ +- ~modus-vivendi~ +- ~modus-vivendi-tinted~ +- ~modus-vivendi-deuteranopia~ - ~modus-vivendi-tritanopia~ -Specify two themes to toggle between using the command -~modus-themes-toggle~. +** Option for which themes to rotate +:PROPERTIES: +:CUSTOM_ID: h:a10c0202-3683-4fad-9897-433c25e255f6 +:END: + +#+findex: modus-themes-rotate +Brief: Specify which themes to rotate among when using the command +~modus-themes-rotate~. + +#+vindex: modus-themes-to-rotate +Symbol: ~modus-themes-to-rotate~ (=list= type) + +Default value: =modus-themes-items= (which includes all the Modus themes) + +Possible values: + +- ~modus-operandi~ +- ~modus-operandi-tinted~ +- ~modus-operandi-deuteranopia~ +- ~modus-operandi-tritanopia~ +- ~modus-vivendi~ +- ~modus-vivendi-tinted~ +- ~modus-vivendi-deuteranopia~ +- ~modus-vivendi-tritanopia~ ** Option for font mixing :properties: @@ -1517,6 +1541,101 @@ the general idea (extra space for didactic purposes): ,@modus-themes-preset-overrides-intense)) #+end_src +** DIY Add support for ~engrave-faces~ +:PROPERTIES: +:CUSTOM_ID: h:6c3f87a8-3573-43de-89e0-53f567c0ede1 +:END: + +The ~engraved-faces~ package is used as part of an Org export process +to produce decent colors in the output. Its default style though +requires changes to use the colors of the active Modus theme. + +In the code below we show how to map everything that ~engrave-faces~ +defines to the corresponding entry in the palette of the active Modus +theme. We then use a hook to ensure that the value is updated after we +switch to another theme in the collection ([[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][DIY Use a hook at the post-load-theme phase]]). + +#+begin_src emacs-lisp +(defun my-modus-themes-engraved-faces (&rest _) + (modus-themes-with-colors + (setq engrave-faces-themes + `((default . + (;; faces.el --- excluding: bold, italic, bold-italic, underline, and some others + (default :short "default" :slug "D" :foreground ,fg-main :background ,bg-main :family "Monospace") + (variable-pitch :short "var-pitch" :slug "vp" :foreground ,fg-main :family "Sans Serif") + (shadow :short "shadow" :slug "h" :foreground ,fg-dim) + (success :short "success" :slug "sc" :foreground ,green :weight bold) + (warning :short "warning" :slug "w" :foreground ,warning :weight bold) + (error :short "error" :slug "e" :foreground ,err :weight bold) + (link :short "link" :slug "l" :foreground ,fg-link) + (link-visited :short "link" :slug "lv" :foreground ,fg-link-visited) + (highlight :short "link" :slug "hi" :foreground ,info) + ;; font-lock.el + (font-lock-comment-face :short "fl-comment" :slug "c" :foreground ,comment) + (font-lock-comment-delimiter-face :short "fl-comment-delim" :slug "cd" :foreground ,comment) + (font-lock-string-face :short "fl-string" :slug "s" :foreground ,string) + (font-lock-doc-face :short "fl-doc" :slug "d" :foreground ,docstring) + (font-lock-doc-markup-face :short "fl-doc-markup" :slug "m" :foreground ,docmarkup) + (font-lock-keyword-face :short "fl-keyword" :slug "k" :foreground ,keyword) + (font-lock-builtin-face :short "fl-builtin" :slug "b" :foreground ,builtin) + (font-lock-function-name-face :short "fl-function" :slug "f" :foreground ,fnname) + (font-lock-variable-name-face :short "fl-variable" :slug "v" :foreground ,variable) + (font-lock-type-face :short "fl-type" :slug "t" :foreground ,type) + (font-lock-constant-face :short "fl-constant" :slug "o" :foreground ,constant) + (font-lock-warning-face :short "fl-warning" :slug "wr" :foreground ,warning :weight bold) + (font-lock-negation-char-face :short "fl-neg-char" :slug "nc") + (font-lock-preprocessor-face :short "fl-preprocessor" :slug "pp" :foreground ,preprocessor) + (font-lock-regexp-grouping-construct :short "fl-regexp" :slug "rc" :weight bold) + (font-lock-regexp-grouping-backslash :short "fl-regexp-backslash" :slug "rb" :weight bold) + ;; org-faces.el + (org-block :short "org-block" :slug "ob") ; forcing no background is preferable + (org-block-begin-line :short "org-block-begin" :slug "obb") ; forcing no background is preferable + (org-block-end-line :short "org-block-end" :slug "obe") ; forcing no background is preferable + ;; outlines + (outline-1 :short "outline-1" :slug "Oa" :foreground ,fg-heading-1) + (outline-2 :short "outline-2" :slug "Ob" :foreground ,fg-heading-2) + (outline-3 :short "outline-3" :slug "Oc" :foreground ,fg-heading-3) + (outline-4 :short "outline-4" :slug "Od" :foreground ,fg-heading-4) + (outline-5 :short "outline-5" :slug "Oe" :foreground ,fg-heading-5) + (outline-6 :short "outline-6" :slug "Of" :foreground ,fg-heading-6) + (outline-7 :short "outline-7" :slug "Og" :foreground ,fg-heading-7) + (outline-8 :short "outline-8" :slug "Oh" :foreground ,fg-heading-8) + ;; highlight-numbers.el + (highlight-numbers-number :short "hl-number" :slug "hn" :foreground ,number) + ;; highlight-quoted.el + (highlight-quoted-quote :short "hl-qquote" :slug "hq" :foreground ,string) + (highlight-quoted-symbol :short "hl-qsymbol" :slug "hs" :foreground ,constant) + ;; rainbow-delimiters.el + (rainbow-delimiters-depth-1-face :short "rd-1" :slug "rda" :foreground ,rainbow-0) + (rainbow-delimiters-depth-2-face :short "rd-2" :slug "rdb" :foreground ,rainbow-1) + (rainbow-delimiters-depth-3-face :short "rd-3" :slug "rdc" :foreground ,rainbow-2) + (rainbow-delimiters-depth-4-face :short "rd-4" :slug "rdd" :foreground ,rainbow-3) + (rainbow-delimiters-depth-5-face :short "rd-5" :slug "rde" :foreground ,rainbow-4) + (rainbow-delimiters-depth-6-face :short "rd-6" :slug "rdf" :foreground ,rainbow-5) + (rainbow-delimiters-depth-7-face :short "rd-7" :slug "rdg" :foreground ,rainbow-6) + (rainbow-delimiters-depth-8-face :short "rd-8" :slug "rdh" :foreground ,rainbow-7) + (rainbow-delimiters-depth-9-face :short "rd-9" :slug "rdi" :foreground ,rainbow-8) + ;; ansi-color + (ansi-color-yellow :short "ansi-yellow" :slug "any" :foreground ,fg-term-yellow) + (ansi-color-red :short "ansi-red" :slug "anr" :foreground ,fg-term-red) + (ansi-color-black :short "ansi-black" :slug "anb" :foreground ,fg-term-black) + (ansi-color-green :short "ansi-green" :slug "ang" :foreground ,fg-term-green) + (ansi-color-blue :short "ansi-blue" :slug "anB" :foreground ,fg-term-blue) + (ansi-color-cyan :short "ansi-cyan" :slug "anc" :foreground ,fg-term-cyan) + (ansi-color-white :short "ansi-white" :slug "anw" :foreground ,fg-term-white) + (ansi-color-magenta :short "ansi-magenta" :slug "anm" :foreground ,fg-term-magenta) + (ansi-color-bright-yellow :short "ansi-bright-yellow" :slug "ANy" :foreground ,fg-term-yellow-bright) + (ansi-color-bright-red :short "ansi-bright-red" :slug "ANr" :foreground ,fg-term-red-bright) + (ansi-color-bright-black :short "ansi-bright-black" :slug "ANb" :foregroun ,fg-term-black-bright) + (ansi-color-bright-green :short "ansi-bright-green" :slug "ANg" :foreground ,fg-term-green-bright) + (ansi-color-bright-blue :short "ansi-bright-blue" :slug "ANB" :foreground ,fg-term-blue-bright) + (ansi-color-bright-cyan :short "ansi-bright-cyan" :slug "ANc" :foreground ,fg-term-cyan-bright) + (ansi-color-bright-white :short "ansi-bright-white" :slug "ANw" :foregroun ,fg-term-white-bright) + (ansi-color-bright-magenta :short "ansi-bright-magenta" :slug "ANm" :foregroun ,fg-term-magenta-bright))))))) + +(add-hook 'enable-theme-functions #'my-modus-themes-engraved-faces) +#+end_src + ** DIY Stylistic variants using palette overrides :PROPERTIES: :CUSTOM_ID: h:df1199d8-eaba-47db-805d-6b568a577bf3 @@ -2892,7 +3011,7 @@ above: The reason we no longer provide this option is because it depends on a non-~nil~ value for ~x-underline-at-descent-line~. That variable affects ALL underlines, including those of links. The effect is -intrusive and looks awkard in prose. +intrusive and looks awkward in prose. As such, the Modus themes no longer provide that option but instead offer this piece of documentation to make the user fully aware of the @@ -2907,7 +3026,7 @@ Reload the theme for changes to take effect. #+cindex: Remapping faces There are cases where we need to change the buffer-local attributes of a -face. This might be because we have our own minor mode that re-uses a +face. This might be because we have our own minor mode that reuses a face for a particular purpose, such as a line selection tool that activates ~hl-line-mode~, but we wish to keep it distinct from other buffers. This is where ~face-remap-add-relative~ can be applied and may @@ -3837,7 +3956,7 @@ on what we cover at length elsewhere in this manual: (modus-themes-with-colors (custom-set-faces `(solaire-default-face ((,c :inherit default :background ,bg-dim :foreground ,fg-dim))) - `(solaire-line-number-face ((,c :inherit solaire-default-face :foreground ,fg-unfocused))) + `(solaire-line-number-face ((,c :inherit solaire-default-face :foreground ,fg-dim))) `(solaire-hl-line-face ((,c :background ,bg-active))) `(solaire-org-hide-face ((,c :background ,bg-dim :foreground ,bg-dim)))))) @@ -3848,6 +3967,127 @@ on what we cover at length elsewhere in this manual: Reload the theme for changes to take effect. +** DIY Add support for meow-mode +:PROPERTIES: +:CUSTOM_ID: h:caa5a5c4-18fb-4b9f-91f9-883f216fce41 +:END: + +The ~meow~ package provides a modal editing experience. It is meant to +build on top of the key bindings the user is already familiar with. My +problem as an outsider is that I cannot make sense of all the contexts +where its faces are used in, so I cannot make a good choice of which +styles to use. The following is but a basic attempt to get started. + +#+begin_src emacs-lisp +;; This is not complete, because it is difficult for a non-user to +;; make sense of where all the faces are used in. +(defun my-modus-themes-custom-faces (&rest _) + (modus-themes-with-colors + (custom-set-faces + ;; FIXME: What is a "region cursor" and should it differ from the position highlights below? + `(meow-region-cursor-1 ((,c :inherit (bold modus-themes-reset-soft) :background ,bg-char-0))) + `(meow-region-cursor-2 ((,c :inherit (bold modus-themes-reset-soft) :background ,bg-char-1))) + `(meow-region-cursor-3 ((,c :inherit (bold modus-themes-reset-soft) :background ,bg-char-2))) + + `(meow-position-highlight-number-1 ((,c :inherit (bold modus-themes-reset-soft) :background ,bg-char-0))) + `(meow-position-highlight-number-2 ((,c :inherit (bold modus-themes-reset-soft) :background ,bg-char-1))) + `(meow-position-highlight-number-3 ((,c :inherit (bold modus-themes-reset-soft) :background ,bg-char-2)))))) + +(add-hook 'enable-theme-functions #'my-modus-themes-custom-faces) +#+end_src + +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + +** DIY Add support for combobulate +:PROPERTIES: +:CUSTOM_ID: h:e94bdd17-1c2d-41b5-86c5-83462bd8f30c +:END: + +The ~combobulate~ package provides the means to operate on text that +is underpinned by the ~tree-sitter~ program. Because this is a +specialized case that requires intimate knowledge of the +technicalities, I am not adding support for this package directly at +the theme level. Users can try this instead: + +#+begin_src emacs-lisp +(defun my-modus-themes-custom-faces (&rest _) + (modus-themes-with-colors + (custom-set-faces + `(combobulate-active-indicator-face ((,c :foreground ,fg-main))) + `(combobulate-dimmed-indicator-face ((,c :inherit shadow))) + `(combobulate-error-indicator-face ((,c :inherit error))) + `(combobulate-query-highlight-fiery-flames-face ((,c :inherit modus-themes-intense-red))) + `(combobulate-query-highlight-gleaming-gold-face ((,c :inherit modus-themes-intense-yellow))) + `(combobulate-query-highlight-majestic-mercury-face ((,c :inherit modus-themes-intense-cyan))) + `(combobulate-query-highlight-mysterious-mauve-face ((,c :inherit modus-themes-intense-magenta))) + `(combobulate-query-highlight-radiant-rind-face ((,c :inherit modus-themes-subtle-red))) + `(combobulate-query-highlight-regal-ripples-face ((,c :inherit modus-themes-intense-blue))) + `(combobulate-query-highlight-serene-shade-face ((,c :inherit modus-themes-subtle-green))) + `(combobulate-query-highlight-silver-shadows-face ((,c :background ,bg-active :foreground ,fg-main))) + `(combobulate-query-highlight-vibrant-veggie-face ((,c :inherit modus-themes-intense-green))) + `(combobulate-query-query-anonymous-face ((,c :inherit modus-themes-bold :foreground ,fg-alt))) + `(combobulate-query-query-builtin-face ((,c :inherit font-lock-builtin-face))) + `(combobulate-query-query-constant-face ((,c :inherit font-lock-constant-face))) + `(combobulate-query-query-doc-markup-face ((,c :inherit font-lock-doc-markup-face))) + `(combobulate-query-query-keyword-face ((,c :inherit font-lock-keyword-face))) + `(combobulate-query-query-predicate-builtin-face ((,c :inherit bold))) + `(combobulate-query-query-string-face ((,c :inherit font-lock-string-face))) + `(combobulate-refactor-choice-face ((,c :inherit modus-themes-slant :foreground ,info))) + `(combobulate-refactor-cursor-face ((,c :foreground ,cursor))) + `(combobulate-refactor-field-face ((,c :background ,bg-inactive :foreground ,fg-main :extend nil))) + `(combobulate-refactor-highlight-face ((,c :inherit highlight))) + `(combobulate-refactor-inactive-choice-face ((,c :inherit modus-themes-slant :foreground ,fg-dim))) + `(combobulate-refactor-inactive-field-face ((,c :background ,bg-dim :foreground ,fg-dim :extend nil))) + `(combobulate-refactor-label-face ((,c :inherit modus-themes-search-replace))) + `(combobulate-tree-branch-face ((,c :inherit shadow))) + `(combobulate-tree-highlighted-node-face ((,c :inherit success))) + `(combobulate-tree-normal-node-face ((,c :foreground ,fg-main))) + `(combobulate-tree-pulse-node-face ((,c :background ,bg-blue-intense :extend t)))))) + +(add-hook 'enable-theme-functions #'my-modus-themes-custom-faces) +#+end_src + +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + +** DIY Add support for howm +:PROPERTIES: +:CUSTOM_ID: h:7ea8fa66-1cd8-47b0-92b4-9998a3068f85 +:END: + +The ~howm~ package is a note-taking solution for Emacs. Users can add +support for its faces with something like the following. + +#+begin_src emacs-lisp +(defun my-modus-themes-custom-faces (&rest _) + (modus-themes-with-colors + (custom-set-faces + `(action-lock-face ((,c :inherit button))) + `(howm-mode-keyword-face (( ))) + `(howm-mode-ref-face ((,c :inherit link))) + `(howm-mode-title-face ((,c :inherit modus-themes-heading-0))) + `(howm-mode-wiki-face ((,c :inherit link))) + `(howm-reminder-deadline-face ((,c :foreground ,date-deadline))) + `(howm-reminder-late-deadline-face ((,c :inherit bold :foreground ,date-deadline))) + `(howm-reminder-defer-face ((,c :foreground ,date-scheduled))) + `(howm-reminder-scheduled-face ((,c :foreground ,date-scheduled))) + `(howm-reminder-done-face ((,c :foreground ,prose-done))) + `(howm-reminder-todo-face ((,c :foreground ,prose-todo))) + `(howm-reminder-normal-face ((,c :foreground ,date-common))) + `(howm-reminder-today-face ((,c :inherit bold :foreground ,date-common))) + `(howm-reminder-tomorrow-face ((,c :inherit bold :foreground ,date-scheduled))) + `(howm-simulate-todo-mode-line-face ((,c :inherit bold))) + `(howm-view-empty-face (( ))) + `(howm-view-hilit-face ((,c :inherit match))) + `(howm-view-name-face ((,c :inherit bold))) + `(iigrep-counts-face1 ((,c :foreground ,rainbow-1))) + `(iigrep-counts-face2 ((,c :foreground ,rainbow-2))) + `(iigrep-counts-face3 ((,c :foreground ,rainbow-3))) + `(iigrep-counts-face4 ((,c :foreground ,rainbow-4))) + `(iigrep-counts-face5 ((,c :foreground ,rainbow-5)))))) + +(add-hook 'enable-theme-functions #'my-modus-themes-custom-faces) +#+end_src + ** DIY Use a hook at the post-load-theme phase :PROPERTIES: :CUSTOM_ID: h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24 @@ -4057,6 +4297,7 @@ have lots of extensions, so the "full support" may not be 100% true… + focus + fold-this + font-lock (generic syntax highlighting) ++ forge + geiser + git-commit + git-gutter (and variants) @@ -4066,6 +4307,7 @@ have lots of extensions, so the "full support" may not be 100% true… + gotest + golden-ratio-scroll-screen + helpful ++ hexl-mode + highlight-numbers + highlight-parentheses ([[#h:24bab397-dcb2-421d-aa6e-ec5bd622b913][Note on highlight-parentheses.el]]) + highlight-thing @@ -4264,7 +4506,6 @@ supported by the themes. + flyspell-correct + fortran-mode + freeze-it -+ forge + git-walktree + goggles + highlight-defined @@ -4534,7 +4775,7 @@ advanced customization options of the themes. [[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]. In the following example, we are assuming that the user wants to (i) -re-use color variables provided by the themes, (ii) be able to retain +reuse color variables provided by the themes, (ii) be able to retain their tweaks while switching between ~modus-operandi~ and ~modus-vivendi~, and (iii) have the option to highlight either the foreground of the parentheses or the background as well. @@ -4554,7 +4795,7 @@ Then we can update our preference with this: (setq my-highlight-parentheses-use-background nil) #+end_src -To re-use colors from the themes, we must wrap our code in the +To reuse colors from the themes, we must wrap our code in the ~modus-themes-with-colors~ macro. Our implementation must interface with the variables ~highlight-parentheses-background-colors~ and/or ~highlight-parentheses-colors~. @@ -5220,7 +5461,7 @@ each of the three channels of light (red, green, blue). For example: : xrandr --output LVDS1 --brightness 1.0 --gamma 0.76:0.75:0.68 Typography is another variable. Some font families are blurry at small -point sizes. Others may have a regular weight that is lighter (thiner) +point sizes. Others may have a regular weight that is lighter (thinner) than that of their peers which may, under certain circumstances, cause a halo effect around each glyph. @@ -5516,19 +5757,19 @@ The Modus themes are a collective effort. Every bit of work matters. Euker, Feng Shu, Filippo Argiolas, Gautier Ponsinet, Gerry Agbobada, Gianluca Recchia, Gonçalo Marrafa, Guilherme Semente, Gustavo Barros, Hörmetjan Yiltiz, Ilja Kocken, Imran Khan, Iris Garcia, Ivan - Popovych, James Ferguson, Jeremy Friesen, Jerry Zhang, Johannes - Grødem, John Haman, John Wick, Jonas Collberg, Jorge Morais, Joshua - O'Connor, Julio C. Villasante, Kenta Usami, Kevin Fleming, Kévin Le - Gouguec, Kevin Kainan Li, Kostadin Ninev, Laith Bahodi, Lasse - Lindner, Len Trigg, Lennart C.{{{space()}}} Karssen, Luis Miguel - Castañeda, Magne Hov, Manuel Giraud, Manuel Uberti, Mark Bestley, - Mark Burton, Mark Simpson, Marko Kocic, Markus Beppler, Matt - Armstrong, Matthias Fuchs, Mattias Engdegård, Mauro Aranda, Maxime - Tréca, Michael Goldenberg, Morgan Smith, Morgan Willcock, Murilo - Pereira, Nicky van Foreest, Nicolas De Jaeghere, Nicolas Semrau, - Olaf Meeuwissen, Oliver Epper, Pablo Stafforini, Paul Poloskov, - Pengji Zhang, Pete Kazmier, Peter Wu, Philip Kaludercic, Pierre - Téchoueyres, Przemysław Kryger, Robert Hepple, Roman Rudakov, + Popovych, Jabir Ali Ouassou, James Ferguson, Jeremy Friesen, Jerry + Zhang, Johannes Grødem, John Haman, John Wick, Jonas Collberg, Jorge + Morais, Joshua O'Connor, Julio C. Villasante, Kenta Usami, Kevin + Fleming, Kévin Le Gouguec, Kevin Kainan Li, Kostadin Ninev, Laith + Bahodi, Lasse Lindner, Len Trigg, Lennart C.{{{space()}}} Karssen, + Luis Miguel Castañeda, Magne Hov, Manuel Giraud, Manuel Uberti, Mark + Bestley, Mark Burton, Mark Simpson, Marko Kocic, Markus Beppler, + Matt Armstrong, Matthias Fuchs, Mattias Engdegård, Mauro Aranda, + Maxime Tréca, Michael Goldenberg, Morgan Smith, Morgan Willcock, + Murilo Pereira, Nicky van Foreest, Nicolas De Jaeghere, Nicolas + Semrau, Olaf Meeuwissen, Oliver Epper, Pablo Stafforini, Paul + Poloskov, Pengji Zhang, Pete Kazmier, Peter Wu, Philip Kaludercic, + Pierre Téchoueyres, Przemysław Kryger, Robert Hepple, Roman Rudakov, Russell Sim, Ryan Phillips, Rytis Paškauskas, Rudolf Adamkovič, Sam Kleinman, Samuel Culpepper, Saša Janiška, Shreyas Ragavan, Simon Pugnet, Steve Downey, Tassilo Horn, Thanos Apollo, Thibaut Verron, diff --git a/etc/themes/modus-operandi-deuteranopia-theme.el b/etc/themes/modus-operandi-deuteranopia-theme.el index 485a71e19b5..58b27b90a18 100644 --- a/etc/themes/modus-operandi-deuteranopia-theme.el +++ b/etc/themes/modus-operandi-deuteranopia-theme.el @@ -304,14 +304,16 @@ standard)." (date-common cyan) (date-deadline yellow-warmer) + (date-deadline-subtle red-faint) (date-event fg-alt) (date-holiday yellow-warmer) (date-holiday-other blue) (date-now fg-main) (date-range fg-alt) (date-scheduled yellow-cooler) + (date-scheduled-subtle yellow-faint) (date-weekday cyan) - (date-weekend yellow-faint) + (date-weekend magenta) ;;;; Line number mappings diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el index 6fd2ddd57de..bd6d4b4c50b 100644 --- a/etc/themes/modus-operandi-theme.el +++ b/etc/themes/modus-operandi-theme.el @@ -301,15 +301,17 @@ which corresponds to a minimum contrast in relative luminance of ;;;; Date mappings (date-common cyan) - (date-deadline red) + (date-deadline red-cooler) + (date-deadline-subtle red-faint) (date-event fg-alt) - (date-holiday red-cooler) + (date-holiday red) (date-holiday-other blue) (date-now fg-main) (date-range fg-alt) - (date-scheduled yellow-warmer) + (date-scheduled yellow) + (date-scheduled-subtle yellow-faint) (date-weekday cyan) - (date-weekend red-faint) + (date-weekend magenta) ;;;; Line number mappings diff --git a/etc/themes/modus-operandi-tinted-theme.el b/etc/themes/modus-operandi-tinted-theme.el index c901e834d15..a9be4374f80 100644 --- a/etc/themes/modus-operandi-tinted-theme.el +++ b/etc/themes/modus-operandi-tinted-theme.el @@ -301,15 +301,17 @@ which corresponds to a minimum contrast in relative luminance of ;;;; Date mappings (date-common cyan) - (date-deadline red) + (date-deadline red-cooler) + (date-deadline-subtle red-faint) (date-event fg-alt) - (date-holiday red-cooler) + (date-holiday red) (date-holiday-other blue) (date-now fg-main) (date-range fg-alt) - (date-scheduled yellow-warmer) + (date-scheduled yellow) + (date-scheduled-subtle yellow-faint) (date-weekday cyan) - (date-weekend red-faint) + (date-weekend magenta) ;;;; Line number mappings diff --git a/etc/themes/modus-operandi-tritanopia-theme.el b/etc/themes/modus-operandi-tritanopia-theme.el index ae62198c4ed..c7460ba9054 100644 --- a/etc/themes/modus-operandi-tritanopia-theme.el +++ b/etc/themes/modus-operandi-tritanopia-theme.el @@ -304,14 +304,16 @@ standard)." (date-common cyan-cooler) (date-deadline red) + (date-deadline-subtle red-faint) (date-event fg-alt) (date-holiday red) (date-holiday-other cyan) (date-now fg-main) (date-range fg-alt) (date-scheduled magenta) + (date-scheduled-subtle magenta-faint) (date-weekday cyan) - (date-weekend red-faint) + (date-weekend magenta-warmer) ;;;; Line number mappings diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el index 7950a3da39d..c2ffc6e3593 100644 --- a/etc/themes/modus-themes.el +++ b/etc/themes/modus-themes.el @@ -5,7 +5,7 @@ ;; Author: Protesilaos Stavrou ;; Maintainer: Protesilaos Stavrou ;; URL: https://github.com/protesilaos/modus-themes -;; Version: 4.5.0 +;; Version: 4.6.0 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility @@ -287,10 +287,14 @@ set this variable to a nil value." "Alias of `modus-themes-items'.") (defconst modus-themes-items - '( modus-operandi modus-vivendi - modus-operandi-tinted modus-vivendi-tinted - modus-operandi-deuteranopia modus-vivendi-deuteranopia - modus-operandi-tritanopia modus-vivendi-tritanopia) + '( modus-operandi + modus-operandi-tinted + modus-operandi-deuteranopia + modus-operandi-tritanopia + modus-vivendi + modus-vivendi-tinted + modus-vivendi-deuteranopia + modus-vivendi-tritanopia) "Symbols of the Modus themes.") (defcustom modus-themes-to-toggle '(modus-operandi modus-vivendi) @@ -308,18 +312,19 @@ the same as using the command `modus-themes-select'." :type `(choice (const :tag "No toggle" nil) (list :tag "Pick two themes to toggle between" - (choice :tag "Theme one of two" - ,@(mapcar (lambda (theme) - (list 'const theme)) - modus-themes-items)) - (choice :tag "Theme two of two" - ,@(mapcar (lambda (theme) - (list 'const theme)) - modus-themes-items)))) + (choice :tag "Theme one of two" ,@(mapcar (lambda (theme) (list 'const theme)) modus-themes-items)) + (choice :tag "Theme two of two" ,@(mapcar (lambda (theme) (list 'const theme)) modus-themes-items)))) :package-version '(modus-themes . "4.0.0") :version "30.1" - :set #'modus-themes--set-option - :initialize #'custom-initialize-default + :group 'modus-themes) + +(defcustom modus-themes-to-rotate modus-themes-items + "List of Modus themes to rotate among, per `modus-themes-rotate'." + :type `(repeat + (choice :tag "A theme among the `modus-themes-items'" + ,@(mapcar (lambda (theme) (list 'const theme)) modus-themes-items))) + :package-version '(modus-themes . "4.6.0") + :version "31.1" :group 'modus-themes) (defvaralias 'modus-themes-post-load-hook 'modus-themes-after-load-theme-hook) @@ -330,8 +335,6 @@ This is used by the command `modus-themes-toggle'." :type 'hook :package-version '(modus-themes . "4.0.0") :version "30.1" - :set #'modus-themes--set-option - :initialize #'custom-initialize-default :group 'modus-themes) (defvaralias 'modus-themes-slanted-constructs 'modus-themes-italic-constructs) @@ -1106,7 +1109,7 @@ With optional SUFFIX, return THEME-palette-SUFFIX as a symbol." "Return palette value of active Modus theme, else produce `user-error'. With optional OVERRIDES return palette value plus whatever overrides." - (if-let ((theme (modus-themes--current-theme))) + (if-let* ((theme (modus-themes--current-theme))) (if overrides (modus-themes--palette-value theme :overrides) (modus-themes--palette-value theme)) @@ -1182,13 +1185,15 @@ symbol, which is safe when used as a face attribute's value." ;;;; Commands +;;;;; Select a theme with completion + (defvar modus-themes--select-theme-history nil "Minibuffer history of `modus-themes--select-prompt'.") (defun modus-themes--annotate-theme (theme) "Return completion annotation for THEME." - (when-let ((symbol (intern-soft theme)) - (doc-string (get symbol 'theme-documentation))) + (when-let* ((symbol (intern-soft theme)) + (doc-string (get symbol 'theme-documentation))) (format " -- %s" (propertize (car (split-string doc-string "\\.")) 'face 'completions-annotations)))) @@ -1222,6 +1227,8 @@ Disable other themes per `modus-themes-disable-other-themes'." (interactive (list (modus-themes--select-prompt))) (modus-themes-load-theme theme)) +;;;;; Toggle between two themes + (defun modus-themes--toggle-theme-p () "Return non-nil if `modus-themes-to-toggle' are valid." (mapc @@ -1241,6 +1248,7 @@ practically the same as the `modus-themes-select' command). Run `modus-themes-after-load-theme-hook' after loading the theme. Disable other themes per `modus-themes-disable-other-themes'." + (declare (interactive-only t)) (interactive) (if-let* ((themes (modus-themes--toggle-theme-p)) (one (car themes)) @@ -1248,6 +1256,44 @@ Disable other themes per `modus-themes-disable-other-themes'." (modus-themes-load-theme (if (eq (car custom-enabled-themes) one) two one)) (modus-themes-load-theme (modus-themes--select-prompt)))) +;;;;; Rotate through a list of themes + +(defun modus-themes--rotate (themes) + "Rotate THEMES rightward such that the car is moved to the end." + (if (proper-list-p themes) + (let* ((index (seq-position themes (modus-themes--current-theme))) + (offset (1+ index))) + (append (nthcdr offset themes) (take offset themes))) + (error "The `%s' is not a list" themes))) + +(defun modus-themes--rotate-p (themes) + "Return a new theme among THEMES if it is possible to rotate to it." + (if-let* ((new-theme (car (modus-themes--rotate themes)))) + (if (eq new-theme (modus-themes--current-theme)) + (car (modus-themes--rotate-p (modus-themes--rotate themes))) + new-theme) + (error "Cannot determine a theme among `%s'" themes))) + +;;;###autoload +(defun modus-themes-rotate (themes) + "Rotate to the next theme among THEMES. +When called interactively THEMES is the value of `modus-themes-to-rotate'. + +If the current theme is already the next in line, then move to the one +after. Perform the rotation rightwards, such that the first element in +the list becomes the last. Do not modify THEMES in the process." + (interactive (list modus-themes-to-rotate)) + (unless (proper-list-p themes) + "This is not a list of themes: `%s'" themes) + (let ((candidate (modus-themes--rotate-p themes))) + (if (modus-themes--modus-p candidate) + (progn + (message "Rotating to `%s'" (propertize (symbol-name candidate) 'face 'success)) + (modus-themes-load-theme candidate)) + (user-error "`%s' is not part of the Modus collection" candidate)))) + +;;;;; Preview a theme palette + (defun modus-themes--list-colors-render (buffer theme &optional mappings &rest _) "Render colors in BUFFER from THEME for `modus-themes-list-colors'. Optional MAPPINGS changes the output to only list the semantic @@ -1741,12 +1787,12 @@ FG and BG are the main colors." `(all-the-icons-silver ((,c :foreground "gray50"))) `(all-the-icons-yellow ((,c :foreground ,yellow))) ;;;;; all-the-icons-dired - `(all-the-icons-dired-dir-face ((,c :foreground ,cyan-faint))) + `(all-the-icons-dired-dir-face ((,c :foreground ,accent-0))) ;;;;; all-the-icons-ibuffer - `(all-the-icons-ibuffer-dir-face ((,c :foreground ,cyan-faint))) - `(all-the-icons-ibuffer-file-face ((,c :foreground ,blue-faint))) - `(all-the-icons-ibuffer-mode-face ((,c :foreground ,cyan))) - `(all-the-icons-ibuffer-size-face ((,c :foreground ,cyan-cooler))) + `(all-the-icons-ibuffer-dir-face ((,c :foreground ,accent-0))) + `(all-the-icons-ibuffer-file-face ((,c :foreground ,docstring))) + `(all-the-icons-ibuffer-mode-face ((,c :foreground ,type))) + `(all-the-icons-ibuffer-size-face ((,c :foreground ,variable))) ;;;;; annotate `(annotate-annotation ((,c :inherit modus-themes-subtle-blue))) `(annotate-annotation-secondary ((,c :inherit modus-themes-subtle-magenta))) @@ -1942,7 +1988,7 @@ FG and BG are the main colors." `(company-scrollbar-bg ((,c :background ,bg-active))) `(company-scrollbar-fg ((,c :background ,fg-main))) `(company-template-field ((,c :background ,bg-active))) - `(company-tooltip ((,c :background ,bg-dim))) + `(company-tooltip ((,c :inherit modus-themes-fixed-pitch :background ,bg-dim))) `(company-tooltip-annotation ((,c :inherit completions-annotations))) `(company-tooltip-common ((,c :inherit company-echo-common))) `(company-tooltip-deprecated ((,c :inherit company-tooltip :strike-through t))) @@ -1978,7 +2024,7 @@ FG and BG are the main colors." `(corfu-current ((,c :inherit modus-themes-completion-selected))) `(corfu-bar ((,c :background ,fg-dim))) `(corfu-border ((,c :background ,bg-active))) - `(corfu-default ((,c :background ,bg-dim))) + `(corfu-default ((,c :inherit modus-themes-fixed-pitch :background ,bg-dim))) ;;;;; corfu-candidate-overlay `(corfu-candidate-overlay-face ((t :inherit shadow))) ;;;;; corfu-quick @@ -2269,8 +2315,10 @@ FG and BG are the main colors." `(elpher-gemini-heading2 ((,c :inherit modus-themes-heading-2))) `(elpher-gemini-heading3 ((,c :inherit modus-themes-heading-3))) ;;;;; embark + `(embark-collect-group-title ((,c :inherit bold :foreground ,name))) `(embark-keybinding ((,c :inherit modus-themes-key-binding))) - `(embark-collect-marked ((,c :inherit modus-themes-mark-sel))) + `(embark-keybinding-repeat ((,c :inherit bold))) + `(embark-selected ((,c :inherit modus-themes-mark-sel))) ;;;;; ement (ement.el) `(ement-room-fully-read-marker ((,c :inherit success))) `(ement-room-membership ((,c :inherit shadow))) @@ -2439,6 +2487,23 @@ FG and BG are the main colors." `(font-lock-type-face ((,c :inherit modus-themes-bold :foreground ,type))) `(font-lock-variable-name-face ((,c :foreground ,variable))) `(font-lock-warning-face ((,c :inherit modus-themes-bold :foreground ,warning))) +;;;;; forge + `(forge-dimmed ((,c :inherit shadow))) + `(forge-issue-completed ((,c :inherit shadow))) + `(forge-issue-open (( ))) + `(forge-issue-unplanned ((,c :inherit forge-dimmed :strike-through t))) + `(forge-post-author ((,c :inherit bold :foreground ,name))) + `(forge-post-date ((,c :inherit bold :foreground ,date-common))) + `(forge-pullreq-merged ((,c :foreground ,fg-alt))) + `(forge-pullreq-open ((,c :foreground ,info))) + `(forge-pullreq-rejected ((,c :foreground ,err :strike-through t))) + `(forge-topic-done (( ))) + `(forge-topic-pending ((,c :inherit italic))) + `(forge-topic-slug-completed ((,c :inherit forge-dimmed))) + `(forge-topic-slug-open ((,c :inherit forge-dimmed))) + `(forge-topic-slug-saved ((,c :inherit success))) + `(forge-topic-slug-unplanned ((,c :inherit forge-dimmed :strike-through t))) + `(forge-topic-unread ((,c :inherit bold))) ;;;;; geiser `(geiser-font-lock-autodoc-current-arg ((,c :inherit bold :background ,bg-active-argument :foreground ,fg-active-argument))) `(geiser-font-lock-autodoc-identifier ((,c :foreground ,docstring))) @@ -2562,6 +2627,9 @@ FG and BG are the main colors." `(golden-ratio-scroll-highlight-line-face ((,c :background ,bg-cyan-subtle :foreground ,fg-main))) ;;;;; helpful `(helpful-heading ((,c :inherit modus-themes-heading-1))) +;;;;; hexl-mode + `(hexl-address-region ((,c :foreground ,constant))) + `(hexl-ascii-region ((,c :foreground ,variable))) ;;;;; highlight region or ad-hoc regexp ;; HACK 2022-06-23: The :inverse-video prevents hl-line-mode from ;; overriding the background. Such an override really defeats the @@ -2620,6 +2688,11 @@ FG and BG are the main colors." `(hydra-face-pink ((,c :inherit bold :foreground ,magenta))) `(hydra-face-red ((,c :inherit bold :foreground ,red-faint))) `(hydra-face-teal ((,c :inherit bold :foreground ,cyan-cooler))) +;;;;; hyperbole + `(hbut-item-face ((,c :foreground ,info))) + `(hbut-face ((,c :inherit modus-themes-button))) + `(hbut-flash ((,c :background ,bg-search-replace))) + `(ibut-face ((,c :inherit button :background ,bg-link-symbolic :foreground ,fg-link-symbolic :underline ,underline-link-symbolic))) ;;;;; icomplete `(icomplete-first-match ((,c :inherit modus-themes-completion-match-0))) `(icomplete-selected-match ((,c :inherit modus-themes-completion-selected))) @@ -3128,14 +3201,14 @@ FG and BG are the main colors." `(nerd-icons-silver ((,c :foreground "gray50"))) `(nerd-icons-yellow ((,c :foreground ,yellow))) ;;;;; nerd-icons-completion - `(nerd-icons-completion-dir-face ((,c :foreground ,cyan-faint))) + `(nerd-icons-completion-dir-face ((,c :foreground ,accent-0))) ;;;;; nerd-icons-dired - `(nerd-icons-dired-dir-face ((,c :foreground ,cyan-faint))) + `(nerd-icons-dired-dir-face ((,c :foreground ,accent-0))) ;;;;; nerd-icons-ibuffer - `(nerd-icons-ibuffer-dir-face ((,c :foreground ,cyan-faint))) - `(nerd-icons-ibuffer-file-face ((,c :foreground ,blue-faint))) - `(nerd-icons-ibuffer-mode-face ((,c :foreground ,cyan))) - `(nerd-icons-ibuffer-size-face ((,c :foreground ,cyan-cooler))) + `(nerd-icons-ibuffer-dir-face ((,c :foreground ,accent-0))) + `(nerd-icons-ibuffer-file-face ((,c :foreground ,docstring))) + `(nerd-icons-ibuffer-mode-face ((,c :foreground ,type))) + `(nerd-icons-ibuffer-size-face ((,c :foreground ,variable))) ;;;;; neotree `(neo-banner-face ((,c :foreground ,accent-0))) `(neo-button-face ((,c :inherit button))) @@ -3273,7 +3346,7 @@ FG and BG are the main colors." `(org-headline-todo ((,c :inherit org-todo))) `(org-hide ((,c :foreground ,bg-main))) `(org-indent ((,c :inherit (fixed-pitch org-hide)))) - `(org-imminent-deadline ((,c :inherit modus-themes-bold :foreground ,date-deadline))) + `(org-imminent-deadline ((,c :inherit bold :foreground ,date-deadline))) `(org-latex-and-related ((,c :foreground ,type))) `(org-level-1 ((,c :inherit modus-themes-heading-1))) `(org-level-2 ((,c :inherit modus-themes-heading-2))) @@ -3292,9 +3365,9 @@ FG and BG are the main colors." `(org-priority ((,c :foreground ,prose-tag))) `(org-property-value ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-metadata-value))) `(org-quote ((,c :inherit org-block))) - `(org-scheduled ((,c :foreground ,date-scheduled))) - `(org-scheduled-previously ((,c :inherit org-scheduled))) - `(org-scheduled-today ((,c :inherit (modus-themes-bold org-scheduled)))) + `(org-scheduled ((,c :foreground ,date-scheduled-subtle))) + `(org-scheduled-previously ((,c :inherit (bold org-scheduled-today)))) + `(org-scheduled-today ((,c :foreground ,date-scheduled))) `(org-sexp-date ((,c :foreground ,date-common))) `(org-special-keyword ((,c :inherit org-drawer))) `(org-table ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-table))) @@ -3304,8 +3377,8 @@ FG and BG are the main colors." `(org-target ((,c :underline t))) `(org-time-grid ((,c :foreground ,fg-dim))) `(org-todo ((,c :foreground ,prose-todo))) - `(org-upcoming-deadline ((,c :foreground ,date-deadline))) - `(org-upcoming-distant-deadline ((,c :inherit org-upcoming-deadline))) + `(org-upcoming-deadline ((,c :foreground ,date-deadline-subtle))) + `(org-upcoming-distant-deadline ((,c :foreground ,fg-main))) `(org-verbatim ((,c :inherit modus-themes-prose-verbatim))) `(org-verse ((,c :inherit org-block))) `(org-warning ((,c :inherit warning))) diff --git a/etc/themes/modus-vivendi-deuteranopia-theme.el b/etc/themes/modus-vivendi-deuteranopia-theme.el index 815e2403e13..23b31186d15 100644 --- a/etc/themes/modus-vivendi-deuteranopia-theme.el +++ b/etc/themes/modus-vivendi-deuteranopia-theme.el @@ -72,7 +72,7 @@ standard)." (red "#ff5f59") (red-warmer "#ff6b55") - (red-cooler "#ff7f9f") + (red-cooler "#ff7f86") (red-faint "#ff9580") (red-intense "#ff5f5f") (green "#44bc44") @@ -304,14 +304,16 @@ standard)." (date-common cyan) (date-deadline yellow-warmer) + (date-deadline-subtle red-faint) (date-event fg-alt) (date-holiday yellow-warmer) (date-holiday-other blue) (date-now fg-main) (date-range fg-alt) (date-scheduled yellow-cooler) + (date-scheduled-subtle yellow-faint) (date-weekday cyan) - (date-weekend yellow-faint) + (date-weekend magenta) ;;;; Line number mappings diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el index 8f56d0ca78e..216bb2a7201 100644 --- a/etc/themes/modus-vivendi-theme.el +++ b/etc/themes/modus-vivendi-theme.el @@ -70,7 +70,7 @@ which corresponds to a minimum contrast in relative luminance of (red "#ff5f59") (red-warmer "#ff6b55") - (red-cooler "#ff7f9f") + (red-cooler "#ff7f86") (red-faint "#ff9580") (red-intense "#ff5f5f") (green "#44bc44") @@ -301,15 +301,17 @@ which corresponds to a minimum contrast in relative luminance of ;;;; Date mappings (date-common cyan) - (date-deadline red) + (date-deadline red-cooler) + (date-deadline-subtle red-faint) (date-event fg-alt) - (date-holiday red-cooler) + (date-holiday magenta-warmer) (date-holiday-other blue) (date-now fg-main) (date-range fg-alt) - (date-scheduled yellow-warmer) + (date-scheduled yellow-cooler) + (date-scheduled-subtle yellow-faint) (date-weekday cyan) - (date-weekend red-faint) + (date-weekend magenta) ;;;; Line number mappings diff --git a/etc/themes/modus-vivendi-tinted-theme.el b/etc/themes/modus-vivendi-tinted-theme.el index 55c1cd7d2d1..2bbec8aa844 100644 --- a/etc/themes/modus-vivendi-tinted-theme.el +++ b/etc/themes/modus-vivendi-tinted-theme.el @@ -70,7 +70,7 @@ which corresponds to a minimum contrast in relative luminance of (red "#ff5f59") (red-warmer "#ff6b55") - (red-cooler "#ff7f9f") + (red-cooler "#ff7f86") (red-faint "#ff9f80") (red-intense "#ff5f5f") (green "#44bc44") @@ -301,15 +301,17 @@ which corresponds to a minimum contrast in relative luminance of ;;;; Date mappings (date-common cyan) - (date-deadline red) + (date-deadline red-cooler) + (date-deadline-subtle red-faint) (date-event fg-alt) - (date-holiday red-cooler) + (date-holiday magenta-warmer) (date-holiday-other blue) (date-now fg-main) (date-range fg-alt) - (date-scheduled yellow-warmer) + (date-scheduled yellow-cooler) + (date-scheduled-subtle yellow-faint) (date-weekday cyan) - (date-weekend red-faint) + (date-weekend magenta) ;;;; Line number mappings diff --git a/etc/themes/modus-vivendi-tritanopia-theme.el b/etc/themes/modus-vivendi-tritanopia-theme.el index f1bd65e97bc..d18a44b38db 100644 --- a/etc/themes/modus-vivendi-tritanopia-theme.el +++ b/etc/themes/modus-vivendi-tritanopia-theme.el @@ -72,7 +72,7 @@ standard)." (red "#ff5f59") (red-warmer "#ff6740") - (red-cooler "#ff6f9f") + (red-cooler "#ff7f86") (red-faint "#ff9070") (red-intense "#ff5f5f") (green "#44bc44") @@ -304,14 +304,16 @@ standard)." (date-common cyan-cooler) (date-deadline red) + (date-deadline-subtle red-faint) (date-event fg-alt) (date-holiday red-intense) (date-holiday-other cyan-warmer) (date-now fg-main) (date-range fg-alt) (date-scheduled magenta) + (date-scheduled-subtle magenta-faint) (date-weekday cyan) - (date-weekend red-faint) + (date-weekend magenta-warmer) ;;;; Line number mappings commit aeaeccbe3219c655b091fa3867c87b02b6289a1b Merge: c5b410d6120 c78b4d2b31d Author: Eli Zaretskii Date: Sun Oct 27 08:23:06 2024 -0400 Merge from origin/emacs-30 c78b4d2b31d Fix doc string of 'wdired-use-dired-vertical-movement' b0aaee93fde Update the documentation of void functions 299a1f24075 ; * lisp/vc/log-edit.el (log-edit-diff-function): Grammar... 67a27ff53bf ; Fix typos commit c5b410d6120b62f14664cb06715689b6a0505ca5 Merge: e4e3def201c bd2b0644386 Author: Eli Zaretskii Date: Sun Oct 27 08:23:06 2024 -0400 ; Merge from origin/emacs-30 The following commits were skipped: bd2b0644386 Backport some docstring updates, warn about upcoming obso... 3f94b979d80 ; Remove proced-tests.el instrumentation (Do not merge wi... commit e4e3def201c1fc52785efe032c67ec383a2af93a Merge: 20120bdfa42 dd52839dd9d Author: Eli Zaretskii Date: Sun Oct 27 08:23:06 2024 -0400 Merge from origin/emacs-30 dd52839dd9d * lisp/editorconfig.el (editorconfig--get-indentation): F... commit 20120bdfa420abaa1c7fb9a134c1970f047aa3f8 Merge: e4f490c8719 ed1d691184d Author: Eli Zaretskii Date: Sun Oct 27 08:23:05 2024 -0400 ; Merge from origin/emacs-30 The following commits were skipped: ed1d691184d Update 'ldefs-boot.el' (don't merge) bbc8a5830af Bump Emacs version to 30.0.92 commit e4f490c8719bf3afda90f7968ccfb7f318a2e827 Merge: 4704dd39de0 e0f964c16df Author: Eli Zaretskii Date: Sun Oct 27 08:23:05 2024 -0400 Merge from origin/emacs-30 e0f964c16df ; * etc/AUTHORS: Update. eb18f7288b3 ; * ChangeLog.4: Update. 8e37b537160 Skip *.dylib files in 'loaddefs-generate' 0d8d5f10ffc Highlight namespace name in "use" clause. d3e98487d08 ; * lisp/loadup.el: Improve file abstract 1a91d37a21c ; * doc/lispref/control.texi (Conditionals): Fix markup. commit c78b4d2b31d9b763aa506d8498f70b3e651bbbf5 Author: Eli Zaretskii Date: Sun Oct 27 13:41:24 2024 +0200 Fix doc string of 'wdired-use-dired-vertical-movement' * lisp/wdired.el (wdired-use-dired-vertical-movement): Remove the incorrect reference to 'track-eol'. (Bug#73917) diff --git a/lisp/wdired.el b/lisp/wdired.el index 8ce115eb142..0a858864d2d 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -93,8 +93,7 @@ is not nil." That is, always move the point to the beginning of the filename at line. If `sometimes', only move to the beginning of filename if the point is -before it, and `track-eol' is non-nil. This behavior is very handy -when editing several filenames. +before it. This behavior is very handy when editing several filenames. If nil, \"up\" and \"down\" movement is done as in any other buffer." :type '(choice (const :tag "As in any other mode" nil) commit b0aaee93fde245b972a0d69b60328550f53bc043 Author: Eli Zaretskii Date: Sun Oct 27 13:16:36 2024 +0200 Update the documentation of void functions * doc/lispref/functions.texi (Function Cells): * src/data.c (Ffboundp, Ffmakunbound, Fsymbol_function): Update documentation to the changes of how void functions are represented since Emacs 24.5. (Bug#73886) diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 0131305525c..bfb8789d05b 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -1511,9 +1511,9 @@ indirect-function}. This returns the object in the function cell of @var{symbol}. It does not check that the returned object is a legitimate function. -If the function cell is void, the return value is @code{nil}. To -distinguish between a function cell that is void and one set to -@code{nil}, use @code{fboundp} (see below). +If the function cell is void, the return value is @code{nil}. It is +impossible to distinguish between a function cell that is void and one +set to @code{nil}. @example @group @@ -1538,24 +1538,24 @@ that that symbol's function cell is @dfn{void}. In other words, the function cell does not have any Lisp object in it. If you try to call the symbol as a function, Emacs signals a @code{void-function} error. - Note that void is not the same as @code{nil} or the symbol -@code{void}. The symbols @code{nil} and @code{void} are Lisp objects, -and can be stored into a function cell just as any other object can be -(and @code{void} can be a valid function if you define it with -@code{defun}). A void function cell contains no object whatsoever. + Unlike with void variables (@pxref{Void Variables}), a symbol's +function cell that contains @code{nil} is indistinguishable from the +function's being void. Note that void is not the same as the symbol +@code{void}: @code{void} can be a valid function if you define it with +@code{defun}. You can test the voidness of a symbol's function definition with @code{fboundp}. After you have given a symbol a function definition, you can make it void once more using @code{fmakunbound}. @defun fboundp symbol -This function returns @code{t} if the symbol has an object in its -function cell, @code{nil} otherwise. It does not check that the object -is a legitimate function. +This function returns @code{t} if the symbol has a non-@code{nil} object +in its function cell, @code{nil} otherwise. It does not check that the +object is a legitimate function. @end defun @defun fmakunbound symbol -This function makes @var{symbol}'s function cell void, so that a +This function makes @var{symbol}'s function cell @code{nil}, so that a subsequent attempt to access this cell will cause a @code{void-function} error. It returns @var{symbol}. (See also @code{makunbound}, in @ref{Void Variables}.) diff --git a/src/data.c b/src/data.c index 13b4593e005..bf83755bff3 100644 --- a/src/data.c +++ b/src/data.c @@ -756,7 +756,7 @@ global value outside of any lexical scope. */) breaking backward compatibility, as some users of fboundp may expect t in particular, rather than any true value. */ DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, - doc: /* Return t if SYMBOL's function definition is not void. */) + doc: /* Return t if SYMBOL's function definition is neither void nor nil. */) (Lisp_Object symbol) { CHECK_SYMBOL (symbol); @@ -782,12 +782,12 @@ See also `fmakunbound'. */) } DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, - doc: /* Make SYMBOL's function definition be void. + doc: /* Make SYMBOL's function definition be nil. Return SYMBOL. -If a function definition is void, trying to call a function by that -name will cause a `void-function' error. For more details, see Info -node `(elisp) Function Cells'. +If a function definition is nil or void, trying to call a function by +that name will cause a `void-function' error. For more details, see +Info node `(elisp) Function Cells'. See also `makunbound'. */) (register Lisp_Object symbol) @@ -800,7 +800,7 @@ See also `makunbound'. */) } DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0, - doc: /* Return SYMBOL's function definition, or nil if that is void. */) + doc: /* Return SYMBOL's function definition, or nil if that is void or nil. */) (Lisp_Object symbol) { CHECK_SYMBOL (symbol); commit 299a1f240750595d7b0132aec5eb3a2b58c9d943 Author: Sean Whitton Date: Sun Oct 27 18:56:31 2024 +0800 ; * lisp/vc/log-edit.el (log-edit-diff-function): Grammar fix. diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index d61a108b195..3c4eadb59a1 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -246,7 +246,7 @@ when this variable is set to nil.") (defvar log-edit-initial-files nil) (defvar log-edit-callback nil) (defvar log-edit-diff-function - (lambda () (error "Diff functionality has not been setup"))) + (lambda () (error "Diff functionality has not been set up"))) (defvar log-edit-listfun nil) (defvar log-edit-parent-buffer nil) commit 4704dd39de0427466ca3585ab284b7302b0ef2d7 Author: Sean Whitton Date: Sun Oct 27 18:45:31 2024 +0800 transient.el: Replace use of obsolete if-let and when-let * lisp/transient.el (transient--expand-define-args) (transient--parse-suffix, transient-get-suffix) (transient--make-transient-map, transient--init-suffix) (transient--init-suffix-key, transient--suspend-override) (transient--wrap-command, transient--call-pre-command) (transient--setup-recursion, transient--invalid) (transient-init-value, transient-default-value) (transient-infix-read, transient-prompt, transient--show) (transient--insert-group, transient-format-key) (transient-format-description, transient-format-value) (transient--maybe-pad-keys, transient-command-summary-or-name) (transient-show-help): Replace use of if-let and when-let, obsolete for Emacs 31.x. diff --git a/lisp/transient.el b/lisp/transient.el index 41515f6616e..0f53fee3c0e 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -1060,7 +1060,7 @@ commands are aliases for." (when (eq (car-safe (car args)) 'declare) (setq declare (car args)) (setq args (cdr args)) - (when-let ((int (assq 'interactive-only declare))) + (when-let* ((int (assq 'interactive-only declare))) (setq interactive-only (cadr int)) (delq int declare)) (unless (cdr declare) @@ -1184,7 +1184,7 @@ commands are aliases for." (setq args (plist-put args :argument (cadr arg))) (setq arg (cadr arg))) (string - (when-let ((shortarg (transient--derive-shortarg arg))) + (when-let* ((shortarg (transient--derive-shortarg arg))) (setq args (plist-put args :shortarg shortarg))) (setq args (plist-put args :argument arg)))) (setq sym (intern (format "transient:%s:%s" prefix arg))) @@ -1221,7 +1221,7 @@ commands are aliases for." (setq args (plist-put args key (macroexp-quote val)))) ((setq args (plist-put args key val))))))) (unless (plist-get args :key) - (when-let ((shortarg (plist-get args :shortarg))) + (when-let* ((shortarg (plist-get args :shortarg))) (setq args (plist-put args :key shortarg)))) (list 'list (or level transient--default-child-level) @@ -1371,7 +1371,7 @@ LOC is a command, a key vector, a key description (a string as returned by `key-description'), or a coordination list (whose last element may also be a command or key). See info node `(transient)Modifying Existing Transients'." - (if-let ((mem (transient--layout-member loc prefix))) + (if-let* ((mem (transient--layout-member loc prefix))) (car mem) (error "%s not found in %s" loc prefix))) @@ -1907,9 +1907,9 @@ of the corresponding object." (error "Cannot bind %S to %s and also %s" (string-trim key) cmd alt)) ((define-key map kbd cmd)))))) - (when-let ((b (keymap-lookup map "-"))) (keymap-set map "" b)) - (when-let ((b (keymap-lookup map "="))) (keymap-set map "" b)) - (when-let ((b (keymap-lookup map "+"))) (keymap-set map "" b)) + (when-let* ((b (keymap-lookup map "-"))) (keymap-set map "" b)) + (when-let* ((b (keymap-lookup map "="))) (keymap-set map "" b)) + (when-let* ((b (keymap-lookup map "+"))) (keymap-set map "" b)) (when transient-enable-popup-navigation ;; `transient--make-redisplay-map' maps only over bindings that are ;; directly in the base keymap, so that cannot be a composed keymap. @@ -2135,7 +2135,7 @@ value. Otherwise return CHILDREN as is." (apply class :level level args) (unless (and cmd (symbolp cmd)) (error "BUG: Non-symbolic suffix command: %s" cmd)) - (if-let ((proto (and cmd (transient--suffix-prototype cmd)))) + (if-let* ((proto (and cmd (transient--suffix-prototype cmd)))) (apply #'clone proto :level level args) (apply class :command cmd :level level args))))) (cond ((not cmd)) @@ -2166,7 +2166,7 @@ value. Otherwise return CHILDREN as is." (if (transient-switches--eieio-childp obj) (cl-call-next-method obj) (unless (slot-boundp obj 'shortarg) - (when-let ((shortarg (transient--derive-shortarg (oref obj argument)))) + (when-let* ((shortarg (transient--derive-shortarg (oref obj argument)))) (oset obj shortarg shortarg))) (unless (slot-boundp obj 'key) (if (slot-boundp obj 'shortarg) @@ -2367,7 +2367,7 @@ value. Otherwise return CHILDREN as is." ((and transient--prefix transient--redisplay-key) (setq transient--redisplay-key nil) (when transient--showp - (if-let ((win (minibuffer-selected-window))) + (if-let* ((win (minibuffer-selected-window))) (with-selected-window win (transient--show)) (transient--show))))) @@ -2439,7 +2439,7 @@ value. Otherwise return CHILDREN as is." (advice-eval-interactive-spec spec)) (setq abort nil)) (when abort - (when-let ((unwind (oref prefix unwind-suffix))) + (when-let* ((unwind (oref prefix unwind-suffix))) (transient--debug 'unwind-interactive) (funcall unwind suffix)) (advice-remove suffix advice) @@ -2447,7 +2447,7 @@ value. Otherwise return CHILDREN as is." (unwind-protect (let ((debugger #'transient--exit-and-debug)) (apply fn args)) - (when-let ((unwind (oref prefix unwind-suffix))) + (when-let* ((unwind (oref prefix unwind-suffix))) (transient--debug 'unwind-command) (funcall unwind suffix)) (advice-remove suffix advice) @@ -2622,7 +2622,7 @@ exit." ;;; Pre-Commands (defun transient--call-pre-command () - (if-let ((fn (transient--get-pre-command this-command))) + (if-let* ((fn (transient--get-pre-command this-command))) (let ((action (funcall fn))) (when (eq action transient--exit) (setq transient--exitp (or transient--exitp t))) @@ -2718,7 +2718,7 @@ If there is no parent prefix, then just call the command." (defun transient--setup-recursion (prefix-obj) (when transient--stack (let ((command (oref prefix-obj command))) - (when-let ((suffix-obj (transient-suffix-object command))) + (when-let* ((suffix-obj (transient-suffix-object command))) (when (memq (if (slot-boundp suffix-obj 'transient) (oref suffix-obj transient) (oref transient-current-prefix transient-suffix)) @@ -2827,8 +2827,8 @@ prefix argument and pivot to `transient-update'." ;; `this-command' is `transient-undefined' or `transient-inapt'. ;; Show the command (`this-original-command') the user actually ;; tried to invoke. - (if-let ((cmd (or (ignore-errors (symbol-name this-original-command)) - (ignore-errors (symbol-name this-command))))) + (if-let* ((cmd (or (ignore-errors (symbol-name this-original-command)) + (ignore-errors (symbol-name this-command))))) (format " [%s]" (propertize cmd 'face 'font-lock-warning-face)) "")) (unless (and transient--transient-map @@ -3125,7 +3125,7 @@ Otherwise call the primary method according to object's class." (if (slot-boundp obj 'value) (oref obj value) (oset obj value - (if-let ((saved (assq (oref obj command) transient-values))) + (if-let* ((saved (assq (oref obj command) transient-values))) (cdr saved) (transient-default-value obj))))) @@ -3161,8 +3161,8 @@ Otherwise call the primary method according to object's class." nil) (cl-defmethod transient-default-value ((obj transient-prefix)) - (if-let ((default (and (slot-boundp obj 'default-value) - (oref obj default-value)))) + (if-let* ((default (and (slot-boundp obj 'default-value) + (oref obj default-value)))) (if (functionp default) (funcall default) default) @@ -3267,7 +3267,7 @@ it\", in which case it is pointless to preserve history.)" The last value is \"don't use any of these switches\"." (let ((choices (mapcar (apply-partially #'format (oref obj argument-format)) (oref obj choices)))) - (if-let ((value (oref obj value))) + (if-let* ((value (oref obj value))) (cadr (member value choices)) (car choices)))) @@ -3275,7 +3275,7 @@ The last value is \"don't use any of these switches\"." "Elsewhere use the reader of the infix command COMMAND. Use this if you want to share an infix's history with a regular stand-alone command." - (if-let ((obj (transient--suffix-prototype command))) + (if-let* ((obj (transient--suffix-prototype command))) (cl-letf (((symbol-function #'transient--show) #'ignore)) (transient-infix-read obj)) (error "Not a suffix command: `%s'" command))) @@ -3351,7 +3351,7 @@ command-line option) or \": \". Finally fall through to using \"(BUG: no prompt): \" as the prompt." - (if-let ((prompt (oref obj prompt))) + (if-let* ((prompt (oref obj prompt))) (let ((prompt (if (functionp prompt) (funcall prompt obj) prompt))) @@ -3644,7 +3644,7 @@ have a history of their own.") (transient--insert-groups) (when (or transient--helpp transient--editp) (transient--insert-help)) - (when-let ((line (transient--separator-line))) + (when-let* ((line (transient--separator-line))) (insert line))) (unless (window-live-p transient--window) (setq transient--window @@ -3705,8 +3705,8 @@ have a history of their own.") (cl-defmethod transient--insert-group :around ((group transient-group)) "Insert GROUP's description, if any." - (when-let ((desc (transient-with-shadowed-buffer - (transient-format-description group)))) + (when-let* ((desc (transient-with-shadowed-buffer + (transient-format-description group)))) (insert desc ?\n)) (let ((transient--max-group-level (max (oref group level) transient--max-group-level)) @@ -3839,7 +3839,7 @@ as a button." "Format OBJ's `key' for display and return the result." (let ((key (if (slot-boundp obj 'key) (oref obj key) "")) (cmd (and (slot-boundp obj 'command) (oref obj command)))) - (when-let ((width (oref transient--pending-group pad-keys))) + (when-let* ((width (oref transient--pending-group pad-keys))) (setq key (truncate-string-to-width key width nil ?\s))) (if transient--redisplay-key (let ((len (length transient--redisplay-key)) @@ -3937,7 +3937,7 @@ apply the face `transient-unreachable' to the complete string." (funcall (oref transient--prefix suffix-description) obj))))) (if desc - (when-let ((face (transient--get-face obj 'face))) + (when-let* ((face (transient--get-face obj 'face))) (setq desc (transient--add-face desc face t))) (setq desc (propertize "(BUG: no description)" 'face 'error))) (when (if transient--all-levels-p @@ -3946,8 +3946,8 @@ apply the face `transient-unreachable' to the complete string." (> (max (oref obj level) transient--max-group-level) transient--default-prefix-level))) (setq desc (transient--add-face desc 'transient-higher-level))) - (when-let ((inapt-face (and (oref obj inapt) - (transient--get-face obj 'inapt-face)))) + (when-let* ((inapt-face (and (oref obj inapt) + (transient--get-face obj 'inapt-face)))) (setq desc (transient--add-face desc inapt-face))) (when (and (slot-boundp obj 'key) (transient--key-unreachable-p obj)) @@ -3965,7 +3965,7 @@ apply the face `transient-unreachable' to the complete string." (cl-defmethod transient-format-value ((obj transient-option)) (let ((argument (oref obj argument))) - (if-let ((value (oref obj value))) + (if-let* ((value (oref obj value))) (pcase-exhaustive (oref obj multi-value) ('nil (concat (propertize argument 'face 'transient-argument) @@ -4047,8 +4047,8 @@ apply the face `transient-unreachable' to the complete string." (and val (not (integerp val)) val))) (defun transient--maybe-pad-keys (group &optional parent) - (when-let ((pad (or (oref group pad-keys) - (and parent (oref parent pad-keys))))) + (when-let* ((pad (or (oref group pad-keys) + (and parent (oref parent pad-keys))))) (oset group pad-keys (apply #'max (if (integerp pad) pad 0) @@ -4098,7 +4098,7 @@ that, else its name. Intended to be temporarily used as the `:suffix-description' of a prefix command, while porting a regular keymap to a transient." (let ((command (oref obj command))) - (if-let ((doc (documentation command))) + (if-let* ((doc (documentation command))) (propertize (car (split-string doc "\n")) 'face 'font-lock-doc-face) (propertize (symbol-name command) 'face 'font-lock-function-name-face)))) @@ -4129,7 +4129,7 @@ prefix method." 'transient--prefix))) (and prefix (not (eq (oref transient--prefix command) this-command)) (prog1 t (transient-show-help prefix))))) - ((if-let ((show-help (oref obj show-help))) + ((if-let* ((show-help (oref obj show-help))) (funcall show-help obj) (transient--describe-function this-command))))) @@ -4137,11 +4137,11 @@ prefix method." "Call `show-help' if non-nil, else show the `man-page' if non-nil, else use `describe-function'. When showing the manpage, then try to jump to the correct location." - (if-let ((show-help (oref obj show-help))) + (if-let* ((show-help (oref obj show-help))) (funcall show-help obj) - (if-let ((man-page (oref transient--prefix man-page)) - (argument (and (slot-boundp obj 'argument) - (oref obj argument)))) + (if-let* ((man-page (oref transient--prefix man-page)) + (argument (and (slot-boundp obj 'argument) + (oref obj argument)))) (transient--show-manpage man-page argument) (transient--describe-function this-command)))) commit 734d5e2f294e13ef762bd3bfd644551f7f94e9fa Author: Eli Zaretskii Date: Sun Oct 27 12:28:12 2024 +0200 Allow escape from 'read-key' * lisp/emacs-lisp/backtrace.el (backtrace-mode-map): Add a binding for 'abort-recursive-edit'. (Bug#73584) diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index 84d9e20abe9..eddb006c500 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -201,6 +201,7 @@ frames where the source code location is known.") "+" #'backtrace-multi-line "-" #'backtrace-single-line "." #'backtrace-expand-ellipses + "C-]" #'abort-recursive-edit "" 'mouse-face "" #'mouse-select-window commit 4af5b794015a64f67d878d43ac6cde1bb39b3bd9 Author: Mats Lidell Date: Sun Oct 27 09:11:16 2024 +0100 Accept texi2any for version identification * lisp/info.el (Info-file-supports-index-cookies): Accept texi2any for version identification. (Bug#74042) diff --git a/lisp/info.el b/lisp/info.el index 1ad1677c6ce..9025fd13363 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -667,7 +667,7 @@ in `Info-file-supports-index-cookies-list'." (goto-char (point-min)) (condition-case () (if (and (re-search-forward - "makeinfo[ \n]version[ \n]\\([0-9]+.[0-9]+\\)" + "\\(?:makeinfo\\|texi2any\\)[ \n]version[ \n]\\([0-9]+.[0-9]+\\)" (line-beginning-position 4) t) (not (version< (match-string 1) "4.7"))) (setq found t)) commit 67a27ff53bf0f8473cb6b58ad85298e066b8def4 Author: Stefan Kangas Date: Sun Oct 27 07:49:32 2024 +0100 ; Fix typos diff --git a/ChangeLog.4 b/ChangeLog.4 index 282197eaeed..7cfdbd13184 100644 --- a/ChangeLog.4 +++ b/ChangeLog.4 @@ -219,7 +219,7 @@ Fix c-ts-mode indentation for initializer lists (bug#73661) - The intentation behavior differed between c-mode/c++-mode + The indentation behavior differed between c-mode/c++-mode and *-ts-mode for initializer lists where the first element was not at beginning-of-line. The anchor-prev-sibling function gave up and returned nil, but it should (probably) anchor on the @@ -547,7 +547,7 @@ Align columns in which-key with wide characters properly - In the case that a character takes up multple columns (such as + In the case that a character takes up multiple columns (such as `…' when used as a truncation character), make sure that the columns are still aligned properly. * lisp/which-key.el (which-key--pad-column): Use `string-width' @@ -1032,7 +1032,7 @@ * src/treesit.c (treesit_sync_visible_region): Minimally fix ranges so it doesn't exceed parser's visible range. - (treesit_call_after_change_functions): Update calling sigature to + (treesit_call_after_change_functions): Update calling signature to treesit_make_ranges. (treesit_ensure_parsed, make_treesit_parser): Use the new field within_reparse. diff --git a/admin/codespell/codespell.exclude b/admin/codespell/codespell.exclude index 1dc4fb8f014..f4c67ae83e8 100644 --- a/admin/codespell/codespell.exclude +++ b/admin/codespell/codespell.exclude @@ -1701,8 +1701,6 @@ Timo Savola, Jorgen Sch@"afer, Holger Schauer, William Schelter, Ralph 5b34fc07085 * lisp/treesit.el (treesit-node-at): Update docstring (bu... 5cf1de683b2 Fix python-fill-paragraph problems on filling strings (bu... 7678b7e46f2 Eglot: check server capability before sending didSave (bu... - 7678b7e46f2 Eglot: check server capability before sending didSave (bu... - 9ac12592781 Fix display of menu-bar bindings of commands in *Help* bu... 9ac12592781 Fix display of menu-bar bindings of commands in *Help* bu... 9e105d483fa Fix c-ts-mode indentation for statement after preproc (bu... When running emacs in a terminal (or at least, in iTerm), keys are not @@ -1736,7 +1734,6 @@ Timo Savola, Jorgen Sch@"afer, Holger Schauer, William Schelter, Ralph ed3bab3cc72 Revert 'forward-sentence-default-function' to return poin... b3e930d328e Revert inadvertent change to lisp/icomplete.el in previou... 973c1d24c6a ruby-ts-mode: Also don't reindent 'identifier' when insid... - 973c1d24c6a ruby-ts-mode: Also don't reindent 'identifier' when insid... e444115d026 Improve keymap-global-set and keymap-local-set interactiv... 8e9783b4ce4 Rebind in read-regexp-map ‘M-c’ to ‘M-s c’ compatible wit... f12f72b0e09 ; * lisp/simple.el (primitive-undo): Clarify error messag... @@ -1744,3 +1741,5 @@ Timo Savola, Jorgen Sch@"afer, Holger Schauer, William Schelter, Ralph b211a63455c Make tab-bar-tab-group-format-function also handle curren... a3c310c11a Create new "use-package" themse and use it for :custom wit... 2a85d81c47 Add support for gathering statistics on use-package declar... + (let* ((nam (buffer-substring (match-beginning 2) (match-end 2))) + (setq nmlst (cons nam nmlst) diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 6df853f2a00..3dd0688d426 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -1432,7 +1432,7 @@ If you need to contact the Free Software Foundation, see @display Free Software Foundation -31 Milk Street # 960789 +31 Milk Street, # 960789 Boston, MA 02196 USA @end display diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index 039588b311d..ec1e6727ff8 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -812,7 +812,7 @@ You do it using Emacs Lisp's built-in support for CLOS-style generic functions via the @code{cl-defgeneric} and @code{cl-defmethod} macros (@pxref{Generic Functions,,,elisp,GNU Emacs Lisp Reference Manual}). -EIEIO provides one extension to @code{cl-defmethod} to allow mathods to +EIEIO provides one extension to @code{cl-defmethod} to allow methods to dispatch on a class argument: so-called ``static'' methods do not depend on an object instance, but instead operate on a class. You can create a static method by using the @code{subclass} specializer with diff --git a/etc/themes/adwaita-theme.el b/etc/themes/adwaita-theme.el index cea8f85c081..1c3c3b26752 100644 --- a/etc/themes/adwaita-theme.el +++ b/etc/themes/adwaita-theme.el @@ -105,4 +105,4 @@ default look of the Gnome 3 desktop." `(diff-added ((,class (:bold t :foreground "#4E9A06")))) `(diff-removed ((,class (:bold t :foreground "#F5666D")))))) -;;; adwaita-theme.el ends here +;;; adwaita-theme.el ends here diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el index 81dac1902f0..1bee1e7faf8 100644 --- a/etc/themes/manoj-dark-theme.el +++ b/etc/themes/manoj-dark-theme.el @@ -37,7 +37,7 @@ ;; viewed, for example, the Gnus group buffer, consistent and logical ;; color choices are the only sane option. Gnus groups can be newa ;; (blueish) or mail (greenish), have states (large number of under -;; messages, normal, and empty). The large number unread groups have +;; messages, normal, and empty). The large number unread groups have ;; highest luminance (appear brighter), and the empty one have lower ;; luminance (appear grayer), but have the same chroma and saturation. ;; Sub states and group priorities are rendered using a color series @@ -704,4 +704,4 @@ jarring angry fruit salad look to reduce eye fatigue." (provide-theme 'manoj-dark) -;;; manoj-dark.el ends here +;;; manoj-dark-theme.el ends here diff --git a/etc/themes/misterioso-theme.el b/etc/themes/misterioso-theme.el index 75693b59016..6487356fbb1 100644 --- a/etc/themes/misterioso-theme.el +++ b/etc/themes/misterioso-theme.el @@ -134,4 +134,4 @@ (provide-theme 'misterioso) -;;; misterioso-theme.el ends here +;;; misterioso-theme.el ends here diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 36df143a82a..ac9254c867a 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -584,7 +584,7 @@ of the piece of advice." ;;;###autoload (defmacro define-advice (symbol args &rest body) "Define an advice and add it to function named SYMBOL. -See `advice-add' and `add-function' for explanation on the +See `advice-add' and `add-function' for explanation of the arguments. If NAME is non-nil, the advice is named `SYMBOL@NAME' and installed with the name NAME; otherwise, the advice is anonymous. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 73ec3f2bb2d..2785e9a6e68 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -1437,9 +1437,9 @@ recommended to enable `electric-pair-mode' with this mode." :help "Toggle C/C++ comment style between block and line comments"]) "--" ("Toggle..." - ["SubWord Mode" subword-mode + ["Subword Mode" subword-mode :style toggle :selected subword-mode - :help "Toggle sub-word movement and editing mode"]))) + :help "Toggle subword movement and editing mode"]))) ;; We could alternatively use parsers, but if this works well, I don't ;; see the need to change. This is copied verbatim from cc-guess.el. diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 35dc0215046..ca69817953e 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1915,7 +1915,7 @@ If no file is associated with the current buffer, this function returns nil." (defun list-tags (file &optional _next-match) "Display list of tags in file FILE. Interactively, prompt for FILE, with completion, offering the current -buffer's file name as the defaul. +buffer's file name as the default. This command searches only the first table in the list of tags tables, and does not search included tables. FILE should be as it was submitted to the `etags' command, which usually diff --git a/lisp/progmodes/php-ts-mode.el b/lisp/progmodes/php-ts-mode.el index ce8cf8aa340..14a487d3f7a 100644 --- a/lisp/progmodes/php-ts-mode.el +++ b/lisp/progmodes/php-ts-mode.el @@ -437,7 +437,7 @@ Useful for debugging." Return `php-ts-mode-indent-offset' plus 1 when BOL is after `php-ts-mode--possibly-braceless-keyword-re', otherwise return 0. It's -usefull for matching incomplete compound_statement or colon_block. +useful for matching incomplete compound_statement or colon_block. PARENT is NODE's parent, BOL is the beginning of non-whitespace characters of the current line." (and (null node) diff --git a/lisp/treesit.el b/lisp/treesit.el index bedcc260750..9ac470691d6 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -3080,7 +3080,7 @@ If `treesit-defun-name-function' is non-nil, set up If `treesit-simple-imenu-settings' is non-nil, set up Imenu. If either `treesit-outline-predicate' or `treesit-simple-imenu-settings' -are non-nil, and Outline minor mode settings don't alreay exist, setup +are non-nil, and Outline minor mode settings don't already exist, setup Outline minor mode. If `sexp', `sentence' are defined in `treesit-thing-settings', diff --git a/test/lisp/eshell/em-glob-tests.el b/test/lisp/eshell/em-glob-tests.el index 88e9cc73bbd..4169ab7f339 100644 --- a/test/lisp/eshell/em-glob-tests.el +++ b/test/lisp/eshell/em-glob-tests.el @@ -74,7 +74,7 @@ component ending in \"symlink\" is treated as a symbolic link." ;; Ensure the default expansion splices the glob. (eshell-command-result-equal "funcall list *.el" '("a.el" "b.el")) (eshell-command-result-equal "funcall list *.txt" '("c.txt")) - ;; When spliting, no-matches cases also return a list containing + ;; When splitting, no-matches cases also return a list containing ;; the original non-matching glob. (eshell-command-result-equal "funcall list *.no" '("*.no")) (when (eshell-tests-remote-accessible-p) diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts b/test/lisp/progmodes/c-ts-mode-resources/indent.erts index f97ceac61f5..2f3540c3970 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts @@ -208,7 +208,7 @@ int main() } =-=-= -Name: Return Compund Literal +Name: Return Compound Literal =-= struct pair { int fst, snd; }; commit aaefb67f54513e8375ec8356d09bf2e6f25b9116 Author: Eli Zaretskii Date: Sun Oct 27 08:43:00 2024 +0200 ; * src/w32dwrite.c (syms_of_w32dwrite): Init 'w32-inhibit-dwrite'. diff --git a/src/w32dwrite.c b/src/w32dwrite.c index 45be5b5beff..32e2644af2c 100644 --- a/src/w32dwrite.c +++ b/src/w32dwrite.c @@ -1100,6 +1100,10 @@ syms_of_w32dwrite (void) { DEFVAR_BOOL ("w32-inhibit-dwrite", w32_inhibit_dwrite, doc: /* If t, don't use DirectWrite. */); + /* The actual value is determined at startup in + w32_initialize_direct_write, which is called from + syms_of_w32uniscribe_for_pdumper. */ + w32_inhibit_dwrite = false; defsubr (&Sw32_dwrite_reinit); defsubr (&Sw32_dwrite_available); commit 702d5ec56684b87dbe7c46d35c6926a46a0697e9 Author: Cecilio Pardo Date: Sat Oct 26 17:51:22 2024 +0200 ; Fix problem with DirectWrite (MS-Windows) Negative lbearings were not handled. * src/w32dwrite.c (w32_dwrite_draw): Modified to handle negative lbearing. diff --git a/src/w32dwrite.c b/src/w32dwrite.c index ecc33af5f3f..45be5b5beff 100644 --- a/src/w32dwrite.c +++ b/src/w32dwrite.c @@ -895,7 +895,9 @@ w32_dwrite_draw (HDC hdc, int x, int y, unsigned *glyphs, int len, return false; } - int bitmap_width = metrics.width + metrics.rbearing; + int left_margin = metrics.lbearing < 0 ? -metrics.lbearing : 0; + + int bitmap_width = left_margin + metrics.width + metrics.rbearing; int bitmap_height = font->ascent + font->descent; /* We never release this, get_bitmap_render_target reuses it. */ @@ -914,7 +916,7 @@ w32_dwrite_draw (HDC hdc, int x, int y, unsigned *glyphs, int len, = bitmap_render_target->lpVtbl->GetMemoryDC (bitmap_render_target); /* Copy the background pixel to the render target bitmap. */ - BitBlt (text_dc, 0, 0, bitmap_width, bitmap_height, hdc, x, y, SRCCOPY); + BitBlt (text_dc, 0, 0, bitmap_width, bitmap_height, hdc, x - left_margin, y, SRCCOPY); UINT16 *indices = SAFE_ALLOCA (len * sizeof (UINT16)); @@ -948,7 +950,7 @@ w32_dwrite_draw (HDC hdc, int x, int y, unsigned *glyphs, int len, IDWriteColorGlyphRunEnumerator *layers; /* This call will tell us if we have to handle any color glyphs. */ hr = dwrite_factory2->lpVtbl->TranslateColorGlyphRun (dwrite_factory2, - 0, font->ascent, + left_margin, font->ascent, &glyph_run, NULL, MEASURING_MODE, @@ -959,7 +961,7 @@ w32_dwrite_draw (HDC hdc, int x, int y, unsigned *glyphs, int len, /* No color. Just draw the GlyphRun. */ if (hr == DWRITE_E_NOCOLOR) bitmap_render_target->lpVtbl->DrawGlyphRun (bitmap_render_target, - 0, font->ascent, + left_margin, font->ascent, MEASURING_MODE, &glyph_run, rendering_params, @@ -1024,7 +1026,7 @@ w32_dwrite_draw (HDC hdc, int x, int y, unsigned *glyphs, int len, } /* Finally, copy the rendered text back to the original DC. */ - BitBlt (hdc, x, y, bitmap_width, bitmap_height, text_dc, 0, 0, SRCCOPY); + BitBlt (hdc, x - left_margin, y, bitmap_width, bitmap_height, text_dc, 0, 0, SRCCOPY); SAFE_FREE (); return true; } commit d7d5b2ec9a747fac48bd50152e2023d33e78393c Author: Sean Whitton Date: Sun Oct 27 14:11:50 2024 +0800 vc-git-resolve-conflicts: Extend unstage-maybe to similar operations * lisp/vc/vc-git.el (vc-git-resolve-when-done): When vc-git-resolve-conflicts is unstage-maybe, don't clear the staging area during a rebase, am, revert or cherry-pick. (vc-git-resolve-conflicts): Update docstring in light of changes to vc-git-resolve-when-done. (vc-git--cmds-in-progress): Detect reverts and cherry-pick operations in progress. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 2eb2379c351..e4969aede74 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -168,10 +168,10 @@ uses a full scan)." (defcustom vc-git-resolve-conflicts t "When non-nil, mark conflicted file as resolved upon saving. -That is performed after all conflict markers in it have been -removed. If the value is `unstage-maybe', and no merge is in -progress, then after the last conflict is resolved, also clear -the staging area." +That is performed after all conflict markers in it have been removed. +If the value is `unstage-maybe', and no merge, rebase or similar +operation is in progress, then after the last conflict is resolved, also +clear the staging area." :type '(choice (const :tag "Don't resolve" nil) (const :tag "Resolve" t) (const :tag "Resolve and maybe unstage all files" @@ -766,6 +766,10 @@ or an empty string if none." (let ((gitdir (vc-git--git-path)) cmds) ;; See contrib/completion/git-prompt.sh in git.git. + (when (file-exists-p (expand-file-name "REVERT_HEAD" gitdir)) + (push 'revert cmds)) + (when (file-exists-p (expand-file-name "CHERRY_PICK_HEAD" gitdir)) + (push 'cherry-pick cmds)) (when (or (file-directory-p (expand-file-name "rebase-merge" gitdir)) (file-exists-p @@ -1419,8 +1423,14 @@ This prompts for a branch to merge from." (vc-git-command nil 0 buffer-file-name "add") (unless (or (not (eq vc-git-resolve-conflicts 'unstage-maybe)) - ;; Doing a merge, so bug#20292 doesn't apply. - (file-exists-p (vc-git--git-path "MERGE_HEAD")) + ;; Doing a merge or rebase-like operation, so bug#20292 + ;; doesn't apply. + ;; + ;; If we were to 'git reset' in the middle of a + ;; cherry-pick, for example, it would effectively abort + ;; the cherry-pick, losing the user's progress. + (cl-intersection '(merge rebase am revert cherry-pick) + (vc-git--cmds-in-progress)) (vc-git-conflicted-files (vc-git-root buffer-file-name))) (vc-git-command nil 0 nil "reset")) (vc-resynch-buffer buffer-file-name t t) commit bd2b064438601271549c137c53e301ae4ebabd55 Author: Sean Whitton Date: Sun Oct 27 11:37:42 2024 +0800 Backport some docstring updates, warn about upcoming obsolescence Try to save people some time if they're developing on Emacs 30.x. Do not merge to master. * lisp/subr.el (if-let*, when-let*, if-let, when-let): Move docstring text around so that if-let* and when-let* descriptions no longer refer to if-let and when-let. Note that if-let and when-let will be marked obsolete, and recommend if-let*, when-let* and and-let* for new code. diff --git a/lisp/subr.el b/lisp/subr.el index 0acc24042f8..b849d8d1b16 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2625,8 +2625,17 @@ Affects only hooks run in the current buffer." (defmacro if-let* (varlist then &rest else) "Bind variables according to VARLIST and evaluate THEN or ELSE. -This is like `if-let' but doesn't handle a VARLIST of the form -\(SYMBOL SOMETHING) specially." +Evaluate each binding in turn, as in `let*', stopping if a +binding value is nil. If all are non-nil return the value of +THEN, otherwise the value of the last form in ELSE, or nil if +there are none. + +Each element of VARLIST is a list (SYMBOL VALUEFORM) that binds +SYMBOL to the value of VALUEFORM. An element can additionally be +of the form (VALUEFORM), which is evaluated and checked for nil; +i.e. SYMBOL can be omitted if only the test result is of +interest. It can also be of the form SYMBOL, then the binding of +SYMBOL is checked for nil." (declare (indent 2) (debug ((&rest [&or symbolp (symbolp form) (form)]) body))) @@ -2639,8 +2648,10 @@ This is like `if-let' but doesn't handle a VARLIST of the form (defmacro when-let* (varlist &rest body) "Bind variables according to VARLIST and conditionally evaluate BODY. -This is like `when-let' but doesn't handle a VARLIST of the form -\(SYMBOL SOMETHING) specially. +Evaluate each binding in turn, stopping if a binding value is nil. +If all are non-nil, return the value of the last form in BODY. + +The variable list VARLIST is the same as in `if-let*'. See also `and-let*'." (declare (indent 1) (debug if-let*)) @@ -2667,21 +2678,13 @@ for forms evaluated for side-effect with returned values ignored." (defmacro if-let (spec then &rest else) "Bind variables according to SPEC and evaluate THEN or ELSE. -Evaluate each binding in turn, as in `let*', stopping if a -binding value is nil. If all are non-nil return the value of -THEN, otherwise the value of the last form in ELSE, or nil if -there are none. +This is like `if-let*' except, as a special case, interpret a SPEC of +the form \(SYMBOL SOMETHING) like \((SYMBOL SOMETHING)). This exists +for backward compatibility with an old syntax that accepted only one +binding. -Each element of SPEC is a list (SYMBOL VALUEFORM) that binds -SYMBOL to the value of VALUEFORM. An element can additionally be -of the form (VALUEFORM), which is evaluated and checked for nil; -i.e. SYMBOL can be omitted if only the test result is of -interest. It can also be of the form SYMBOL, then the binding of -SYMBOL is checked for nil. - -As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING) -like \((SYMBOL SOMETHING)). This exists for backward compatibility -with an old syntax that accepted only one binding." +This macro will be marked obsolete in Emacs 31.1; prefer `if-let*' in +new code." (declare (indent 2) (debug ([&or (symbolp form) ; must be first, Bug#48489 (&rest [&or symbolp (symbolp form) (form)])] @@ -2697,7 +2700,10 @@ with an old syntax that accepted only one binding." Evaluate each binding in turn, stopping if a binding value is nil. If all are non-nil, return the value of the last form in BODY. -The variable list SPEC is the same as in `if-let'." +The variable list SPEC is the same as in `if-let'. + +This macro will be marked obsolete in Emacs 31.1; prefer `when-let*' and +`and-let*' in new code." (declare (indent 1) (debug if-let)) (list 'if-let spec (macroexp-progn body))) commit d354300993e6a48e2d3e72a7e89348cc06b326fb Author: Sean Whitton Date: Thu Oct 24 17:04:40 2024 +0800 lisp/org: Backport org-mode.git fix for if-let/when-let obsolescence Backporting this acked by Org maintainer Ihor Radchenko. * lisp/org/ob-R.el (org-babel-R-associate-session): * lisp/org/ob-clojure.el (ob-clojure-nbb-command) (ob-clojure-cli-command): * lisp/org/ob-core.el (org-babel-execute-src-block): * lisp/org/ob-exp.el (org-babel-exp-code): * lisp/org/ob-julia.el (org-babel-julia-associate-session): * lisp/org/ob-python.el (org-babel-python--python-util-comint-end-of-output-p): * lisp/org/ol.el (org-insert-link): * lisp/org/org-attach.el (org-attach): * lisp/org/org-clock.el (org-clock-select-task): * lisp/org/org-compat.el (fboundp): * lisp/org/org-element-ast.el (org-element-property-raw) (org-element-put-property, org-element-copy): * lisp/org/org-element.el (org-element-timestamp-interpreter) (org-element--cache-key): * lisp/org/org-goto.el (org-goto-location): * lisp/org/org-lint.el (org-lint-suspicious-language-in-src-block) (org-lint-export-option-keywords): * lisp/org/org-macs.el (org-mks): * lisp/org/org-persist.el: (org-persist-write:elisp): * lisp/org/org-table.el (org-table-fedit-finish): * lisp/org/org.el (org-entry-get-with-inheritance): * lisp/org/ox-html.el (org-html--reference) (org-html--build-mathjax-config, org-html-example-block): * lisp/org/ox-latex.el (org-latex-table-row): * lisp/org/ox.el (org-export--prune-tree) (org-export--blindly-expand-include): Replace use of if-let and when-let, obsolete in Emacs 31.0.50. diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el index de2d27a9a70..8074496f881 100644 --- a/lisp/org/ob-R.el +++ b/lisp/org/ob-R.el @@ -288,7 +288,7 @@ Use PARAMS to set default directory when creating a new session." "Associate R code buffer with an R session. Make SESSION be the inferior ESS process associated with the current code buffer." - (when-let ((process (get-buffer-process session))) + (when-let* ((process (get-buffer-process session))) (setq ess-local-process-name (process-name process)) (ess-make-buffer-current)) (setq-local ess-gen-proc-buffer-name-function (lambda (_) session))) diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el index c7ebbbb95e9..eb2d8c34cac 100644 --- a/lisp/org/ob-clojure.el +++ b/lisp/org/ob-clojure.el @@ -120,14 +120,14 @@ :package-version '(Org . "9.6")) (defcustom ob-clojure-nbb-command (or (executable-find "nbb") - (when-let (npx (executable-find "npx")) + (when-let* ((npx (executable-find "npx"))) (concat npx " nbb"))) "Nbb command used by the ClojureScript `nbb' backend." :type '(choice string (const nil)) :group 'org-babel :package-version '(Org . "9.7")) -(defcustom ob-clojure-cli-command (when-let (cmd (executable-find "clojure")) +(defcustom ob-clojure-cli-command (when-let* ((cmd (executable-find "clojure"))) (concat cmd " -M")) "Clojure CLI command used by the Clojure `clojure-cli' backend." :type '(choice string (const nil)) diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 7b4ca9b5ea3..b657a93dab3 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -870,7 +870,7 @@ guess will be made." (default-directory (cond ((not dir) default-directory) - ((when-let ((session (org-babel-session-buffer info))) + ((when-let* ((session (org-babel-session-buffer info))) (buffer-local-value 'default-directory (get-buffer session)))) ((member mkdirp '("no" "nil" nil)) (file-name-as-directory (expand-file-name dir))) diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el index 30b2a42a6c4..b9d5f288ac1 100644 --- a/lisp/org/ob-exp.el +++ b/lisp/org/ob-exp.el @@ -441,7 +441,7 @@ replaced with its value." ("header-args" . ,(org-babel-exp--at-source - (when-let ((params (org-element-property :parameters (org-element-context)))) + (when-let* ((params (org-element-property :parameters (org-element-context)))) (concat " " params)))) ,@(mapcar (lambda (pair) (cons (substring (symbol-name (car pair)) 1) diff --git a/lisp/org/ob-julia.el b/lisp/org/ob-julia.el index 10a331e54d5..224a8ec75e8 100644 --- a/lisp/org/ob-julia.el +++ b/lisp/org/ob-julia.el @@ -75,7 +75,7 @@ "Associate R code buffer with an R session. Make SESSION be the inferior ESS process associated with the current code buffer." - (when-let ((process (get-buffer-process session))) + (when-let* ((process (get-buffer-process session))) (setq ess-local-process-name (process-name process)) (ess-make-buffer-current)) (setq-local ess-gen-proc-buffer-name-function (lambda (_) session))) diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el index 8a3c24f7038..f881918c75c 100644 --- a/lisp/org/ob-python.el +++ b/lisp/org/ob-python.el @@ -269,7 +269,7 @@ results as a string." "Return non-nil if the last prompt matches input prompt. Backport of `python-util-comint-end-of-output-p' to emacs28. To be removed after minimum supported version reaches emacs29." - (when-let ((prompt (python-util-comint-last-prompt))) + (when-let* ((prompt (python-util-comint-last-prompt))) (python-shell-comint-end-of-output-p (buffer-substring-no-properties (car prompt) (cdr prompt))))) diff --git a/lisp/org/ol.el b/lisp/org/ol.el index a16f27c2e30..c3101254f70 100644 --- a/lisp/org/ol.el +++ b/lisp/org/ol.el @@ -2028,7 +2028,7 @@ non-interactively, don't allow editing the default description." (setq link (substring link 0 -1)))) (setq link (with-current-buffer origbuf (org-link--try-special-completion link))))) - (when-let ((window (get-buffer-window "*Org Links*" t))) + (when-let* ((window (get-buffer-window "*Org Links*" t))) (quit-window 'kill window)) (set-window-configuration wcf) (when (get-buffer "*Org Links*") diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index fc7f50a08e7..a441971238a 100644 --- a/lisp/org/org-attach.el +++ b/lisp/org/org-attach.el @@ -357,7 +357,7 @@ Shows a list of commands and prompts for another key to execute a command." (while (and (setq c (read-char-exclusive)) (memq c '(?\C-n ?\C-p ?\C-v ?\M-v))) (org-scroll c t))) - (when-let ((window (get-buffer-window "*Org Attach*" t))) + (when-let* ((window (get-buffer-window "*Org Attach*" t))) (quit-window 'kill window)) (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*"))))) (let ((command (cl-some (lambda (entry) diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 316cd7eee4b..7ac4f27ad80 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -698,7 +698,7 @@ there is no recent clock to choose from." (fit-window-to-buffer nil nil (if (< chl 10) chl (+ 5 chl))) (message (or prompt "Select task for clocking:")) (unwind-protect (setq cursor-type nil rpl (read-char-exclusive)) - (when-let ((window (get-buffer-window "*Clock Task Select*" t))) + (when-let* ((window (get-buffer-window "*Clock Task Select*" t))) (quit-window 'kill window)) (when (get-buffer "*Clock Task Select*") (kill-buffer "*Clock Task Select*"))) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 41c26ad72fe..e92b8d718c8 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -115,10 +115,10 @@ This is an action function for buffer display, see Info node `(elisp) Buffer Display Action Functions'. It should be called only by `display-buffer' or a function directly or indirectly called by the latter." - (when-let ((window (or (display-buffer-reuse-window buffer alist) - (display-buffer-same-window buffer alist) - (display-buffer-pop-up-window buffer alist) - (display-buffer-use-some-window buffer alist)))) + (when-let* ((window (or (display-buffer-reuse-window buffer alist) + (display-buffer-same-window buffer alist) + (display-buffer-pop-up-window buffer alist) + (display-buffer-use-some-window buffer alist)))) (delete-other-windows window) window))) diff --git a/lisp/org/org-element-ast.el b/lisp/org/org-element-ast.el index f3f74928004..e96b129f1fc 100644 --- a/lisp/org/org-element-ast.el +++ b/lisp/org/org-element-ast.el @@ -410,7 +410,7 @@ If PROPERTY is not present, return DFLT." (let ((idx (org-element--property-idx (inline-const-val property)))) (inline-quote (let ((idx (or ,idx (org-element--property-idx ,property)))) - (if-let ((parray (and idx (org-element--parray ,node)))) + (if-let* ((parray (and idx (org-element--parray ,node)))) (pcase (aref parray idx) (`org-element-ast--nil ,dflt) (val val)) @@ -456,7 +456,7 @@ Return modified NODE." (inline-quote (let ((idx (org-element--property-idx ,property))) (if (and idx (not (org-element-type-p ,node 'plain-text))) - (when-let + (when-let* ((parray (or (org-element--parray ,node) (org-element--put-parray ,node)))) @@ -796,7 +796,7 @@ When DATUM is `plain-text', all the properties are removed." (type (let ((node-copy (append (list type (copy-sequence (cadr datum))) (copy-sequence (cddr datum))))) ;; Copy `:standard-properties' - (when-let ((parray (org-element-property-raw :standard-properties node-copy))) + (when-let* ((parray (org-element-property-raw :standard-properties node-copy))) (org-element-put-property node-copy :standard-properties (copy-sequence parray))) ;; Clear `:parent'. (org-element-put-property node-copy :parent nil) @@ -810,7 +810,7 @@ When DATUM is `plain-text', all the properties are removed." ;; properties. So, we need to reassign inner `:parent' ;; properties to the DATUM copy explicitly. (dolist (secondary-prop (org-element-property :secondary node-copy)) - (when-let ((secondary-value (org-element-property secondary-prop node-copy))) + (when-let* ((secondary-value (org-element-property secondary-prop node-copy))) (setq secondary-value (org-element-copy secondary-value t)) (if (org-element-type secondary-value) (org-element-put-property secondary-value :parent node-copy) diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index a3fe427403a..d184165f6cb 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -4455,10 +4455,10 @@ Assume point is at the beginning of the timestamp." (and val (number-to-string val))) (pcase (org-element-property :repeater-unit timestamp) (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")) - (when-let ((repeater-deadline-value - (org-element-property :repeater-deadline-value timestamp)) - (repeater-deadline-unit - (org-element-property :repeater-deadline-unit timestamp))) + (when-let* ((repeater-deadline-value + (org-element-property :repeater-deadline-value timestamp)) + (repeater-deadline-unit + (org-element-property :repeater-deadline-unit timestamp))) (concat "/" (number-to-string repeater-deadline-value) @@ -6012,7 +6012,7 @@ cache during the synchronization get a new key generated with Such keys are stored inside the element property `:org-element--cache-sync-key'. The property is a cons containing current `org-element--cache-sync-keys-value' and the element key." - (or (when-let ((key-cons (org-element-property :org-element--cache-sync-key element))) + (or (when-let* ((key-cons (org-element-property :org-element--cache-sync-key element))) (when (eq org-element--cache-sync-keys-value (car key-cons)) (cdr key-cons))) (let* ((begin (org-element-begin element)) diff --git a/lisp/org/org-goto.el b/lisp/org/org-goto.el index cb74942a5e7..f75cc9ed85a 100644 --- a/lisp/org/org-goto.el +++ b/lisp/org/org-goto.el @@ -241,7 +241,7 @@ position or nil." (message "Select location and press RET") (use-local-map org-goto-map) (unwind-protect (recursive-edit) - (when-let ((window (get-buffer-window "*Org Help*" t))) + (when-let* ((window (get-buffer-window "*Org Help*" t))) (quit-window 'kill window))))) (when (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) (cons org-goto-selected-point org-goto-exit-command))) diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el index 2d87ae270c4..0f96134587c 100644 --- a/lisp/org/org-lint.el +++ b/lisp/org/org-lint.el @@ -551,7 +551,7 @@ Use :header-args: instead" (defun org-lint-suspicious-language-in-src-block (ast) (org-element-map ast 'src-block (lambda (b) - (when-let ((lang (org-element-property :language b))) + (when-let* ((lang (org-element-property :language b))) (unless (or (functionp (intern (format "org-babel-execute:%s" lang))) ;; No babel backend, but there is corresponding ;; major mode. @@ -859,9 +859,9 @@ Use \"export %s\" instead" (when (member prop common-options) "global ") prop - (if-let ((backends - (and (not (member prop common-options)) - (cdr (assoc-string prop options-alist))))) + (if-let* ((backends + (and (not (member prop common-options)) + (cdr (assoc-string prop options-alist))))) (format " in %S export %s" (if (= 1 (length backends)) (car backends) backends) diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index a6ff0e54512..4071b632fcb 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -573,7 +573,7 @@ is selected, only the bare key is returned." ((assoc current specials) (throw 'exit current)) (t (error "No entry available"))))))) (when buffer - (when-let ((window (get-buffer-window buffer t))) + (when-let* ((window (get-buffer-window buffer t))) (quit-window 'kill window)) (kill-buffer buffer)))))) diff --git a/lisp/org/org-persist.el b/lisp/org/org-persist.el index 7fa836d0d7a..cd66a0a57a8 100644 --- a/lisp/org/org-persist.el +++ b/lisp/org/org-persist.el @@ -810,8 +810,8 @@ COLLECTION is the plist holding data collection." (let ((scope (nth 2 container))) (pcase scope ((pred stringp) - (when-let ((buf (or (get-buffer scope) - (get-file-buffer scope)))) + (when-let* ((buf (or (get-buffer scope) + (get-file-buffer scope)))) ;; FIXME: There is `buffer-local-boundp' introduced in Emacs 28. ;; Not using it yet to keep backward compatibility. (condition-case nil @@ -821,8 +821,8 @@ COLLECTION is the plist holding data collection." (when (boundp (cadr container)) (symbol-value (cadr container)))) (`nil - (if-let ((buf (and (plist-get (plist-get collection :associated) :file) - (get-file-buffer (plist-get (plist-get collection :associated) :file))))) + (if-let* ((buf (and (plist-get (plist-get collection :associated) :file) + (get-file-buffer (plist-get (plist-get collection :associated) :file))))) ;; FIXME: There is `buffer-local-boundp' introduced in Emacs 28. ;; Not using it yet to keep backward compatibility. (condition-case nil diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 8a0943a48b9..222bc7d9658 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -3709,7 +3709,7 @@ With prefix ARG, apply the new formulas to the table." (org-table-store-formulas eql) (set-marker pos nil) (set-marker source nil) - (when-let ((window (get-buffer-window "*Edit Formulas*" t))) + (when-let* ((window (get-buffer-window "*Edit Formulas*" t))) (quit-window 'kill window)) (when (get-buffer "*Edit Formulas*") (kill-buffer "*Edit Formulas*")) (if arg diff --git a/lisp/org/org.el b/lisp/org/org.el index 5bee96fb0b5..4166738c162 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -13219,8 +13219,8 @@ However, if LITERAL-NIL is set, return the string value \"nil\" instead." ;; Consider global properties, if we found no PROPERTY (or maybe ;; only PROPERTY+). (unless found-inherited? - (when-let ((global (org--property-global-or-keyword-value - property t))) + (when-let* ((global (org--property-global-or-keyword-value + property t))) (setq values (cons global values)))) (when values (setq values (mapconcat diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index 446698758c4..4eb3a511b00 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -1732,7 +1732,7 @@ targets and targets." (and (memq type '(radio-target target)) (org-element-property :value datum)) (org-element-property :name datum) - (when-let ((id (org-element-property :ID datum))) + (when-let* ((id (org-element-property :ID datum))) (concat org-html--id-attr-prefix id))))) (cond @@ -2052,7 +2052,7 @@ INFO is a plist used as a communication channel." (when value (pcase symbol (`font - (when-let + (when-let* ((value-new (pcase value ("TeX" "mathjax-tex") @@ -2697,7 +2697,7 @@ information." (let ((attributes (org-export-read-attribute :attr_html example-block))) (if (plist-get attributes :textarea) (org-html--textarea-block example-block) - (if-let ((class-val (plist-get attributes :class))) + (if-let* ((class-val (plist-get attributes :class))) (setq attributes (plist-put attributes :class (concat "example " class-val))) (setq attributes (plist-put attributes :class "example"))) (format "\n%s" diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index 79df1fe119e..4d0935b073d 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -4097,7 +4097,7 @@ a communication channel." (unless (hash-table-p table-head-cache) (setq table-head-cache (make-hash-table :test #'eq)) (plist-put info :org-latex-table-head-cache table-head-cache)) - (if-let ((head-contents (gethash (org-element-parent table-row) table-head-cache))) + (if-let* ((head-contents (gethash (org-element-parent table-row) table-head-cache))) (puthash (org-element-parent table-row) (concat head-contents "\\\\\n" contents) table-head-cache) (puthash (org-element-parent table-row) contents table-head-cache)))) diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 7cdf622ec44..fd8bfa1114a 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -2672,7 +2672,7 @@ from tree." (let ((type (org-element-type data))) (if (org-export--skip-p data info selected excluded) (if (memq type '(table-cell table-row)) (push data ignore) - (if-let ((keep-spaces (org-export--keep-spaces data info))) + (if-let* ((keep-spaces (org-export--keep-spaces data info))) ;; Keep spaces in place of removed ;; element, if necessary. ;; Example: "Foo.[10%] Bar" would become @@ -3456,7 +3456,7 @@ file." (with-temp-buffer (let ((org-inhibit-startup t) (lines - (if-let ((location (plist-get parameters :location))) + (if-let* ((location (plist-get parameters :location))) (org-export--inclusion-absolute-lines file location (plist-get parameters :only-contents) commit 2030b8c7f24a10024ab973149b10194fd50dd2bb Author: Dmitry Gutov Date: Sun Oct 27 03:46:57 2024 +0300 vc-git-log-edit-toggle-amend: Honor vc-allow-rewriting-published-history * etc/NEWS: Update the entry for vc-allow-rewriting-published-history. * lisp/vc/vc-git.el (vc-git-log-edit-toggle-amend): Add a check against published history (bug#64055). diff --git a/etc/NEWS b/etc/NEWS index 5bb1c8a4695..d1c7303f976 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -613,13 +613,11 @@ of seconds. Crossfading can be toggled using the command --- *** New user option 'vc-allow-rewriting-published-history'. -Many VCS commands can change your copy of published change history -without warning. If VC commands detect that this could happen, they -will stop. You can customize this variable to permit rewriting history +Some VCS commands can change your copy of published change history +without warning. In VC we try to detect before that happens, and stop. +You can customize this variable to permit rewriting history even though Emacs thinks it is dangerous. -So far, this applies only to using 'e' from Log View mode for Git. - --- *** 'vc-clone' is now an interactive command. When called interactively, 'vc-clone' now prompts for the remote diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 2702203a371..2eb2379c351 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1040,6 +1040,7 @@ See `vc-git-log-edit-summary-max-len'.") "Toggle whether this will amend the previous commit. If toggling on, also insert its message into the buffer." (interactive) + (vc-git--assert-allowed-rewrite (vc-git--rev-parse "HEAD")) (log-edit--toggle-amend (lambda () (vc-git-get-change-comment nil "HEAD")))) commit 523aade3ea11c188e30e3889f031d1848129cf82 Author: Jim Porter Date: Sun Oct 20 21:37:55 2024 -0700 Fix Eshell incompatibility with "[" command when eshell-pred is disabled * lisp/eshell/em-pred.el (eshell-pred-initialize): Ensure that 'eshell-parse-arg-modifier' is called before 'eshell-parse-glob-chars'. * lisp/eshell/em-glob.el (eshell-glob-initialize): Use a number for hook depth to be clearer. (eshell-parse-glob-chars): Simplify; since eshell-pred's hook now runs first, the extra code is no longer necessary. * test/lisp/eshell/em-glob-tests.el (em-glob-test/test-command-without-pred): New test. diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index 8c8466960c1..57bb0c53b57 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -141,7 +141,7 @@ This mimics the behavior of zsh if non-nil, but bash if nil." (when (boundp 'eshell-special-chars-outside-quoting) (setq-local eshell-special-chars-outside-quoting (append eshell-glob-chars-list eshell-special-chars-outside-quoting))) - (add-hook 'eshell-parse-argument-hook 'eshell-parse-glob-chars t t) + (add-hook 'eshell-parse-argument-hook 'eshell-parse-glob-chars 90 t) (add-hook 'eshell-pre-rewrite-command-hook 'eshell-no-command-globbing nil t)) @@ -165,22 +165,7 @@ The character is not advanced for ordinary globbing characters, so that other function may have a chance to override the globbing interpretation." (when (memq (char-after) eshell-glob-chars-list) - (if (not (memq (char-after) '(?\( ?\[))) - (ignore (eshell-add-glob-modifier)) - (let ((here (point))) - (forward-char) - (let* ((delim (char-before)) - (end (eshell-find-delimiter - delim (if (eq delim ?\[) ?\] ?\))))) - (if (not end) - (throw 'eshell-incomplete (char-to-string delim)) - (if (and (eshell-using-module 'eshell-pred) - (eshell-arg-delimiter (1+ end))) - (ignore (goto-char here)) - (eshell-add-glob-modifier) - (prog1 - (buffer-substring-no-properties (1- (point)) (1+ end)) - (goto-char (1+ end)))))))))) + (ignore (eshell-add-glob-modifier)))) (defvar eshell-glob-matches) (defvar message-shown) diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index 053ebf91dab..df7438ffa4d 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -261,8 +261,8 @@ respectively.") (defun eshell-pred-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the predicate/modifier code." - (add-hook 'eshell-parse-argument-hook - #'eshell-parse-arg-modifier t t) + ;; Make sure this function runs before `eshell-parse-glob-chars'. + (add-hook 'eshell-parse-argument-hook #'eshell-parse-arg-modifier 50 t) (eshell-pred-mode)) (defun eshell-apply-modifiers (lst predicates modifiers string-desc) diff --git a/test/lisp/eshell/em-glob-tests.el b/test/lisp/eshell/em-glob-tests.el index 88e9cc73bbd..239968917ab 100644 --- a/test/lisp/eshell/em-glob-tests.el +++ b/test/lisp/eshell/em-glob-tests.el @@ -317,4 +317,15 @@ value of `eshell-glob-splice-results'." (should (equal (eshell-extended-glob (format "%s~/file.txt" remote)) (format "%s~/file.txt" remote))))) +;; Compatibility tests + + +(ert-deftest em-glob-test/test-command-without-pred () + "Test that the \"[\" command works when `eshell-pred' is disabled." + (skip-unless (executable-find "[")) + (let ((eshell-modules-list (remq 'eshell-pred eshell-modules-list))) + (with-temp-eshell + (eshell-match-command-output "[ foo = foo ]" "\\`\\'") + (should (= eshell-last-command-status 0))))) + ;; em-glob-tests.el ends here commit d6fe32e531044b518ae5b6b39377378cbf13292d Author: Jim Porter Date: Sat Oct 26 14:22:38 2024 -0700 ; Ensure 'eshell-split-filename' doesn't expand the filename first * lisp/eshell/esh-util.el (eshell-split-filename): Never expand the filename. * lisp/eshell/em-glob.el (eshell-glob-p): A leading "~" isn't a globbing character. * test/lisp/eshell/esh-util-tests.el (esh-util-test/split-filename/absolute) (esh-util-test/split-filename/relative) (esh-util-test/split-filename/user) (esh-util-test/split-filename/remote-absolute) (esh-util-test/split-filename/remote-relative) (esh-util-test/split-filename/remote-user): New tests. diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index f4337872a8e..8c8466960c1 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -244,7 +244,10 @@ resulting regular expression." (defun eshell-glob-p (pattern) "Return non-nil if PATTERN has any special glob characters." - (string-match (eshell-glob-chars-regexp) pattern)) + ;; "~" is an infix globbing character, so one at the start of a glob + ;; must be a literal. + (let ((start (if (string-prefix-p "~" pattern) 1 0))) + (string-match (eshell-glob-chars-regexp) pattern start))) (defun eshell-glob-convert-1 (glob &optional last) "Convert a GLOB matching a single element of a file name to regexps. diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 180f049e495..65e19228e0e 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -462,7 +462,7 @@ Prepend remote identification of `default-directory', if any." (defun eshell-split-filename (filename) "Split a FILENAME into a list of file/directory components." (let* ((remote (file-remote-p filename)) - (filename (file-local-name filename)) + (filename (or (file-remote-p filename 'localname 'never) filename)) (len (length filename)) (index 0) (curr-start 0) parts) diff --git a/test/lisp/eshell/esh-util-tests.el b/test/lisp/eshell/esh-util-tests.el index 4a0874bff39..b2fd01e0c29 100644 --- a/test/lisp/eshell/esh-util-tests.el +++ b/test/lisp/eshell/esh-util-tests.el @@ -183,4 +183,44 @@ (should (equal (eshell-get-path 'literal) expected-path)))) +(ert-deftest esh-util-test/split-filename/absolute () + "Test splitting an absolute filename." + (should (equal (eshell-split-filename "/foo/bar/file.txt") + '("/" "foo/" "bar/" "file.txt")))) + +(ert-deftest esh-util-test/split-filename/relative () + "Test splitting a relative filename." + (should (equal (eshell-split-filename "foo/bar/file.txt") + '("foo/" "bar/" "file.txt")))) + +(ert-deftest esh-util-test/split-filename/user () + "Test splitting a user filename." + (should (equal (eshell-split-filename "~/file.txt") + '("~/" "file.txt"))) + (should (equal (eshell-split-filename "~user/file.txt") + '("~user/" "file.txt")))) + +(ert-deftest esh-util-test/split-filename/remote-absolute () + "Test splitting a remote absolute filename." + (skip-unless (eshell-tests-remote-accessible-p)) + (let ((remote (file-remote-p ert-remote-temporary-file-directory))) + (should (equal (eshell-split-filename (format "%s/foo/bar/file.txt" remote)) + `(,remote "/" "foo/" "bar/" "file.txt"))))) + +(ert-deftest esh-util-test/split-filename/remote-relative () + "Test splitting a remote relative filename." + (skip-unless (eshell-tests-remote-accessible-p)) + (let ((remote (file-remote-p ert-remote-temporary-file-directory))) + (should (equal (eshell-split-filename (format "%sfoo/bar/file.txt" remote)) + `(,remote "foo/" "bar/" "file.txt"))))) + +(ert-deftest esh-util-test/split-filename/remote-user () + "Test splitting a remote user filename." + (skip-unless (eshell-tests-remote-accessible-p)) + (let ((remote (file-remote-p ert-remote-temporary-file-directory))) + (should (equal (eshell-split-filename (format "%s~/file.txt" remote)) + `(,remote "~/" "file.txt"))) + (should (equal (eshell-split-filename (format "%s~user/file.txt" remote)) + `(,remote "~user/" "file.txt"))))) + ;;; esh-util-tests.el ends here commit 02510606f6d0e431e36634b8290e648b3a47af18 Author: Eli Zaretskii Date: Sat Oct 26 22:38:58 2024 +0300 Fix bootstrap on MS-Windows * src/w32uniscribe.c (syms_of_w32uniscribe): Don't call 'syms_of_w32dwrite' here... * src/emacs.c (main): ...call it here. Reported by Andy Moreton . diff --git a/src/emacs.c b/src/emacs.c index b0d1f2f53e8..bdd9eee10c4 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2472,6 +2472,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #ifdef HAVE_W32NOTIFY syms_of_w32notify (); #endif /* HAVE_W32NOTIFY */ + syms_of_w32dwrite (); #endif /* WINDOWSNT */ syms_of_xwidget (); diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index d6db1e9e7db..66d27b81b9e 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c @@ -1512,7 +1512,6 @@ static void syms_of_w32uniscribe_for_pdumper (void); void syms_of_w32uniscribe (void) { - syms_of_w32dwrite (); pdumper_do_now_and_after_load (syms_of_w32uniscribe_for_pdumper); } commit e0b21b6c4de4d7f0b7ad9ae112755435f501835e Author: Earl Hyatt Date: Sat Oct 12 20:28:25 2024 -0400 Add delete-selection-local-mode. * lisp/delsel.el (delete-selection-local-mode): Add local version of 'delete-selection-mode'. The local mode sets the value of the variable 'delete-selection-mode' to maintain compatibility with packages and features that consider the existing mode. * doc/emacs/mark.texi (Using Region): Describe 'delete-selection-local-mode'. * etc/NEWS: Describe 'delete-selection-local-mode'. diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi index 0d705769f55..83261d36495 100644 --- a/doc/emacs/mark.texi +++ b/doc/emacs/mark.texi @@ -306,6 +306,7 @@ instead signal an error if the mark is inactive. @cindex Delete Selection mode @cindex mode, Delete Selection @findex delete-selection-mode +@findex delete-selection-local-mode @vindex delete-selection-temporary-region By default, text insertion occurs normally even if the mark is active---for example, typing @kbd{a} inserts the character @samp{a}, @@ -323,7 +324,8 @@ setting @code{delete-selection-temporary-region} to @code{selection}: then temporary regions by @kbd{C-u C-x C-x} won't be replaced, only the ones activated by dragging the mouse or shift-selection. To toggle Delete Selection mode on or off, type @kbd{M-x -delete-selection-mode}. +delete-selection-mode}. To toggle Delete Selection mode on or off +in the current buffer only, type @kbd{M-x delete-selection-local-mode}. @node Mark Ring @section The Mark Ring diff --git a/etc/NEWS b/etc/NEWS index a00536607da..5bb1c8a4695 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -206,6 +206,12 @@ Typing 'M-~' while saving some buffers means not to save the buffer and also to mark it as unmodified. This is an alternative way to mark a buffer as unmodified which doesn't require switching to that buffer. +** New minor mode 'delete-selection-local-mode'. +This mode sets 'delete-selection-mode' buffer-locally. This can be +useful for enabling or disabling the features of 'delete-selection-mode' +based on the state of the buffer, such as for the different states of +modal editing packages. + * Changes in Specialized Modes and Packages in Emacs 31.1 diff --git a/lisp/delsel.el b/lisp/delsel.el index df99a56d7bc..18d889ab4c8 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -95,6 +95,24 @@ information on adapting behavior of commands in Delete Selection mode." (remove-hook 'pre-command-hook 'delete-selection-pre-hook) (add-hook 'pre-command-hook 'delete-selection-pre-hook))) +;;;###autoload +(define-minor-mode delete-selection-local-mode + "Toggle `delete-selection-mode' only in this buffer. + +For compatibility with features and packages that are aware of +`delete-selection-mode', this local mode sets the variable +`delete-selection-mode' in the current buffer as needed." + :global nil :group 'editing-basics + :variable (buffer-local-value 'delete-selection-mode (current-buffer)) + (cond + ((eq delete-selection-mode (default-value 'delete-selection-mode)) + (kill-local-variable 'delete-selection-mode)) + ((not (default-value 'delete-selection-mode)) + ;; Locally enabled, but globally disabled. + (delete-selection-mode 1) ; Setup the hooks. + (setq-default delete-selection-mode nil) ; But keep it globally disabled. + ))) + (defvar delsel--replace-text-or-position nil) ;;;###autoload commit 3f94b979d8070c2f6ac1a09638424b8a69b5cbc5 Author: Michael Albinus Date: Sat Oct 26 18:55:46 2024 +0200 ; Remove proced-tests.el instrumentation (Do not merge with master) diff --git a/test/lisp/proced-tests.el b/test/lisp/proced-tests.el index 682c1328549..6f16a241146 100644 --- a/test/lisp/proced-tests.el +++ b/test/lisp/proced-tests.el @@ -28,13 +28,11 @@ `(let ((proced-format ,format) (proced-filter ,filter) (proced-auto-update-flag nil) - (inhibit-message (not (getenv "EMACS_EMBA_CI")))) + (inhibit-message t)) (proced) (unwind-protect (with-current-buffer "*Proced*" ,@body) - (with-current-buffer "*Proced*" - (message "%s" (buffer-string))) (kill-buffer "*Proced*")))) (defun proced--assert-emacs-pid-in-buffer () commit dd52839dd9d5f5af1f961e3ace2554931ec66510 Author: Stefan Monnier Date: Sat Oct 26 11:12:32 2024 -0400 * lisp/editorconfig.el (editorconfig--get-indentation): Fix bug#73991 diff --git a/lisp/editorconfig.el b/lisp/editorconfig.el index 8d239229dcb..c524945c4b9 100644 --- a/lisp/editorconfig.el +++ b/lisp/editorconfig.el @@ -437,8 +437,18 @@ heuristic for those modes not found there." (let ((style (gethash 'indent_style props)) (size (gethash 'indent_size props)) (tab_width (gethash 'tab_width props))) - (when tab_width - (setq tab_width (string-to-number tab_width))) + (cond + (tab_width (setq tab_width (string-to-number tab_width))) + ;; The EditorConfig spec is excessively eager to set `tab-width' + ;; even when not explicitly requested (bug#73991). + ;; As a trade-off, we accept `indent_style=tab' as a good enough hint. + ((and (equal style "tab") (editorconfig-string-integer-p size)) + (setq tab_width (string-to-number size)))) + + ;; When users choose `indent_size=tab', they most likely prefer + ;; `indent_style=tab' as well. + (when (and (null style) (equal size "tab")) + (setq style "tab")) (setq size (cond ((editorconfig-string-integer-p size) commit fb974171b44253aa0600074e9b293bdeabc8c032 Author: Eyal Soha Date: Sat Oct 26 14:16:26 2024 +0200 Improve Tramp VC cache * lisp/net/tramp-sh.el (tramp-vc-file-name-handler): Add `file-directory-p', which is used in `vc-find-root'. (Bug#74026) Copyright-paperwork-exempt: yes diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 9e813ecc628..068c3483750 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3735,10 +3735,12 @@ Fall back to normal file name handler if no Tramp handler exists." (cond ;; That's what we want: file names, for which checks are ;; applied. We assume that VC uses only `file-exists-p' - ;; and `file-readable-p' checks; otherwise we must extend - ;; the list. We do not perform any action, but return - ;; nil, in order to keep `vc-registered' running. - ((and fn (memq operation '(file-exists-p file-readable-p))) + ;; `file-readable-p' and `file-directory-p' checks; + ;; otherwise we must extend the list. We do not perform + ;; any action, but return nil, in order to keep + ;; `vc-registered' running. + ((and fn (memq operation + '(file-exists-p file-readable-p file-directory-p))) (add-to-list 'tramp-vc-registered-file-names localname 'append) nil) ;; `process-file' and `start-file-process' shall be ignored. commit c2fcb6ca5c4baea5eed39376be12c21e03a960c2 Author: Alan Mackenzie Date: Sat Oct 26 11:01:15 2024 +0000 * lisp/progmodes/cc-langs.el (c-cpp-matchers): Remove an unneeded let*. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 3a87339e38a..83afe081b85 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -556,26 +556,23 @@ stuff. Used on level 1 and higher." ;; Fontify filenames in #include <...> as strings. ,@(when (c-lang-const c-cpp-include-directives) - (let* ((re (c-make-keywords-re nil - (c-lang-const c-cpp-include-directives))) - (re-depth (regexp-opt-depth re))) - ;; We used to use a font-lock "anchored matcher" here for - ;; the paren syntax. This failed when the ">" was at EOL, - ;; since `font-lock-fontify-anchored-keywords' terminated - ;; its loop at EOL without executing our lambda form at - ;; all. - `((,(concat noncontinued-line-end - "\\(" ; To make the next ^ special. - (c-lang-const c-cpp-include-key) - "\\)" - (c-lang-const c-syntactic-ws) - "\\(<\\([^>\n\r]*\\)>?\\)") - ,(+ ncle-depth 1 - (regexp-opt-depth - (c-lang-const c-cpp-include-key)) - sws-depth - (if (featurep 'xemacs) 2 1)) - font-lock-string-face t)))) + ;; We used to use a font-lock "anchored matcher" here for + ;; the paren syntax. This failed when the ">" was at EOL, + ;; since `font-lock-fontify-anchored-keywords' terminated + ;; its loop at EOL without executing our lambda form at all. + ;; (2024-10): The paren syntax is now handled in + ;; before/after-change functions. + `((,(concat noncontinued-line-end + "\\(" ; To make the next ^ special. + (c-lang-const c-cpp-include-key) + "\\)" + (c-lang-const c-syntactic-ws) + "\\(<\\([^>\n\r]*\\)>?\\)") + ,(+ ncle-depth 1 + (regexp-opt-depth (c-lang-const c-cpp-include-key)) + sws-depth + (if (featurep 'xemacs) 2 1)) + font-lock-string-face t))) ;; #define. ,@(when (c-lang-const c-opt-cpp-macro-define) commit ed1d691184df4b50da6b8e1a207e9ccd88aa9ffb (tag: refs/tags/emacs-30.0.92) Author: Andrea Corallo Date: Sat Oct 26 12:09:36 2024 +0200 Update 'ldefs-boot.el' (don't merge) * lisp/ldefs-boot.el: Update. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 51a2333826e..06797a17e18 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -6120,6 +6120,11 @@ This is like `setq', but is meant for user options instead of plain variables. This means that `setopt' will execute any `custom-set' form associated with VARIABLE. +Note that `setopt' will emit a warning if the type of a VALUE +does not match the type of the corresponding VARIABLE as +declared by `defcustom'. (VARIABLE will be assigned the value +even if it doesn't match the type.) + (fn [VARIABLE VALUE]...)" nil t) (autoload 'setopt--set "cus-edit" "\ @@ -11241,11 +11246,12 @@ For non-interactive use, this is superseded by `fileloop-initialize-replace'. (set-advertised-calling-convention 'tags-query-replace '(from to &optional delimited) '"27.1") (autoload 'list-tags "etags" "\ Display list of tags in file FILE. -This searches only the first table in the list, and no included -tables. FILE should be as it appeared in the `etags' command, -usually without a directory specification. If called -interactively, FILE defaults to the file name of the current -buffer. +Interactively, prompt for FILE, with completion, offering the current +buffer's file name as the defaul. +This command searches only the first table in the list of tags tables, +and does not search included tables. +FILE should be as it was submitted to the `etags' command, which usually +means relative to the directory of the tags table file. (fn FILE &optional NEXT-MATCH)" t) (autoload 'tags-apropos "etags" "\ @@ -12679,6 +12685,11 @@ The command run (after changing into DIR) is essentially except that the car of the variable `find-ls-option' specifies what to use in place of \"-ls\" as the final argument. +If your `find' program is not a GNU Find, the columns in the produced +Dired display might fail to align. We recommend to install GNU Find in +those cases (you may need to customize the value of `find-program' if +you do so), which attempts to align the columns. + Collect output in the \"*Find*\" buffer. To kill the job before it finishes, type \\[kill-find]. @@ -33755,7 +33766,7 @@ Add archive file name handler to `file-name-handler-alist'." (when (and tramp-ar ;;; Generated autoloads from transient.el -(push (purecopy '(transient 0 7 2 1)) package--builtin-versions) +(push (purecopy '(transient 0 7 2 2)) package--builtin-versions) (autoload 'transient-insert-suffix "transient" "\ Insert a SUFFIX into PREFIX before LOC. PREFIX is a prefix command, a symbol. @@ -38396,7 +38407,7 @@ TYPES should be a MIME media type symbol, a regexp, or a list that can contain both symbols and regexps. HANDLER is a function that will be called with two arguments: The -MIME type (a symbol on the form `image/png') and the selection +MIME type (a symbol of the form `image/png') and the selection data (a string). (fn TYPES HANDLER)") commit bbc8a5830af7681ef5aea08ae309707a0c989599 Author: Andrea Corallo Date: Sat Oct 26 11:41:45 2024 +0200 Bump Emacs version to 30.0.92 * nt/README.W32: Update Emacs version. * msdos/sed2v2.inp: Likewise. * exec/configure.ac: Likewise. * configure.ac: Likewise. * README: Likewise. diff --git a/README b/README index e994e6e947d..6336a0f41ab 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ Copyright (C) 2001-2024 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 30.0.91 of GNU Emacs, the extensible, +This directory tree holds version 30.0.92 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/configure.ac b/configure.ac index 6473f4bbc9d..730c5ea942b 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see . AC_PREREQ([2.65]) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. -AC_INIT([GNU Emacs], [30.0.91], [bug-gnu-emacs@gnu.org], [], +AC_INIT([GNU Emacs], [30.0.92], [bug-gnu-emacs@gnu.org], [], [https://www.gnu.org/software/emacs/]) if test "$XCONFIGURE" = "android"; then diff --git a/exec/configure.ac b/exec/configure.ac index 1382e34c741..b9d46434432 100644 --- a/exec/configure.ac +++ b/exec/configure.ac @@ -22,7 +22,7 @@ dnl You should have received a copy of the GNU General Public License dnl along with GNU Emacs. If not, see . AC_PREREQ([2.65]) -AC_INIT([libexec], [30.0.91], [bug-gnu-emacs@gnu.org], [], +AC_INIT([libexec], [30.0.92], [bug-gnu-emacs@gnu.org], [], [https://www.gnu.org/software/emacs/]) AH_TOP([/* Copyright (C) 2024 Free Software Foundation, Inc. diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index 794a1eb89f9..e2f2a5e23a9 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -67,7 +67,7 @@ /^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/ /^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ -/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "30.0.91"/ +/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "30.0.92"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ diff --git a/nt/README.W32 b/nt/README.W32 index 801c1282de6..3eca9e90716 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,7 +1,7 @@ Copyright (C) 2001-2024 Free Software Foundation, Inc. See the end of the file for license conditions. - Emacs version 30.0.91 for MS-Windows + Emacs version 30.0.92 for MS-Windows This README file describes how to set up and run a precompiled distribution of the latest version of GNU Emacs for MS-Windows. You commit e0f964c16df4951e3d1ad6d43371ce2a09ede28c Author: Andrea Corallo Date: Sat Oct 26 11:38:39 2024 +0200 ; * etc/AUTHORS: Update. diff --git a/etc/AUTHORS b/etc/AUTHORS index 838d2127a7d..3f62ddb8834 100644 --- a/etc/AUTHORS +++ b/etc/AUTHORS @@ -303,10 +303,10 @@ Anders Waldenborg: changed emacsclient.c Andrea Corallo: wrote comp-common.el comp-cstr-tests.el comp-cstr.el comp-run.el comp-tests.el comp.c comp.el syncdoc-type-hierarchy.el -and changed pdumper.c lread.c bytecomp.el startup.el configure.ac +and changed pdumper.c lread.c bytecomp.el configure.ac startup.el loadup.el comp.h lisp.h cl-macs.el cl-preloaded.el comp-test-funcs.el subr.el Makefile.in data.c elisp-mode.el nadvice.el alloc.c byte-run.el - emacs.c lisp/Makefile.in advice.el and 100 other files + emacs.c lisp/Makefile.in advice.el and 101 other files André A. Gomes: changed ispell.el @@ -372,7 +372,7 @@ Andre Spiegel: changed vc.el vc-hooks.el vc-cvs.el vc-rcs.el vc-sccs.el parse-time.el startup.el tramp-vc.el vc-arch.el vc-mcvs.el vc-svn.el vcdiff viper-util.el -Andrés Ramírez: changed viper-cmd.el +Andrés Ramírez: changed viper-cmd.el viperCard.tex Andre Srinivasan: changed gnus-group.el gnus-sum.el gnus.texi message.el mm-decode.el mml.el nnmail.el @@ -776,6 +776,8 @@ Brendan Kehoe: changed hpux9.h Brendan O'Dea: changed em-unix.el woman.el +Brennan Vincent: changed eglot.el + Brent Goodrick: changed abbrev.el Brent Westbrook: changed eudcb-mailabbrev.el @@ -1736,7 +1738,7 @@ and co-wrote help-tests.el and changed xdisp.c display.texi w32.c msdos.c simple.el w32fns.c files.el fileio.c keyboard.c emacs.c configure.ac text.texi w32term.c dispnew.c frames.texi w32proc.c files.texi xfaces.c window.c - dispextern.h lisp.h and 1397 other files + dispextern.h lisp.h and 1398 other files Eliza Velasquez: changed server.el simple.el @@ -2885,8 +2887,8 @@ Jim Paris: changed process.c Jim Porter: changed eshell.texi esh-cmd.el esh-var.el esh-var-tests.el eshell-tests.el esh-proc.el esh-io.el esh-cmd-tests.el esh-util.el esh-arg.el esh-mode.el esh-proc-tests.el eshell-tests-helpers.el - tramp.el em-cmpl.el em-pred.el em-unix.el em-dirs.el eshell/eshell.el - em-cmpl-tests.el em-glob.el and 137 other files + tramp.el em-cmpl.el em-pred.el em-unix.el em-dirs.el em-glob.el + eshell/eshell.el em-cmpl-tests.el and 137 other files Jim Radford: changed gnus-start.el @@ -3145,6 +3147,8 @@ Jörg Bornemann: changed cmake-ts-mode.el Jorge A. Alfaro-Murillo: changed message.el +Jørgen Kvalsvik: changed c-ts-mode.el indent.erts + Jorgen Schäfer: wrote erc-autoaway.el erc-goodies.el erc-spelling.el and changed erc.el erc-track.el erc-backend.el erc-match.el misc.el erc-stamp.el erc-button.el erc-fill.el erc-members.el erc-truncate.el @@ -4118,7 +4122,7 @@ Matt Hodges: changed textmodes/table.el faces.el iswitchb.el simple.el Mattias Engdegård: changed byte-opt.el bytecomp.el bytecomp-tests.el fns.c subr.el rx.el lisp.h rx-tests.el lread.c searching.texi eval.c - bytecode.c print.c calc-tests.el progmodes/compile.el alloc.c + bytecode.c print.c alloc.c calc-tests.el progmodes/compile.el fns-tests.el macroexp.el subr-tests.el cconv.el data.c and 789 other files @@ -4419,7 +4423,7 @@ Morgan Smith: changed image-dired.el doc-view.el window.el esh-var-tests.el esh-var.el eshell.texi gnus-group-tests.el minibuffer-tests.el minibuffer.el url-vars.el vc-git.el -Morgan Willcock: changed tempo.el +Morgan Willcock: changed tempo.el electric.el ert-font-lock.el Moritz Maxeiner: changed commands.texi cus-start.el dispnew.c xdisp.c @@ -4897,7 +4901,7 @@ Peter Münster: changed image-dired.el gnus-delay.el gnus-demon.el Peter O'Gorman: changed configure.ac frame.h hpux10-20.h termhooks.h Peter Oliver: changed emacsclient.desktop emacsclient-mail.desktop - Makefile.in emacs-mail.desktop misc.texi server.el configure.ac + Makefile.in emacs-mail.desktop configure.ac misc.texi server.el dired-tests.el ediff-diff.el emacs.c emacs.desktop emacs.metainfo.xml emacsclient.1 perl-mode.el ruby-mode-tests.el vc-sccs.el wdired-tests.el @@ -5298,9 +5302,8 @@ Robert P. Goldman: changed org.texi ob-exp.el org.el ox-latex.el Robert Pluim: wrote nsm-tests.el and changed configure.ac process.c keymap.el blocks.awk custom.texi font.c network-stream-tests.el processes.texi emoji-zwj.awk ftfont.c - gtkutil.c process-tests.el unicode vc-git.el files.texi nsterm.m - terminal.c char-fold.el display.texi gnutls.el help.el - and 214 other files + gtkutil.c process-tests.el unicode vc-git.el display.texi files.texi + nsterm.m terminal.c char-fold.el gnutls.el help.el and 215 other files Robert Thorpe: changed cus-start.el indent.el rmail.texi @@ -5526,9 +5529,9 @@ Sean Sieger: changed emacs-lisp-intro.texi Sean Whitton: wrote em-elecslash.el em-extpipe-tests.el em-extpipe.el and changed vc-git.el project.el bindings.el server.el simple.el - vc-dispatcher.el vc.el eshell-tests.el eshell.texi subr-x.el window.el - .dir-locals.el cl-macs.el eshell-tests-helpers.el files.texi ftfont.c - startup.el subr.el term.el INSTALL authors.el and 32 other files + vc-dispatcher.el vc.el window.el eshell-tests.el eshell.texi subr-x.el + subr.el .dir-locals.el cl-macs.el eshell-tests-helpers.el files.texi + ftfont.c remember.el startup.el term.el INSTALL and 34 other files Sebastian Fieber: changed gnus-art.el mm-decode.el mm-view.el @@ -5716,10 +5719,10 @@ Sławomir Nowaczyk: changed emacs.py progmodes/python.el TUTORIAL.pl Spencer Baugh: wrote uniquify-tests.el which-func-tests.el and changed project.el minibuffer.el simple.el progmodes/grep.el vc-hg.el - data-tests.el flymake.el mini.texi startup.el uniquify.el which-func.el - alloc.c autorevert.el bindings.el casefiddle-tests.el casefiddle.c - comint.el crm.el dired-aux.el dired-x.el dired-x.texi - and 22 other files + data-tests.el flymake.el mini.texi minibuffer-tests.el startup.el + uniquify.el which-func.el alloc.c autorevert.el bindings.el + casefiddle-tests.el casefiddle.c comint.el crm.el dired-aux.el + dired-x.el and 22 other files Spencer Thomas: changed dabbrev.el emacsclient.c gnus.texi server.el unexcoff.c @@ -5749,7 +5752,7 @@ and co-wrote help-tests.el keymap-tests.el and changed image-dired.el efaq.texi package.el cperl-mode.el checkdoc.el subr.el help.el simple.el bookmark.el dired.el files.el dired-x.el gnus.texi browse-url.el erc.el keymap.c image-mode.el ediff-util.el - speedbar.el woman.el ffap.el and 1800 other files + speedbar.el woman.el eglot.el and 1801 other files Stefan Merten: co-wrote rst.el @@ -5799,11 +5802,11 @@ Stephen A. Wood: changed fortran.el Stephen Berman: wrote todo-mode-tests.el and co-wrote todo-mode.el visual-wrap.el -and changed wdired.el wid-edit.el todo-mode.texi wdired-tests.el +and changed wid-edit.el wdired.el todo-mode.texi wdired-tests.el diary-lib.el dired.el dired-tests.el doc-view.el files.el info.el minibuffer.el outline.el todo-test-1.todo widget.texi allout.el eww.el find-dired.el frames.texi hl-line.el ibuffer.el menu-bar.el - and 70 other files + and 71 other files Stephen C. Gilardi: changed configure.ac @@ -6086,6 +6089,8 @@ Thomas Riccardi: changed erc-backend.el Thomas Steffen: co-wrote deuglify.el +Thomas Voss: changed which-key.el + Thomas W Murphy: changed outline.el Thomas Wurgler: changed emacs-lock.el subr.el @@ -6323,7 +6328,7 @@ Ulrich Müller: changed configure.ac calc-units.el Makefile.in emacsclient-mail.desktop lib-src/Makefile.in src/Makefile.in version.el bindings.el doctor.el emacs.1 files.el gamegrid.el gud.el language/cyrillic.el server.el strings.texi ChgPane.c ChgSel.c HELLO - INSTALL XMakeAssoc.c and 53 other files + INSTALL XMakeAssoc.c and 54 other files Ulrich Neumerkel: changed xterm.c @@ -6564,6 +6569,9 @@ Xavier Maillard: changed gnus-faq.texi gnus-score.el mh-utils.el spam.el Xiaoyue Chen: changed esh-proc.el +Xie Qi: changed simple.el dired.el customize.texi display.texi + functions.texi keymap.el loading.texi progmodes/python.el xdisp.c + Xi Lu: changed etags.c htmlfontify.el ruby-mode.el CTAGS.good_crlf CTAGS.good_update Makefile TUTORIAL.cn crlf eww.el filesets.el man-tests.el man.el shortdoc.el tramp-sh.el @@ -6641,10 +6649,10 @@ and changed fontset.el message.el nnheader.el nnmail.el Your Name: changed configure.ac Yuan Fu: changed treesit.el treesit.c c-ts-mode.el parsing.texi - progmodes/python.el modes.texi treesit-tests.el js.el indent.erts + treesit-tests.el progmodes/python.el modes.texi js.el indent.erts treesit.h typescript-ts-mode.el c-ts-common.el css-mode.el - java-ts-mode.el print.c rust-ts-mode.el configure.ac sh-script.el - gdb-mi.el go-ts-mode.el lisp.h and 73 other files + java-ts-mode.el rust-ts-mode.el print.c sh-script.el configure.ac + go-ts-mode.el csharp-mode.el gdb-mi.el and 78 other files Yuanle Song: changed rng-xsd.el commit eb18f7288b3817378b98c1b81d723cf4a1b1e4f5 Author: Andrea Corallo Date: Sat Oct 26 11:38:10 2024 +0200 ; * ChangeLog.4: Update. diff --git a/ChangeLog.4 b/ChangeLog.4 index 975750f40cd..282197eaeed 100644 --- a/ChangeLog.4 +++ b/ChangeLog.4 @@ -1,3 +1,934 @@ +2024-10-25 Eli Zaretskii + + Skip *.dylib files in 'loaddefs-generate' + + * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Add .dylib + to extensions of files that are skipped. (Bug#74001) + +2024-10-24 Vincenzo Pupillo + + Highlight namespace name in "use" clause. + + * lisp/progmodes/php-ts-mode.el (php-ts-mode--font-lock-settings): + New rule to highlight namespace name in "use" clause. (Bug#73975) + +2024-10-24 Sean Whitton + + Update special conditionals documentation + + * doc/lispref/control.texi (Conditionals): Document if-let* and + when-let*, not if-let and when-let. Document and-let*. + +2024-10-23 Sean Whitton + + Document and-let* vs. when-let* usage convention + + * lisp/subr.el (and-let*): Document and/and-let* + vs. when/when-let* usage convention (some discussion in + bug#73853). + (when-let*): Add cross-reference to and-let*. + +2024-10-22 Jim Porter + + Fix error when splicing Eshell globs and a glob expands to itself + + This could happen when 'eshell-extended-glob' determines that a "glob" + is not really a glob. This mainly happens for remote file names with a + "~" in them, like "/ssh:remote:~/file.txt". + + * lisp/eshell/em-glob.el (eshell-extended-glob): Return a list when + 'eshell-glob-splice-results' is non-nil. + * test/lisp/eshell/em-glob-tests.el + (em-glob-test/expand/splice-results) + em-glob-test/expand/no-splice-results): Extend tests. + +2024-10-22 Stefan Monnier + + * etc/package-keyring.gpg: Update expiration and add new key + +2024-10-21 Eli Zaretskii + + Avoid crashes when scrolling images under winner-mode + + * src/window.c (window_scroll_pixel_based): Fix calculation of a + window's vscroll. (Bug#73933) + +2024-10-20 Eli Zaretskii + + * src/lread.c (READ_AND_BUFFER): Reject negative chars (bug#73914). + +2024-10-20 Michael Albinus + + * test/Makefile.in: Do not show emacs-module-tests.log by default. + +2024-10-19 Vincenzo Pupillo + + Fix 'php-ts-mode': better indentation and font locking + + Incomplete compound_statement or colon_block (statement-group + without a closing brace or closing keyword) that are not inside + a function or method are not recognized as such by tree-sitter-php. + A new function 'php-ts-mode--open-statement-group-heuristic' + handles this case. Font locking of magic methods and better + support for alternative control structure syntax. + Support for latest grammar version. + * lisp/progmodes/php-ts-mode.el + (php-ts-mode--language-source-alist): Updated grammar version. + (php-ts-mode--possibly-braceless-keyword-re): Regular expression + for braceless keyword. + (php-ts-mode--open-statement-group-heuristic): New function. + (php-ts-mode--parent-html-bol): Use the new function and doc fix. + (php-ts-mode--parent-html-heuristic): Use the new function and doc + fix. + (php-ts-mode--indent-styles): Use the new function and add + 'colon_block' support. + (php-ts-mode--class-magic-methods): New predefined magic methods + list. + (php-ts-mode--test-namespace-name-as-prefix-p): Doc fix. + (php-ts-mode--test-namespace-aliasing-clause-p): Fix the test and + doc. + (php-ts-mode--test-namespace-use-group-clause-p): Doc fix. + (php-ts-mode--test-visibility-modifier-operation-clause-p): New + function for the new asymmetric property visibility feature of + PHP 8.4. + (php-ts-mode--font-lock-settings): Font lock for class magic methods + and alternative syntax. Better font lock for 'instanceof'. Use + 'font-lock-function-call-face' for scoped and member call expression. + (bug#73779) + +2024-10-19 Michael Albinus + + * lisp/auth-source.el (read-passwd): Remove entry from `post-command-hook'. + +2024-10-19 Eli Zaretskii + + New FAQ about Ctrl keys on xterm + + * doc/misc/efaq.texi + (Some Ctrl-modified keys do not work on xterm): New section + (bug#73813). + +2024-10-19 Eli Zaretskii + + Autoload 'message-narrow-to-headers-or-head' in mml.el + + * lisp/gnus/mml.el (message-narrow-to-headers-or-head): Autoload + it. (Bug#73815) + +2024-10-18 Stefan Monnier + + * lisp/emacs-lisp/pcase.el (pcase--make-docstring): Fix bug#73766 + + Do not merge to `master`. + +2024-10-18 Michael Albinus + + Locate password icon in global-mode-string + + * doc/emacs/mini.texi (Passwords): Precise the location of the + password icon. + + * doc/lispref/minibuf.texi (Reading a Password): The password icon + is added to global-mode-string. + + * lisp/auth-source.el (read-passwd--mode-line-buffer): Remove. + (read-passwd--hide-password): Fix docstring. + (read-passwd-toggle-visibility): Don't use + `read-passwd--mode-line-buffer'. Check for `read-passwd-mode'. + Force update in all mode lines. + (read-passwd-mode): Set `read-passwd--mode-line-icon' in + `global-mode-string'. (Bug#73768) + +2024-10-18 Robert Pluim + + Explain tty-color-mode frame parameter more. + + * doc/emacs/cmdargs.texi (Colors X): Explain that tty color + support is dynamic. + * doc/lispref/frames.texi (Font and Color Parameters): Explain + that 'tty-color-mode' can be changed on the fly. + * doc/misc/efaq.texi (Colors on a TTY): Explain how to disable + 'tty-color-mode', either at startup or dynamically. + +2024-10-17 Stefan Monnier + + (track-changes--after): Fix problem found in bug#73041 + + When calling `track-changes--before` (e.g. because of a missing + b-f-c or for some other reason), it sets `track-changes--before-end` + to the right value so we shouldn't increment it right after. + Also, we should update `track-changes--buffer-size` before + calling `track-changes--before` so it doesn't risk signaling + a spurious inconsistency. + + * lisp/emacs-lisp/track-changes.el (track-changes--after): + Update `track-changes--buffer-size` earlier, and don't increment + `track-changes--before-end` when we call `track-changes--before`. + +2024-10-16 Jim Porter + + Fix Eshell's evaluation of empty 'progn' forms + + Do not merge to master. + + * lisp/eshell/esh-cmd.el (eshell-do-eval): Make sure we evaluate to + 'nil' for 'progn' forms with no body (bug#73722). + +2024-10-15 Andrea Corallo + + * lisp/progmodes/c-ts-mode.el (treesit-node-eq): Declare to silence warning. + +2024-10-15 Michael Albinus + + * admin/notes/emba: Docker builds do not run in a worktree. + +2024-10-15 Ulrich Müller + + * lisp/calc/calc-ext.el (math-approx-sqrt-e): Doc fix (bug#73817). + +2024-10-15 Eli Zaretskii + + : Revert a mistaken change + + * lisp/net/dictionary.el (dictionary-word-definition-face): Revert + a mistakenly installed change. + +2024-10-15 Yuan Fu + + Fix c-ts-mode--anchor-prev-sibling (bug#73661) + + * lisp/progmodes/c-ts-mode.el: + (c-ts-mode--anchor-prev-sibling): Fix parentheses and use a + slightly more efficient function. + * test/lisp/progmodes/c-ts-mode-resources/indent.erts: Replace + the tab in the test code with spaces. + +2024-10-14 Earl Hyatt + + Fix formatting of long keyboard macros by 'list-keyboard-macros'. + + * lisp/kmacro.el (kmacro-menu--refresh): Include the second + argument of 'format-kbd-macro' so that the formatted keyboard + macro is on a single line. (Bug#73797) + +2024-10-13 Michael Albinus + + * doc/emacs/mini.texi (Passwords): Mention password visibility. + +2024-10-10 Jørgen Kvalsvik (tiny change) + + Fix c-ts-mode indentation for initializer lists (bug#73661) + + The intentation behavior differed between c-mode/c++-mode + and *-ts-mode for initializer lists where the first element was + not at beginning-of-line. The anchor-prev-sibling function gave + up and returned nil, but it should (probably) anchor on the + first element in the initializer list, such as this: + + return { v1, v2, ..., + y1, y2, ... }; + + c-ts-mode behaved better and figured out how to align, but I + added a test for a similar compound literal to prevent + regressions. + + * lisp/progmodes/c-ts-mode.el (c-ts-mode--anchor-prev-sibling): + Anchor at first sibling unless bol is found. + + * test/lisp/progmodes/c-ts-mode-resources/indent.erts: New + initializer list and compound literal test. + +2024-10-09 Eli Zaretskii + + Avoid segfaults in Rmail-MIME + + Rmail-MIME decodes text of email, including removal of + CR characters, but that can segfault if the text of some + MIME part is empty. + * src/coding.c (decode_coding_raw_text): + * lisp/mail/rmailmm.el (rmail-mime-insert-decoded-text): Don't + attempt to decode empty text region. + +2024-10-09 Brennan Vincent (tiny change) + + Eglot: use :immediate t when resolving completions (bug#73279) + + + * lisp/progmodes/eglot.el (eglot-completion-at-point): Tweak + eglot--request call. + +2024-10-09 João Távora + + Eglot: minor changes to doc and docstrings + + * doc/misc/eglot.texi (Quick Start): Tweak. + (Setting Up LSP Servers): Tweak. + (Customizing Eglot): Clarify eglot-connect-hook and + eglot-initialized-hook. + + * lisp/progmodes/eglot.el (eglot-connect-hook) + (eglot-server-initialized-hook): Rework docstring. + +2024-10-09 Yuan Fu + + Revert "Set treesit-primary-parser for tree-sitter modes" + + This reverts commit ed57faafc74e0810b492841deccb3cdc77a258ff. + +2024-10-08 Yuan Fu + + Remove duplicate indent rules in elixir-ts-mode + + * lisp/progmodes/elixir-ts-mode.el (elixir-ts-mode): There are + two forms adding heex-ts--indent-rules, remove one of them. + +2024-10-08 Yuan Fu + + Set treesit-primary-parser for tree-sitter modes + + I debated whether to do this, since technically speaking it's + not needed for single-language modes. But ultimately it's + better to be explicit and set a good example with builtin modes. + + * lisp/progmodes/cmake-ts-mode.el (cmake-ts-mode): + * lisp/progmodes/csharp-mode.el (csharp-ts-mode): + * lisp/progmodes/dockerfile-ts-mode.el (dockerfile-ts-mode): + * lisp/progmodes/go-ts-mode.el (go-ts-mode): + (go-mod-ts-mode): + * lisp/progmodes/heex-ts-mode.el (heex-ts-mode): + * lisp/progmodes/java-ts-mode.el (java-ts-mode): + * lisp/progmodes/json-ts-mode.el (json-ts-mode): + * lisp/progmodes/lua-ts-mode.el (lua-ts-mode): + * lisp/progmodes/python.el (python-ts-mode): + * lisp/progmodes/ruby-ts-mode.el (ruby-ts-mode): + * lisp/progmodes/rust-ts-mode.el (rust-ts-mode): + * lisp/progmodes/sh-script.el: + * lisp/progmodes/typescript-ts-mode.el (typescript-ts-mode): + (tsx-ts-mode): + * lisp/textmodes/css-mode.el (css-ts-mode): + * lisp/textmodes/html-ts-mode.el (html-ts-mode): + * lisp/textmodes/toml-ts-mode.el (toml-ts-mode): + * lisp/textmodes/yaml-ts-mode.el (yaml-ts-mode): Set + treesit-primary-parser. + +2024-10-06 Stefan Kangas + + Delete XIE X extension from TODO + + According to Wikipedia, XIE "is no longer included in the X11 reference + distribution, having been removed with X11R6.7 in 2004." + Ref: https://en.wikipedia.org/wiki/X_Image_Extension + + * etc/TODO: Delete item to use XIE X extension. + +2024-10-05 Morgan Willcock + + Restore comment/string check for 'electric-layout-mode' + + This reverts an accidental change which allowed + 'electric-layout-mode' to insert newlines inside strings and + comments. The new behavior can be obtained by setting the + new variable 'electric-layout-allow-in-comment-or-string' to a + non-nil value. + * lisp/electric.el (electric-layout-allow-in-comment-or-string): + New variable to determine whether inserting newlines is + permitted within comments or strings. + (electric-layout-post-self-insert-function-1): Restore the + previous default behavior of not inserting newlines within + comments or strings. + +2024-10-05 Stefan Kangas + + Update Arni Magnusson's email address + + * .mailmap: + * doc/lispref/ChangeLog.1: + * doc/misc/ChangeLog.1: + * lisp/ChangeLog.16: + * lisp/ChangeLog.17: + * lisp/progmodes/bat-mode.el: Update email address of + Arni Magnusson. (Bug#73631) + +2024-10-05 Stefan Kangas + + Fix python-ts-mode-map docstring + + * lisp/progmodes/python.el (python-ts-mode-map): Fix docstring. + +2024-10-05 Stefan Kangas + + Normalize "Commentary" section in eudc.el + + * lisp/net/eudc.el: Normalize "Commentary" section to make + 'M-x describe-package RET eudc RET' more useful. + +2024-10-04 Eli Zaretskii + + Expand email abbrevs in X-Debbugs-Cc header. + + * lisp/mail/mailabbrev.el (mail-abbrev-mode-regexp): + * lisp/mail/mailalias.el (mail-address-field-regexp) + (mail-complete-alist): Add "X-Debbugs-Cc" to headers where email + aliases should be expanded, for compatibility with emacsbug.el. + +2024-10-04 Eli Zaretskii + + Fix 'list-tags' when invoked from a non-file buffer + + This use case was broken by the improvement that attempts to + offer the current buffer's file name as the default file whose + tags to list. + * lisp/progmodes/etags.el + (tags--get-current-buffer-name-in-tags-file): Doc fix. Return nil + if no file is associated with the current buffer, and avoid + signaling an error if 'buffer-file-name' returns nil. (Bug#37611) + (list-tags): Doc fix. Signal an error if the user specifies no + file name at the prompt. + + * doc/emacs/maintaining.texi (List Identifiers): Fix wording of + the documentation of 'list-tags'. + +2024-10-04 Sean Whitton + + count-windows: Fix reference to walk-windows + + * lisp/window.el (count-windows): Refer to walk-windows for the + precise meaning of both the MINIBUF and ALL-FRAMES arguments, + not just the ALL-FRAMES argument. In both functions, these + arguments are both passed through to window-list-1. + +2024-10-03 Stefan Kangas + + * lisp/info-look.el (mapc): Add use-package manual's index. + +2024-10-03 Yuan Fu + + Update csharp-ts-mode font-lock (bug#73369) + + Adapt to the latest c-sharp grammar. + + * lisp/progmodes/csharp-mode.el: + (csharp-ts-mode--test-this-expression): + (csharp-ts-mode--test-interpolated-string-text): + (csharp-ts-mode--test-type-constraint): + (csharp-ts-mode--test-type-of-expression): + (csharp-ts-mode--test-name-equals): + (csharp-ts-mode--test-if-directive): + (csharp-ts-mode--test-method-declaration-type-field): New + functions. + (csharp-ts-mode--type-field): New variable. + (csharp-ts-mode--font-lock-settings): Fix font-lock rules. + +2024-10-02 Sean Whitton + + Fix inconsistency in value of rcirc-activity-string + + * lisp/net/rcirc.el (rcirc-update-activity-string): Consistently + don't display anything if there aren't any IRC connections. + +2024-10-02 Stefan Kangas + + Revert "; Minor clarification in variables.texi" + + This reverts commit 44156c2140772fa04ebbc0a488a85f0741e0c2ef. + +2024-10-01 john muhl + + Tag interactive commands in 'lua-ts-mode' + + * lisp/progmodes/lua-ts-mode.el (lua-ts-send-buffer) + (lua-ts-send-file, lua-ts-send-region): Mark inferior interaction + commands that are only relevant in Lua buffers. (Bug#73586) + +2024-10-01 Stefan Kangas + + Mention LSP acronym in eglot defgroup docstring + + * lisp/progmodes/eglot.el (eglot): Improve defgroup description by + mentioning the LSP acronym, for users that might be searching for that. + +2024-10-01 Stefan Kangas + + Change :group of 'eglot' defgroup to 'tools' + + In 'M-x customize', Eglot fits in better in "Programming -> Tools", with + the likes of Flymake and Gud, than it does in "Applications", with ERC + and Newsticker. + + * lisp/progmodes/eglot.el (eglot): Change :group of defgroup to 'tools'. + +2024-09-30 Stefan Kangas + + Remove out-of-date documentation from python.el + + * lisp/progmodes/python.el: Remove out-of-date documentation about + automatic indentation; 'electric-indent-mode' is enabled by default in + Emacs 24.4 or later, so this is no longer an issue. + +2024-09-30 Jim Porter + + Fix executing commands in Eshell using "env" with no local variables + + * lisp/eshell/esh-var.el (eshell/env): Throw 'eshell-replace-command' as + needed. + + * test/lisp/eshell/esh-var-tests.el + (esh-var-test/local-variables/env/no-locals): New test (bug#73479). + +2024-09-29 Gautier Ponsinet + + Fix a typo in the calendar manual + + * doc/emacs/calendar.texi (Calendar Unit Motion): Add a missing + parenthesis. (Bug#73555) + +2024-09-28 Morgan Willcock + + Require ert-x for use by 'ert-font-lock-deftest-file' + + This fixes a void-function error when 'ert-font-lock-deftest-file' + is called when ert-x has not already been loaded. + * lisp/emacs-lisp/ert-font-lock.el (ert): Require ert-x so that + 'ert-resource-file' is available for use within + 'ert-font-lock-deftest-file'. (Bug#73254) + +2024-09-28 Vincenzo Pupillo + + Fix php-ts-mode font-lock for latest PHP grammar (bug#73516) + + Version 0.23 of the PHP grammar introduced some changes that + affect the font lock. + + * lisp/progmodes/php-ts-mode.el + (php-ts-mode--language-source-alist): Update php, html, js and css + grammars version. + (php-ts-mode--parent-html-heuristic): Fix docstring + (php-ts-mode--test-namespace-name-as-prefix-p): New function. + (php-ts-mode--test-namespace-aliasing-clause-p): New function. + (php-ts-mode--test-namespace-use-group-clause-p): New function. + (php-ts-mode--font-lock-settings): Use the new functions. + +2024-09-27 Stefan Monnier + + eieio.texi: Fix bug#73505 + + * doc/misc/eieio.texi (Introduction): Remove "missing features" which + aren't missing any more. + (Generics, Methods): Delete sections. + (Inheritance): Adjust reference accordingly. + (Static Methods): Merge into the parent node. + (Writing Methods): Refer to the ELisp manual for `cl-defmethod/defgeneric`. + +2024-09-26 Andrés Ramírez (tiny change) + + Delete duplicated line in Viper refcard + + * etc/refcards/viperCard.tex: Delete duplicated line. (Bug#73480) + +2024-09-25 Michael Albinus + + Fix Tramp shortdoc integration + + * lisp/net/tramp-integration.el (tramp-syntax): Declare. + (shortdoc): Check, that Tramp has `default' syntax. + +2024-09-25 Juri Linkov + + * lisp/imenu.el (imenu-flatten): More limitations in docstring (bug#73117) + +2024-09-25 Sean Whitton + + remember-data-file: Don't unconditionally call set-visited-file-name + + * lisp/textmodes/remember.el (remember-data-file): Don't + unconditionally call set-visited-file-name. + +2024-09-25 Thomas Voss (tiny change) + + Align columns in which-key with wide characters properly + + In the case that a character takes up multple columns (such as + `…' when used as a truncation character), make sure that the + columns are still aligned properly. + * lisp/which-key.el (which-key--pad-column): Use `string-width' + instead of `length'. (Bug#73463) + +2024-09-25 Roland Winkler + + bibtex-mode: fix patch bibtex validation for non-file buffers + +2024-09-24 Robert Pluim + + Document 'buttonize-region' in manual + + It was added in emacs-29, but never added to the lisp reference + manual. + + * doc/lispref/display.texi (Making Buttons): Document + 'buttonize-region'. + +2024-09-24 Tassilo Horn + + Use black-on-white by default for doc-view-svg-face. + + * lisp/doc-view.el (doc-view-svg-face): Define black on white as + default value instead of using the current theme's values. + * etc/NEWS: Adjust entry for doc-view-svg-face. + +2024-09-23 Dmitry Gutov + + etags-regen-file-extensions: Enable for more extensions + + * lisp/progmodes/etags-regen.el (etags-regen-file-extensions): + Add more extensions, but remove "a". From the ones recognized by + etags, also omit "t", "ml", "l", "def" and "inc", see + https://lists.gnu.org/archive/html/emacs-devel/2024-09/msg00735.html. + (etags-regen--all-files): Use 'string-match-p' for performance. + Bind 'case-fold-search' to t to match extensions in any case. + +2024-09-21 Stephen Berman + + Update and improve UI of sql-read-product (bug#73412) + + * lisp/progmodes/sql.el (sql-read-product): In invocation of + completing-read use format-prompt and make deprecated argument + INITIAL-INPUT nil. + (sql-set-product, sql-product-interactive): In invocation of + sql-read-product adjust prompt to use of format-prompt. + +2024-09-21 Philip Kaludercic + + Insert correct commit data into VC package descriptions + + * lisp/emacs-lisp/package-vc.el (package-vc-commit): Rename + argument from PKG to PKG-DESC. + (package-vc--generate-description-file): Update the "extras" + section of the package description with the revision string at + generation time. + +2024-09-21 Stefan Kangas + + Document reporting security issues in user manual + + * doc/emacs/trouble.texi (Bugs): Document how to report important + security issues. + +2024-09-21 Stefan Kangas + + * BUGS: Minor copy edit. + +2024-09-21 Stefan Monnier + + Fix font-lock of last character before EOB under 'whitespace-mode' + + * lisp/whitespace.el (whitespace-color-on): Don't use OVERRIDE in + font-lock-keywords; instead, use 'prepend' in the call to + 'font-lock-add-keywords'. (Bug#73332) + +2024-09-21 Eli Zaretskii + + Fix 'whitespace-mode' with 'missing-newline-at-eof' + + * lisp/whitespace.el (whitespace-post-command-hook): Refontify + when point moves if 'missing-newline-at-eof' is in + 'whitespace-active-style'. (Bug#73332) + +2024-09-21 Eli Zaretskii + + Fix 'replace-regexp' in WDired + + * src/search.c (Freplace_match): Revert the search.c part of the + change from Apr 7, 2024, which aims to fix bug#65451, but causes + bug#73018. Do not merge to master. + + * test/src/editfns-tests.el + (editfns-tests--before/after-change-functions): Expect this test + to fail. + +2024-09-21 Peter Oliver + + Disable xwidgets with recent webkitgtk versions (Bug#66068) + + * configure.ac: Accept only webkit2gtk-4.* versions less than 2.41.92. + +2024-09-21 Yuan Fu + + Fix treesit--merge-ranges (bug#73324) + + * lisp/treesit.el (treesit--merge-ranges): Make sure that old + ranges that intersects with START-END are actually discarded. + * test/src/treesit-tests.el (treesit-range-merge): New test. + +2024-09-21 Stefan Kangas + + Fix midnight-mode documentation + + * lisp/midnight.el (Commentary): Document that 'midnight-mode' should be + enabled using the function, instead of by merely loading the library. + In Emacs 31, doing the latter will no longer work. (Bug#73291) + +2024-09-20 Stefan Monnier + + editorconfig.el: Fix too naive sync from upstream + + * lisp/editorconfig.el (editorconfig--get-indentation-nxml-mode): + New function. + (editorconfig-indentation-alist): Use it to fix bug#73359. + +2024-09-20 Stefan Monnier + + * lisp/progmodes/eglot.el (eglot--signal-textDocument/didOpen): Fix bug#72696 + +2024-09-20 Po Lu + + Disable fontset-related workaround on non-Android systems + + * src/fontset.c (fontset_find_font) [!HAVE_ANDROID]: Don't + refuse to cache font objects whose registries do not agree with + the font specs. (bug#73363) + + Do not merge to master. + +2024-09-20 Sean Whitton + + etags-regen-file-extensions: Add .pm + + * lisp/progmodes/etags-regen.el (etags-regen-file-extensions): + Add .pm. + +2024-09-19 Andrea Corallo + + * src/treesit.c (treesit_debug_print_parser_list): Fix compiler warning. + +2024-09-19 Robert Pluim + + Type-check argument to network-lookup-address-info + + * src/process.c (Fnetwork_lookup_address_info): Check that the + "name" argument is a string, and mention 'puny-encode-domain'. + (Bug#73337) + +2024-09-18 Yuan Fu + + Conservative heuristic for tree-sitter parser ranges (bug#73324) + + * src/treesit.c (treesit_sync_visible_region): If the parser's original + ranges don't overlap with visible region, give it a zero range, rather + than don't set any range. + * test/src/treesit-tests.el (treesit-range-fixup-after-edit): Test new + behavior. + +2024-09-17 Mattias Engdegård + + Re-enable GC mark trace buffer by default + + Enable GC_REMEMBER_LAST_MARKED by default (it was disabled in Emacs 29) + to make it easier to debug difficult-to-reproduce GC problems + encountered by users. This increases GC costs by about 5 %, which can + be avoided by turning the mark trace buffer back off using the new + --disable-gc-mark-trace option. + + See discussion at + https://lists.gnu.org/archive/html/emacs-devel/2024-09/msg00240.html + + * configure.ac (--disable-gc-mark-trace): New config option. + * etc/NEWS: Mention it. + * src/alloc.c: Enable it by default and avoid a compiler warning. + +2024-09-15 Yuan Fu + + Fix treesit_sync_visible_region's range fixup code (bug#73264) + + new_ranges_head + | + v + ( )->( )->( )->( )->( ) + ^ ^ + | | + | lisp_ranges (loop head) + | + prev_cons -> set cdr to nil to cut of the rest + + result: + + ( )->( ) + + * src/treesit.c (treesit_sync_visible_region): Cut off this cons and the + rest, not set the current range's end to nil. + * test/src/treesit-tests.el: + (treesit-range-fixup-after-edit): Add tests for all cases. + +2024-09-15 Po Lu + + Document unavailability of frame geometry on Wayland + + * etc/PROBLEMS (Runtime problems specific to PGTK build): + Document that frame-edges and company are liable not to return + valid coordinates. (bug#73207) + +2024-09-15 Po Lu + + Port to Haiku R1/beta5 + + * src/haiku_support.cc (keysym_from_raw_char): Use revised names + for B_HANGUL and B_HANGUL_HANJA. + +2024-09-14 Yuan Fu + + Fix c++-ts-mode font-lock for latest c++ grammar (bug#73191) + + * lisp/progmodes/c-ts-mode.el: + (c-ts-mode--keywords): Add "thread_local" keyword. + (c-ts-mode--test-virtual-named-p): New function. + (c-ts-mode--font-lock-settings): Use named/anonymous "virtual" depending + on the grammar. + +2024-09-14 Stefan Kangas + + * admin/update-copyright: Print reminder to do manual updates. + + * admin/notes/years: Update. + +2024-09-14 Stefan Kangas + + * etc/TODO: New item "support indentation guides". + + Ref: + https://lists.gnu.org/r/emacs-devel/2024-07/msg01062.html + +2024-09-14 Stephen Berman + + Fix regression in widget-move (bug#72995) + + * lisp/wid-edit.el (widget-move): Avoid advancing point only if it + is at the start of a widget at BOB. + + * test/lisp/wid-edit-tests.el (widget-test-widget-move-bug72995): New test. + +2024-09-14 Spencer Baugh + + Correctly include fixed strings before a prefix wildcard in PCM + + In 03ac16ece40ba3e3ba805d6a61cc457d84bf3792 I fixed a bug with the + PCM implementation of substring completion, relating to the handling + of PCM wildcards. + However, this fix was incomplete. This change completes the fix by + also including a fixed string if it appears before a 'prefix' + wildcard, even if 'try-completion' doesn't discover that fixed + string grows to a unique completion. + I discovered this bug while working on enhancements to PCM + completion related to 'completion-pcm-leading-wildcard'. + * lisp/minibuffer.el (completion-pcm--merge-completions): Include + fixed strings before 'prefix wildcard. (Bug#72819) + * test/lisp/minibuffer-tests.el (completion-substring-test-5): Add a + test for this behavior. + +2024-09-14 Yuan Fu + + Set treesit-primary-parser for c and elixir ts mode + + For buffers with multiple parsers, it's important to set this variable + so font-lock invalidation works smoothly. + + * lisp/progmodes/c-ts-mode.el (c-ts-mode): Set treesit-primary-parser. + * lisp/progmodes/elixir-ts-mode.el (elixir-ts-mode): Set + treesit-primary-parser. + +2024-09-14 Yuan Fu + + Fix range handling so it works for multibyte buffer (bug#73204) + + Here by multibyte buffer I mean buffer that includes non-ASCII + characters. + + The problem is illustrated by this comment, which I copied from the + source: + + ====================================================================== + (ref:bytepos-range-pitfall) Suppose we have the following buffer + content ([ ] is a unibyte char, [ ] is a multibyte char): + + [a][b][c][d][e][ f ] + + and the following ranges (denoted by braces): + + [a][b][c][d][e][ f ] + { }{ } + + So far so good, now user deletes a unibyte char at the beginning: + + [b][c][d][e][ f ] + { }{ } + + Oops, now our range cuts into the multibyte char, bad! + ====================================================================== + + * src/treesit.c (treesit_debug_print_parser_list): Minor fix. + (treesit_sync_visible_region): Change the way we fixup ranges, instead + of using the bytepos ranges from tree-sitter, we use the cached lisp + charpos ranges. + (treesit_make_ts_ranges): New function. + (Ftreesit_parser_set_included_ranges): Refactor out the new function + treesit_make_ts_ranges. + (Ftreesit_parser_included_ranges): Rather than getting the ranges from + tree-sitter, just return the cached lisp ranges. + + * src/treesit.h (Lisp_TS_Parser): Add some comment. + * test/src/treesit-tests.el (treesit-range-fixup-after-edit): New test. + +2024-09-14 Yuan Fu + + Revert "Read more on each call to treesit's buffer reader" + + This reverts commit bf23382f1f2d6ea072db4e4750f8a345f77a3ef2. + + We move around the gap, narrow regions, ralloc, etc, and don't have a + way to invalidate previously given range. So tree-sitter can't be given + the full range. + +2024-09-14 Yuan Fu + + Fix tree-sitter indent preset prev-adaptive-prefix + + * lisp/treesit.el (treesit-simple-indent-presets): Use looking-at so the + call to match-string has the match data to work with. + +2024-09-13 Robert Pluim + + Improve NEWS entries + + * etc/NEWS: Fix typos, and add information about default values of new + user options. + +2024-09-13 Mattias Engdegård + + Don't fail uniquify-tests in non-version-controlled source trees + + * test/lisp/uniquify-tests.el (uniquify-project-transform): + Skip test if there is no project (bug#73205). + +2024-09-13 Stefan Kangas + + * doc/misc/auth.texi: Minor copy edits. + +2024-09-12 Po Lu + + Fix bug#72254 + + * src/pgtkselect.c (Fpgtk_get_selection_internal): If requesting + TARGETS with just one result, return it as a vector. + (bug#72254) + +2024-09-11 Andrea Corallo + + Bump Emacs version to 30.0.91 + + * nt/README.W32: Update Emacs version. + * msdos/sed2v2.inp: Likewise. + * exec/configure.ac: Likewise. + * configure.ac: Likewise. + * README: Likewise. + 2024-09-11 Yuan Fu Fix heex-ts-mode indentation following previews elixir-mode change @@ -200709,7 +201640,7 @@ This file records repository revisions from commit f2ae39829812098d8269eafbc0fcb98959ee5bb7 (exclusive) to -commit ee3e3a6311196129104881d6e9097bb54d8843af (inclusive). +commit 8e37b537160c1560048ac53529ef09de7561963c (inclusive). See ChangeLog.3 for earlier changes. ;; Local Variables: commit 2a6af880b0958d527a4d32005ef9acf3bc4ea030 Author: Eli Zaretskii Date: Sat Oct 26 09:05:10 2024 +0300 ; * lisp/emacs-lisp/cond-star.el: Require cl-lib. diff --git a/lisp/emacs-lisp/cond-star.el b/lisp/emacs-lisp/cond-star.el index 4cd8b9fd0fc..0e4718f088d 100644 --- a/lisp/emacs-lisp/cond-star.el +++ b/lisp/emacs-lisp/cond-star.el @@ -38,6 +38,8 @@ ;;; Code: +(require 'cl-lib) ; for cl-assert + (defmacro cond* (&rest clauses) "Extended form of traditional Lisp `cond' construct. A `cond*' construct is a series of clauses, and a clause commit 4b9daca842419f94226d40adc9f7844d18dfffa9 Author: Sean Whitton Date: Sat Oct 26 11:15:25 2024 +0800 ; Reformat a couple of recently added long strings * lisp/vc/vc-git.el (vc-git--assert-allowed-rewrite) (vc-git-modify-change-comment): Reformat long strings by prefixing an escaped newline. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index ff0bc68e2d4..2702203a371 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1981,9 +1981,11 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (unless (or (cl-member rev outgoing :test #'string-prefix-p) (and (eq vc-allow-rewriting-published-history 'ask) (yes-or-no-p - (format "Commit %s appears published; allow rewriting history?" + (format "\ +Commit %s appears published; allow rewriting history?" rev)))) - (user-error "Will not rewrite likely-public history; see option `vc-allow-rewriting-published-history'"))))) + (user-error "\ +Will not rewrite likely-public history; see option `vc-allow-rewriting-published-history'"))))) (defun vc-git-modify-change-comment (files rev comment) (vc-git--assert-allowed-rewrite rev) @@ -2024,8 +2026,8 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." "log" "--oneline" "-E" "--grep" "^(squash|fixup|amend)! " (format "%s~1.." rev)))) - (not (yes-or-no-p -"Rebase may --autosquash your other squash!/fixup!/amend!; proceed?"))) + (not (yes-or-no-p "\ +Rebase may --autosquash your other squash!/fixup!/amend!; proceed?"))) (user-error "Aborted")) (when msg-file commit d44b94a63d2d407fca5d5ec41fcb92d7b765972e Author: Stefan Monnier Date: Fri Oct 25 22:26:06 2024 -0400 cond*: Add support for Pcase patterns * lisp/emacs-lisp/cond-star.el (cond*): Adjust docstring. (match*): Prefer `_VAR` syntax. (cond*-convert-condition): Add support for `pcase*`. * doc/lispref/control.texi (cond* Macro): Document `pcase*`. * test/lisp/emacs-lisp/cond-star-tests.el: New file. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index b996a372e28..6ad8a779d17 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -1452,12 +1452,15 @@ of the clause. As a condition, it counts as true if the first binding's value is non-@code{nil}. @findex match* +@findex pcase* @code{(match* @var{pattern} @var{datum})} means to match @var{datum} against the specified @var{pattern}. The condition counts as true if @var{pattern} matches @var{datum}. The pattern can specify variables to bind to the parts of @var{datum} that they match. +@code{(pcase* @var{pattern} @var{datum})} works in the same way except it +uses the Pcase syntax for @var{pattern}. -Both @code{bind*} and @code{match*} normally bind their bindings over +@code{bind*}, @code{match*}, and @code{pcase*} normally bind their bindings over the execution of the whole containing clause. However, if the clause is written to specify ``non-exit'', the clause's bindings cover the whole rest of the @code{cond*}. @@ -1475,6 +1478,10 @@ next clause (if any). The bindings made in @var{condition} for the @var{body} of the non-exit clause are passed along to the rest of the clauses in this @code{cond*} construct. +Note: @code{pcase*} does not support @code{:non-exit}, and when used in +a non-exit clause, it follows the semantics of @code{pcase-let}, see +@ref{Destructuring with pcase Patterns}. + @subheading Matching clauses A matching clause looks like @code{(match* @var{pattern} @var{datum})}. @@ -1482,7 +1489,7 @@ It evaluates the expression @var{datum} and matches the pattern @var{pattern} (which is not evaluated) against it. @var{pattern} allows these kinds of patterns, and those that are lists -often include other patters within them: +often include other patterns within them: @table @code @item _ diff --git a/etc/NEWS b/etc/NEWS index 18b6678dce9..a00536607da 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -741,12 +741,14 @@ text "covered" by the overlay. +++ ** New macro 'cond*'. -The new macro 'cond*' is an alternative to 'pcase'. Like 'pcase', it -can be used to define several clauses, each one with its own condition; -the first clause that matches will cause its body to be evaluated. -'cond*' uses syntax that is different from that of 'pcase', which some -users might find less cryptic. See the Info node "(elisp) cond* Macro" -for details. +The new macro 'cond*' is an alternative to 'cond' and 'pcase'. +Like them, it can be used to define several clauses, each one with its +own condition; the first clause that matches will cause its body to be +evaluated. +'cond*' can use Pcase's pattern matching syntax and also provides +another pattern matching syntax that is different from that of 'pcase', +which some users might find less cryptic. +See the Info node "(elisp) cond* Macro" for details. --- ** New function 'shell-command-do-open'. diff --git a/lisp/emacs-lisp/cond-star.el b/lisp/emacs-lisp/cond-star.el index 9495ad96a6c..4cd8b9fd0fc 100644 --- a/lisp/emacs-lisp/cond-star.el +++ b/lisp/emacs-lisp/cond-star.el @@ -31,10 +31,10 @@ ;; and, or, if, progn, let, let*, setq. ;; For regexp matching only, it can call string-match and match-string. -;;; ??? If a clause starts with a keyword, -;;; should the element after the keyword be treated in the usual way -;;; as a pattern? Currently `cond*-non-exit-clause-substance' explicitly -;;; prevents that by adding t at the front of its value. +;; ??? If a clause starts with a keyword, +;; should the element after the keyword be treated in the usual way +;; as a pattern? Currently `cond*-non-exit-clause-substance' explicitly +;; prevents that by adding t at the front of its value. ;;; Code: @@ -44,15 +44,20 @@ A `cond*' construct is a series of clauses, and a clause normally has the form (CONDITION BODY...). CONDITION can be a Lisp expression, as in `cond'. -Or it can be `(bind* BINDINGS...)' or `(match* PATTERN DATUM)'. +Or it can be one of `(pcase* PATTERN DATUM)', +`(bind* BINDINGS...)', or `(match* PATTERN DATUM)', + +`(pcase* PATTERN DATUM)' means to match DATUM against the +pattern PATTERN, using the same pattern syntax as `pcase'. +The condition counts as true if PATTERN matches DATUM. `(bind* BINDINGS...)' means to bind BINDINGS (as if they were in `let*') for the body of the clause. As a condition, it counts as true if the first binding's value is non-nil. All the bindings are made unconditionally for whatever scope they cover. -`(match* PATTERN DATUM)' means to match DATUM against the pattern PATTERN -The condition counts as true if PATTERN matches DATUM. +`(match* PATTERN DATUM)' is an alternative to `pcase*' that uses another +syntax for its patterns, see `match*'. When a clause's condition is true, and it exits the `cond*' or is the last clause, the value of the last expression @@ -70,7 +75,7 @@ are passed along to the rest of the clauses in this `cond*' construct. \\[match*\\] for documentation of the patterns for use in `match*'." (cond*-convert clauses)) -(defmacro match* (pattern datum) +(defmacro match* (pattern _datum) "This specifies matching DATUM against PATTERN. It is not really a Lisp function, and it is meaningful only in the CONDITION of a `cond*' clause. @@ -133,7 +138,7 @@ ATOM (meaning any other kind of non-list not described above) \(constrain SYMBOL EXP) matches datum if the form EXP is true. EXP can refer to symbols bound earlier in the pattern." - (ignore datum) + ;; FIXME: `byte-compile-warn-x' is not necessarily defined here. (byte-compile-warn-x pattern "`match*' used other than as a `cond*' condition")) (defun cond*-non-exit-clause-p (clause) @@ -245,8 +250,8 @@ This is used for conditional exit clauses." ;; Then always go on to run the UNCONDIT-CLAUSES. (if true-exps `(let ((,init-gensym ,first-value)) -;;; ??? Should we make the bindings a second time for the UNCONDIT-CLAUSES. -;;; as the doc string says, for uniformity with match*? +;;; ??? Should we make the bindings a second time for the UNCONDIT-CLAUSES. +;;; as the doc string says, for uniformity with match*? (let* ,mod-bindings (when ,init-gensym . ,true-exps) @@ -262,6 +267,24 @@ This is used for conditional exit clauses." (let* ,mod-bindings (when ,init-gensym . ,true-exps))))))) + ((eq pat-type 'pcase*) + (if true-exps + (progn + (when uncondit-clauses + ;; FIXME: This happens in cases like + ;; (cond* ((match* `(,x . ,y) EXP) THEN :non-exit) + ;; (t ELSE)) + ;; where ELSE is supposed to run after THEN also (and + ;; with access to `x' and `y'). + (error ":non-exit not supported with `pcase*'")) + (cl-assert (or (null iffalse) rest)) + `(pcase ,(nth 2 condition) + (,(nth 1 condition) ,@true-exps) + (_ ,iffalse))) + (cl-assert (null iffalse)) + (cl-assert (null rest)) + `(pcase-let ((,(nth 1 condition) ,(nth 2 condition))) + (cond* . ,uncondit-clauses)))) ((eq pat-type 'match*) (cond*-match condition true-exps uncondit-clauses iffalse)) (t @@ -369,11 +392,11 @@ as in `cond*-condition'." ;; because they are all gensyms anyway. (if (cdr backtrack-aliases) (setq expression - `(let ,(mapcar 'cdr (cdr backtrack-aliases)) + `(let ,(mapcar #'cdr (cdr backtrack-aliases)) ,expression))) (if retrieve-value-swap-outs (setq expression - `(let ,(mapcar 'cadr retrieve-value-swap-outs) + `(let ,(mapcar #'cadr retrieve-value-swap-outs) ,expression))) ;; If we used a gensym, wrap on code to bind it. (if gensym @@ -397,8 +420,8 @@ This is used for the bindings specified explicitly in match* patterns." (defvar cond*-debug-pattern nil) -;;; ??? Structure type patterns not implemented yet. -;;; ??? Probably should optimize the `nth' calls in handling `list'. +;; ??? Structure type patterns not implemented yet. +;; ??? Probably should optimize the `nth' calls in handling `list'. (defun cond*-subpat (subpat cdr-ignore bindings inside-or backtrack-aliases data) "Generate code to match the subpattern within `match*'. @@ -486,7 +509,7 @@ whether SUBPAT (as well as the subpatterns that contain/precede it) matches," (unless (symbolp elt) (byte-compile-warn-x vars "Non-symbol %s given as name for matched substring" elt))) ;; Bind these variables to nil, before the pattern. - (setq bindings (nconc (mapcar 'list vars) bindings)) + (setq bindings (nconc (mapcar #'list vars) bindings)) ;; Make the expressions to set the variables. (setq setqs (mapcar (lambda (var) diff --git a/test/lisp/emacs-lisp/cond-star-tests.el b/test/lisp/emacs-lisp/cond-star-tests.el new file mode 100644 index 00000000000..7cf0a99f8db --- /dev/null +++ b/test/lisp/emacs-lisp/cond-star-tests.el @@ -0,0 +1,53 @@ +;;; cond-star-tests.el --- tests for emacs-lisp/cond-star.el -*- lexical-binding:t -*- + +;; Copyright (C) 2024 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 GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'cond-star) +(require 'ert) + +(ert-deftest cond-star-test-1 () + (should (equal (cond* + ((pcase* `(,x . ,y) (cons 5 4)) (list x y)) + (t 6)) + '(5 4))) + (should (equal (cond* + ((pcase* `(,x . ,y) nil) (list x y)) + (t 6)) + 6)) + ;; FIXME: Not supported. + ;; (let* ((z nil) + ;; (res (cond* + ;; ((pcase* `(,x . ,y) (cons 5 4)) (setq z 6) :non-exit) + ;; (t `(,x ,y ,z))))) + ;; (should (equal res '(5 4 6)))) + (should (equal (cond* + ((pcase* `(,x . ,y) (cons 5 4))) + (t (list x y))) + '(5 4))) + (should (equal (cond* + ((pcase* `(,x . ,y) nil)) + (t (list x y))) + '(nil nil))) + ) + + +;;; cond-star-tests.el ends here commit 574e97575f4331f43fc079b3bfa6d74213bc2559 Author: Po Lu Date: Sat Oct 26 08:39:24 2024 +0800 ; Fix coding style of Uniscribe files * src/w32dwrite.c (EMACS_DWRITE_UNUSED, IDWriteFontFaceVtbl) (IDWriteFontFace, IDWriteRenderingParamsVtbl) (IDWriteRenderingParams, IDWriteFontVtbl, IDWriteFont) (IDWriteBitmapRenderTargetVtbl, IDWriteBitmapRenderTarget) (IDWriteBitmapRenderTarget1, IDWriteGdiInteropVtbl) (IDWriteGdiInterop, IDWriteFactoryVtbl, IDWriteFactory) (IDWriteColorGlyphRunEnumeratorVtbl) (IDWriteColorGlyphRunEnumerator, IDWriteFactory2Vtbl) (IDWriteFactory2, get_font_face, text_extents_internal) (w32_initialize_direct_write, w32_dwrite_draw) (w32_use_direct_write): * src/w32font.c (w32font_text_extents, w32font_draw): * src/w32uniscribe.c (uniscribe_open): Correct coding style. diff --git a/src/w32dwrite.c b/src/w32dwrite.c index 1ca965fe374..ecc33af5f3f 100644 --- a/src/w32dwrite.c +++ b/src/w32dwrite.c @@ -56,7 +56,7 @@ along with GNU Emacs. If not, see . */ we don't use are declared with the EMACS_DWRITE_UNUSED macro, to avoid bringing in more types that would need to be declared. */ -#define EMACS_DWRITE_UNUSED(name) void (STDMETHODCALLTYPE *name)(void) +#define EMACS_DWRITE_UNUSED(name) void (STDMETHODCALLTYPE *name) (void) #define DWRITE_E_NOCOLOR _HRESULT_TYPEDEF_(0x8898500CL) @@ -125,9 +125,12 @@ typedef interface IDWriteBitmapRenderTarget IDWriteBitmapRenderTarget; typedef interface IDWriteBitmapRenderTarget1 IDWriteBitmapRenderTarget1; typedef interface IDWriteColorGlyphRunEnumerator IDWriteColorGlyphRunEnumerator; -DEFINE_GUID(IID_IDWriteBitmapRenderTarget1, 0x791e8298, 0x3ef3, 0x4230, 0x98,0x80, 0xc9,0xbd,0xec,0xc4,0x20,0x64); -DEFINE_GUID(IID_IDWriteFactory2, 0x0439fc60, 0xca44, 0x4994, 0x8d,0xee, 0x3a,0x9a,0xf7,0xb7,0x32,0xec); -DEFINE_GUID(IID_IDWriteFactory, 0xb859ee5a, 0xd838, 0x4b5b, 0xa2,0xe8, 0x1a,0xdc,0x7d,0x93,0xdb,0x48); +DEFINE_GUID (IID_IDWriteBitmapRenderTarget1, 0x791e8298, 0x3ef3, 0x4230, 0x98, + 0x80, 0xc9, 0xbd, 0xec, 0xc4, 0x20, 0x64); +DEFINE_GUID (IID_IDWriteFactory2, 0x0439fc60, 0xca44, 0x4994, 0x8d, 0xee, + 0x3a, 0x9a, 0xf7, 0xb7, 0x32, 0xec); +DEFINE_GUID (IID_IDWriteFactory, 0xb859ee5a, 0xd838, 0x4b5b, 0xa2, 0xe8, 0x1a, + 0xdc, 0x7d, 0x93, 0xdb, 0x48); typedef struct DWRITE_GLYPH_OFFSET { FLOAT advanceOffset; @@ -168,14 +171,14 @@ typedef struct IDWriteFontFaceVtbl { HRESULT (STDMETHODCALLTYPE *QueryInterface) (IDWriteFontFace *This, REFIID riid, void **ppvObject); - ULONG (STDMETHODCALLTYPE *AddRef)(IDWriteFontFace *This); - ULONG (STDMETHODCALLTYPE *Release)(IDWriteFontFace *This); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteFontFace *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteFontFace *This); - EMACS_DWRITE_UNUSED(GetType); - EMACS_DWRITE_UNUSED(GetFiles); - EMACS_DWRITE_UNUSED(GetIndex); - EMACS_DWRITE_UNUSED(GetSimulations); - EMACS_DWRITE_UNUSED(IsSymbolFont); + EMACS_DWRITE_UNUSED (GetType); + EMACS_DWRITE_UNUSED (GetFiles); + EMACS_DWRITE_UNUSED (GetIndex); + EMACS_DWRITE_UNUSED (GetSimulations); + EMACS_DWRITE_UNUSED (IsSymbolFont); void (STDMETHODCALLTYPE *GetMetrics) (IDWriteFontFace *This, DWRITE_FONT_METRICS *metrics); @@ -207,7 +210,7 @@ typedef struct IDWriteFontFaceVtbl { } IDWriteFontFaceVtbl; interface IDWriteFontFace { - CONST_VTBL IDWriteFontFaceVtbl* lpVtbl; + CONST_VTBL IDWriteFontFaceVtbl *lpVtbl; }; typedef struct IDWriteRenderingParamsVtbl { @@ -215,8 +218,8 @@ typedef struct IDWriteRenderingParamsVtbl { HRESULT (STDMETHODCALLTYPE *QueryInterface) (IDWriteRenderingParams *This, REFIID riid, void **ppvObject); - ULONG (STDMETHODCALLTYPE *AddRef)(IDWriteRenderingParams *This); - ULONG (STDMETHODCALLTYPE *Release)(IDWriteRenderingParams *This); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteRenderingParams *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteRenderingParams *This); FLOAT (STDMETHODCALLTYPE *GetGamma) (IDWriteRenderingParams *This); @@ -230,7 +233,7 @@ typedef struct IDWriteRenderingParamsVtbl { } IDWriteRenderingParamsVtbl; interface IDWriteRenderingParams { - CONST_VTBL IDWriteRenderingParamsVtbl* lpVtbl; + CONST_VTBL IDWriteRenderingParamsVtbl *lpVtbl; }; typedef struct IDWriteFontVtbl { @@ -238,8 +241,8 @@ typedef struct IDWriteFontVtbl { HRESULT (STDMETHODCALLTYPE *QueryInterface) (IDWriteFont *This, REFIID riid, void **ppvObject); - ULONG (STDMETHODCALLTYPE *AddRef)(IDWriteFont *This); - ULONG (STDMETHODCALLTYPE *Release)(IDWriteFont *This); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteFont *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteFont *This); EMACS_DWRITE_UNUSED (GetFontFamily); EMACS_DWRITE_UNUSED (GetWeight); @@ -253,7 +256,7 @@ typedef struct IDWriteFontVtbl { void (STDMETHODCALLTYPE *GetMetrics) (IDWriteFont *This, DWRITE_FONT_METRICS *metrics); - EMACS_DWRITE_UNUSED(HasCharacter); + EMACS_DWRITE_UNUSED (HasCharacter); HRESULT (STDMETHODCALLTYPE *CreateFontFace) (IDWriteFont *This, IDWriteFontFace **face); @@ -262,7 +265,7 @@ typedef struct IDWriteFontVtbl { } IDWriteFontVtbl; interface IDWriteFont { - CONST_VTBL IDWriteFontVtbl* lpVtbl; + CONST_VTBL IDWriteFontVtbl *lpVtbl; }; typedef struct IDWriteBitmapRenderTargetVtbl { @@ -270,8 +273,8 @@ typedef struct IDWriteBitmapRenderTargetVtbl { HRESULT (STDMETHODCALLTYPE *QueryInterface) (IDWriteBitmapRenderTarget *This, REFIID riid, void **ppvObject); - ULONG (STDMETHODCALLTYPE *AddRef)(IDWriteBitmapRenderTarget *This); - ULONG (STDMETHODCALLTYPE *Release)(IDWriteBitmapRenderTarget *This); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteBitmapRenderTarget *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteBitmapRenderTarget *This); HRESULT (STDMETHODCALLTYPE *DrawGlyphRun) (IDWriteBitmapRenderTarget *This, @@ -283,7 +286,7 @@ typedef struct IDWriteBitmapRenderTargetVtbl { COLORREF textColor, RECT *blackbox_rect); - HDC (STDMETHODCALLTYPE *GetMemoryDC)(IDWriteBitmapRenderTarget *This); + HDC (STDMETHODCALLTYPE *GetMemoryDC) (IDWriteBitmapRenderTarget *This); EMACS_DWRITE_UNUSED (GetPixelsPerDip); @@ -298,7 +301,7 @@ typedef struct IDWriteBitmapRenderTargetVtbl { } IDWriteBitmapRenderTargetVtbl; interface IDWriteBitmapRenderTarget { - CONST_VTBL IDWriteBitmapRenderTargetVtbl* lpVtbl; + CONST_VTBL IDWriteBitmapRenderTargetVtbl *lpVtbl; }; typedef struct IDWriteBitmapRenderTarget1Vtbl { @@ -326,7 +329,7 @@ typedef struct IDWriteBitmapRenderTarget1Vtbl { } IDWriteBitmapRenderTarget1Vtbl; interface IDWriteBitmapRenderTarget1 { - CONST_VTBL IDWriteBitmapRenderTarget1Vtbl* lpVtbl; + CONST_VTBL IDWriteBitmapRenderTarget1Vtbl *lpVtbl; }; typedef struct IDWriteGdiInteropVtbl { @@ -334,8 +337,8 @@ typedef struct IDWriteGdiInteropVtbl { HRESULT (STDMETHODCALLTYPE *QueryInterface) (IDWriteGdiInterop *This, REFIID riid, void **ppvObject); - ULONG (STDMETHODCALLTYPE *AddRef)(IDWriteGdiInterop *This); - ULONG (STDMETHODCALLTYPE *Release)(IDWriteGdiInterop *This); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteGdiInterop *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteGdiInterop *This); HRESULT (STDMETHODCALLTYPE *CreateFontFromLOGFONT) (IDWriteGdiInterop *This, const LOGFONTW *logfont, @@ -352,7 +355,7 @@ typedef struct IDWriteGdiInteropVtbl { } IDWriteGdiInteropVtbl; interface IDWriteGdiInterop { - CONST_VTBL IDWriteGdiInteropVtbl* lpVtbl; + CONST_VTBL IDWriteGdiInteropVtbl *lpVtbl; }; typedef struct IDWriteFactoryVtbl { @@ -360,8 +363,8 @@ typedef struct IDWriteFactoryVtbl { HRESULT (STDMETHODCALLTYPE *QueryInterface) (IDWriteFactory *This, REFIID riid, void **ppvObject); - ULONG (STDMETHODCALLTYPE *AddRef)(IDWriteFactory *This); - ULONG (STDMETHODCALLTYPE *Release)(IDWriteFactory *This); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteFactory *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteFactory *This); EMACS_DWRITE_UNUSED (GetSystemFontCollection); EMACS_DWRITE_UNUSED (CreateCustomFontCollection); @@ -392,37 +395,35 @@ typedef struct IDWriteFactoryVtbl { END_INTERFACE } IDWriteFactoryVtbl; -interface IDWriteFactory { CONST_VTBL IDWriteFactoryVtbl* lpVtbl; }; +interface IDWriteFactory { CONST_VTBL IDWriteFactoryVtbl *lpVtbl; }; typedef struct IDWriteColorGlyphRunEnumeratorVtbl { BEGIN_INTERFACE HRESULT (STDMETHODCALLTYPE *QueryInterface) (IDWriteColorGlyphRunEnumerator *This, REFIID riid, void **ppvObject); - ULONG (STDMETHODCALLTYPE *AddRef)(IDWriteColorGlyphRunEnumerator *This); - ULONG (STDMETHODCALLTYPE *Release)(IDWriteColorGlyphRunEnumerator *This); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteColorGlyphRunEnumerator *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteColorGlyphRunEnumerator *This); - HRESULT (STDMETHODCALLTYPE *MoveNext)( - IDWriteColorGlyphRunEnumerator *This, - WINBOOL *hasRun); + HRESULT (STDMETHODCALLTYPE *MoveNext) (IDWriteColorGlyphRunEnumerator *This, + WINBOOL *hasRun); - HRESULT (STDMETHODCALLTYPE *GetCurrentRun)( - IDWriteColorGlyphRunEnumerator *This, - const DWRITE_COLOR_GLYPH_RUN **run); + HRESULT (STDMETHODCALLTYPE *GetCurrentRun) (IDWriteColorGlyphRunEnumerator *This, + const DWRITE_COLOR_GLYPH_RUN **run); END_INTERFACE } IDWriteColorGlyphRunEnumeratorVtbl; interface IDWriteColorGlyphRunEnumerator { - CONST_VTBL IDWriteColorGlyphRunEnumeratorVtbl* lpVtbl; + CONST_VTBL IDWriteColorGlyphRunEnumeratorVtbl *lpVtbl; }; typedef struct IDWriteFactory2Vtbl { BEGIN_INTERFACE HRESULT (STDMETHODCALLTYPE *QueryInterface) (IDWriteFactory2 *This, REFIID riid, void **ppvObject); - ULONG (STDMETHODCALLTYPE *AddRef)(IDWriteFactory2 *This); - ULONG (STDMETHODCALLTYPE *Release)(IDWriteFactory2 *This); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteFactory2 *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteFactory2 *This); EMACS_DWRITE_UNUSED (GetSystemFontCollection); EMACS_DWRITE_UNUSED (CreateCustomFontCollection); EMACS_DWRITE_UNUSED (RegisterFontCollectionLoader); @@ -467,7 +468,7 @@ typedef struct IDWriteFactory2Vtbl { } IDWriteFactory2Vtbl; interface IDWriteFactory2 { - CONST_VTBL IDWriteFactory2Vtbl* lpVtbl; + CONST_VTBL IDWriteFactory2Vtbl *lpVtbl; }; #else /* MINGW_W64 */ # include @@ -529,15 +530,15 @@ get_font_face (struct font *infont, IDWriteFontFace **face) LOGFONTW logfont; IDWriteFont *font; - struct uniscribe_font_info *uniscribe_font = - (struct uniscribe_font_info *) infont; + struct uniscribe_font_info *uniscribe_font + = (struct uniscribe_font_info *) infont; /* Check the cache. */ *face = uniscribe_font->dwrite_cache; if (*face) return uniscribe_font->dwrite_font_size; - GetObjectW (FONT_HANDLE(infont), sizeof (LOGFONTW), &logfont); + GetObjectW (FONT_HANDLE (infont), sizeof (LOGFONTW), &logfont); hr = gdi_interop->lpVtbl->CreateFontFromLOGFONT (gdi_interop, (const LOGFONTW *) &logfont, @@ -597,8 +598,8 @@ text_extents_internal (IDWriteFontFace *dwrite_font_face, for (int i = 0; i < nglyphs; i++) indices[i] = code[i]; - DWRITE_GLYPH_METRICS* gmetrics = - SAFE_ALLOCA (nglyphs * sizeof (DWRITE_GLYPH_METRICS)); + DWRITE_GLYPH_METRICS *gmetrics + = SAFE_ALLOCA (nglyphs * sizeof (DWRITE_GLYPH_METRICS)); hr = dwrite_font_face->lpVtbl->GetGdiCompatibleGlyphMetrics (dwrite_font_face, font_size, @@ -620,18 +621,18 @@ text_extents_internal (IDWriteFontFace *dwrite_font_face, for (int i = 0; i < nglyphs; i++) { - float advance = - convert_metrics_sz (gmetrics[i].advanceWidth, font_size, du_per_em); + float advance + = convert_metrics_sz (gmetrics[i].advanceWidth, font_size, du_per_em); width += advance; - float lbearing = - round (convert_metrics_sz (gmetrics[i].leftSideBearing, font_size, - du_per_em)); - float rbearing = - round (advance - - convert_metrics_sz (gmetrics[i].rightSideBearing, - font_size, du_per_em)); + float lbearing + = round (convert_metrics_sz (gmetrics[i].leftSideBearing, font_size, + du_per_em)); + float rbearing + = round (advance - + convert_metrics_sz (gmetrics[i].rightSideBearing, + font_size, du_per_em)); if (i == 0) { metrics->lbearing = lbearing; @@ -759,7 +760,8 @@ w32_initialize_direct_write (void) return; /* This is only used here, no need to define it globally. */ - typedef HRESULT (WINAPI *DWCreateFactory) (DWRITE_FACTORY_TYPE f, REFIID r, IUnknown** u); + typedef HRESULT (WINAPI *DWCreateFactory) (DWRITE_FACTORY_TYPE, + REFIID, IUnknown **); DWCreateFactory dw_create_factory = (DWCreateFactory) get_proc_addr (direct_write, @@ -843,7 +845,7 @@ w32_initialize_direct_write (void) config_gamma, config_enhanced_contrast, config_clear_type_level, - def->lpVtbl->GetPixelGeometry(def), + def->lpVtbl->GetPixelGeometry (def), RENDERING_MODE, &rendering_params); @@ -851,7 +853,8 @@ w32_initialize_direct_write (void) if (FAILED (hr)) { - DebPrint (("DirectWrite HRESULT failed: (%d) CreateCustomRenderingParams\n", hr)); + DebPrint (("DirectWrite HRESULT failed: (%d)" + " CreateCustomRenderingParams\n", hr)); RELEASE_COM (dwrite_factory); RELEASE_COM (dwrite_factory2); RELEASE_COM (gdi_interop); @@ -874,8 +877,8 @@ w32_dwrite_draw (HDC hdc, int x, int y, unsigned *glyphs, int len, USE_SAFE_ALLOCA; - struct uniscribe_font_info *uniscribe_font = - (struct uniscribe_font_info *) font; + struct uniscribe_font_info *uniscribe_font + = (struct uniscribe_font_info *) font; /* What we get as y is the baseline position. */ y -= font->ascent; @@ -907,8 +910,8 @@ w32_dwrite_draw (HDC hdc, int x, int y, unsigned *glyphs, int len, } /* This DC can't be released. */ - HDC text_dc = bitmap_render_target->lpVtbl->GetMemoryDC - (bitmap_render_target); + HDC text_dc + = bitmap_render_target->lpVtbl->GetMemoryDC (bitmap_render_target); /* Copy the background pixel to the render target bitmap. */ BitBlt (text_dc, 0, 0, bitmap_width, bitmap_height, hdc, x, y, SRCCOPY); @@ -1036,10 +1039,10 @@ bool w32_use_direct_write (struct w32font_info *w32font) { #ifdef HAVE_HARFBUZZ - return direct_write_available - && w32font->font.driver == &harfbuzz_font_driver - && !w32_inhibit_dwrite - && !((struct uniscribe_font_info *) w32font)->dwrite_skip_font; + return (direct_write_available + && w32font->font.driver == &harfbuzz_font_driver + && !w32_inhibit_dwrite + && !((struct uniscribe_font_info *) w32font)->dwrite_skip_font); #else return false; #endif diff --git a/src/w32font.c b/src/w32font.c index a6a6a4459a3..48968a28fbd 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -452,9 +452,9 @@ w32font_text_extents (struct font *font, const unsigned *code, memset (metrics, 0, sizeof (struct font_metrics)); - if (w32_use_direct_write (w32_font)) - if (w32_dwrite_text_extents (font, code, nglyphs, metrics)) - return; + if (w32_use_direct_write (w32_font) + && w32_dwrite_text_extents (font, code, nglyphs, metrics)) + return; for (i = 0, first = true; i < nglyphs; i++) { @@ -710,9 +710,9 @@ w32font_draw (struct glyph_string *s, int from, int to, int i; for (i = 0; i < len; i++) - if (!w32_use_direct_write (w32font) || - !w32_dwrite_draw (s->hdc, x, y, s->char2b + from, 1, - GetTextColor (s->hdc), s->font)) + if (!w32_use_direct_write (w32font) + || !w32_dwrite_draw (s->hdc, x, y, s->char2b + from, 1, + GetTextColor (s->hdc), s->font)) { WCHAR c = s->char2b[from + i] & 0xFFFF; ExtTextOutW (s->hdc, x + i, y, options, NULL, &c, 1, NULL); @@ -720,10 +720,10 @@ w32font_draw (struct glyph_string *s, int from, int to, } else { - if (!w32_use_direct_write (w32font) || - !w32_dwrite_draw (s->hdc, x, y, - s->char2b + from, len, GetTextColor (s->hdc), - s->font)) + if (!w32_use_direct_write (w32font) + || !w32_dwrite_draw (s->hdc, x, y, + s->char2b + from, len, GetTextColor (s->hdc), + s->font)) { /* The number of glyphs in a glyph_string cannot be larger than the maximum value of the 'used' member of a glyph_row, so we diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index 015214b1e39..d6db1e9e7db 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c @@ -189,7 +189,6 @@ uniscribe_open (struct frame *f, Lisp_Object font_entity, int pixel_size) /* Initialize the cache for this font. */ uniscribe_font->cache = NULL; uniscribe_font->dwrite_cache = NULL; - uniscribe_font->dwrite_skip_font = false; /* Uniscribe and HarfBuzz backends use glyph indices. */ commit 76268160ba9262a8479589427b8e783db0242260 Author: Alan Mackenzie Date: Fri Oct 25 20:35:32 2024 +0000 CC Mode: correct handling of properties on #include <...> In C, Pike, and IDL Modes, deleting and reinserting such a < could create havoc with the category/syntax-table properties on the < and >. Also the contents of <...> should only get paren properties when the #include is present and correct. * lisp/progmodes/cc-fonts.el (c-cpp-matchers): Replace the c-make-font-lock-search-function which put properties on the <...> with a simple matcher. * lisp/progmodes/cc-langs.el (c-get-state-before-change-functions) (c-before-font-lock-functions): Add respectively c-before-change-include-<> and c-after-change-include-<> in the C, Pike and IDL entries of these variables. * lisp/progmodes/cc-mode.el (c-before-change-include-<>) (c-after-change-include-<>): New functions. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 0f086f8e812..3a87339e38a 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -564,26 +564,18 @@ stuff. Used on level 1 and higher." ;; since `font-lock-fontify-anchored-keywords' terminated ;; its loop at EOL without executing our lambda form at ;; all. - `((,(c-make-font-lock-search-function - (concat noncontinued-line-end - (c-lang-const c-opt-cpp-prefix) - re - (c-lang-const c-syntactic-ws) - "\\(<\\([^>\n\r]*\\)>?\\)") - `(,(+ ncle-depth re-depth sws-depth - (if (featurep 'xemacs) 2 1) - ) - font-lock-string-face t) - `((let ((beg (match-beginning - ,(+ ncle-depth re-depth sws-depth 1))) - (end (1- (match-end ,(+ ncle-depth re-depth - sws-depth 1))))) - (if (eq (char-after end) ?>) - (progn - (c-mark-<-as-paren beg) - (c-mark->-as-paren end)) - (c-unmark-<->-as-paren beg))) - nil)))))) + `((,(concat noncontinued-line-end + "\\(" ; To make the next ^ special. + (c-lang-const c-cpp-include-key) + "\\)" + (c-lang-const c-syntactic-ws) + "\\(<\\([^>\n\r]*\\)>?\\)") + ,(+ ncle-depth 1 + (regexp-opt-depth + (c-lang-const c-cpp-include-key)) + sws-depth + (if (featurep 'xemacs) 2 1)) + font-lock-string-face t)))) ;; #define. ,@(when (c-lang-const c-opt-cpp-macro-define) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 010b0ed6b04..a256371f850 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -451,7 +451,8 @@ so that all identifiers are recognized as words.") (c-lang-defconst c-get-state-before-change-functions ;; For documentation see the following c-lang-defvar of the same name. ;; The value here may be a list of functions or a single function. - t 'c-before-change-check-unbalanced-strings + t '(c-before-change-include-<> + c-before-change-check-unbalanced-strings) c++ '(c-extend-region-for-CPP c-depropertize-CPP c-before-change-check-ml-strings @@ -463,6 +464,7 @@ so that all identifiers are recognized as words.") c-parse-quotes-before-change c-before-change-fix-comment-escapes) c '(c-extend-region-for-CPP + c-before-change-include-<> c-depropertize-CPP c-truncate-bs-cache c-before-change-check-unbalanced-strings @@ -480,7 +482,8 @@ so that all identifiers are recognized as words.") c-unmark-<>-around-region c-before-change-check-unbalanced-strings c-before-change-check-<>-operators) - pike '(c-before-change-check-ml-strings + pike '(c-before-change-include-<> + c-before-change-check-ml-strings c-before-change-check-unbalanced-strings) awk 'c-awk-record-region-clear-NL) (c-lang-defvar c-get-state-before-change-functions @@ -511,6 +514,7 @@ parameters \(point-min) and \(point-max).") t '(c-depropertize-new-text c-after-change-escape-NL-in-string c-after-change-mark-abnormal-strings + c-after-change-include-<> c-change-expand-fl-region) c '(c-depropertize-new-text c-after-change-fix-comment-escapes @@ -518,6 +522,7 @@ parameters \(point-min) and \(point-max).") c-parse-quotes-after-change c-after-change-mark-abnormal-strings c-extend-font-lock-region-for-macros + c-after-change-include-<> c-neutralize-syntax-in-CPP c-change-expand-fl-region) objc '(c-depropertize-new-text @@ -553,6 +558,7 @@ parameters \(point-min) and \(point-max).") c-after-change-escape-NL-in-string c-after-change-unmark-ml-strings c-after-change-mark-abnormal-strings + c-after-change-include-<> c-change-expand-fl-region) awk '(c-depropertize-new-text c-awk-extend-and-syntax-tablify-region)) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 71fafeca59f..2fcb46a1c0d 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -2009,6 +2009,70 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (defvar c-new-id-is-type nil) (make-variable-buffer-local 'c-new-id-is-type) +(defun c-before-change-include-<> (beg end) + "Remove category/syntax-table properties from each #include <..>. +In particular, from the < and > characters which have been marked as parens +using these properties. This is done on every such #include <..> with a +portion between BEG and END. + +This function is used solely as a member of +`c-get-state-before-change-functions' where it should appear early, before +`c-depropertize-CPP'. It should be used only together with +`c-after-change-include-<>'." + (c-save-buffer-state ((search-end (progn (goto-char end) + (c-end-of-macro) + (point))) + hash-pos) + (goto-char beg) + (c-beginning-of-macro) + (while (and (< (point) search-end) + (search-forward-regexp c-cpp-include-key search-end 'bound) + (setq hash-pos (match-beginning 0))) + (save-restriction + (narrow-to-region (point-min) (c-point 'eoll)) + (c-forward-comments)) + (when (and (< (point) search-end) + (looking-at "\\s(") + (looking-at "\\(<\\)[^>\n\r]*\\(>\\)?") + (not (cdr (c-semi-pp-to-literal hash-pos)))) + (c-unmark-<->-as-paren (match-beginning 1)) + (when (< hash-pos c-new-BEG) + (setq c-new-BEG hash-pos)) + (when (match-beginning 2) + (c-unmark-<->-as-paren (match-beginning 2)) + (when (> (match-end 2) c-new-END) + (setq c-new-END (match-end 2)))))))) + +(defun c-after-change-include-<> (beg end _old-len) + "Apply category/syntax-table properties to each #include <..>. +In particular, to the < and > characters to mark them as matching parens +using these properties. This is done on every such #include <..> with a +portion between BEG and END. + +This function is used solely as a member of +`c-before-font-lock-functions' where is should appear late, but before +`c-neutralize-syntax-in-CPP'. It should be used only together with +`c-before-change-include-<>'." + (c-save-buffer-state ((search-end (progn (goto-char end) + (c-end-of-macro) + (point))) + hash-pos) + (goto-char beg) + (c-beginning-of-macro) + (while (and (< (point) search-end) + (search-forward-regexp c-cpp-include-key search-end 'bound) + (setq hash-pos (match-beginning 0))) + (save-restriction + (narrow-to-region (point-min) (c-point 'eoll)) + (c-forward-comments)) + (when (and (< (point) search-end) + (looking-at "\\(<\\)[^>\n\r]*\\(>\\)") + (not (cdr (c-semi-pp-to-literal (match-beginning 0))))) + (c-mark-<-as-paren (match-beginning 1)) + (when (< hash-pos c-new-BEG) (setq c-new-BEG hash-pos)) + (c-mark->-as-paren (match-beginning 2)) + (when (> (match-end 2) c-new-END) (setq c-new-END (match-end 2))))))) + (defun c-before-change-fix-comment-escapes (beg end) "Remove punctuation syntax-table text properties from C/C++ comment markers. This is to handle the rare case of two or more backslashes at an commit 3d508157e03597b00c46c82d42a60742c01a0250 Author: Eli Zaretskii Date: Fri Oct 25 14:47:43 2024 +0300 ; * src/w32dwrite.c (Fw32_dwrite_reinit): Doc fix. diff --git a/src/w32dwrite.c b/src/w32dwrite.c index 1f5eba19a40..1ca965fe374 100644 --- a/src/w32dwrite.c +++ b/src/w32dwrite.c @@ -1060,9 +1060,10 @@ value. Return value is nil. -ENHANCED_CONTRAST is in the range [0.0, 1.0], and defaults to 0.0. -CLEAR_TYPE_LEVEL is in the range [0.0, 1.0], and defaults to 0.0. -GAMMA is in the range (0.0, 256.0], and defaults to 2.2. */) +ENHANCED_CONTRAST is in the range [0.0, 1.0], and defaults to 0.5. +CLEAR_TYPE_LEVEL is in the range [0.0, 1.0], and defaults to 1.0. +GAMMA is in the range (0.0, 256.0], and defaults to a system-dependent value + around 2.0 (sometimes 1.8, sometimes 2.2). */) (Lisp_Object enhanced_contrast, Lisp_Object clear_type_level, Lisp_Object gamma) { commit 222a5207c4d8fa31103637018ae0a7bdb74dd660 Author: Eli Zaretskii Date: Fri Oct 25 14:36:41 2024 +0300 ; Minor fixes to last changes * src/w32font.h: * src/w32font.c: * src/w32dwrite.c: * etc/NEWS: Minor fixes of last changes. (Bug#73730) diff --git a/etc/NEWS b/etc/NEWS index 108d96014db..18b6678dce9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -790,8 +790,11 @@ supported. As on X, the user options 'dnd-scroll-margin' and On Windows 8.1 and later versions Emacs now uses DirectWrite to draw text, which supports color fonts. This can be disabled by setting the variable 'w32-inhibit-dwrite' to t. Also see 'w32-dwrite-available' and -'w32-dwrite-reinit' to check availability and to configure render -parameters. +'w32-dwrite-reinit' to check availability and to configure the +DirectWrite rendering parameters. + +To show color Emoji in Emacs, customize the default fontset to use a +color Emoji font installed on your system for the 'emoji' script. ---------------------------------------------------------------------- diff --git a/src/w32dwrite.c b/src/w32dwrite.c index 9f7b8d96977..1f5eba19a40 100644 --- a/src/w32dwrite.c +++ b/src/w32dwrite.c @@ -469,11 +469,11 @@ typedef struct IDWriteFactory2Vtbl { interface IDWriteFactory2 { CONST_VTBL IDWriteFactory2Vtbl* lpVtbl; }; -#else /* ifndef MINGW_W64 */ +#else /* MINGW_W64 */ # include #endif -/* User configurable variables. If they are lower than 0 use +/* User configurable variables. If they are smaller than 0, use DirectWrite's defaults, or our defaults. To set them, the user calls 'w32-dwrite-reinit' */ static float config_enhanced_contrast = -1.0f; @@ -495,7 +495,7 @@ release_com (IUnknown **i) } } -#define RELEASE_COM(i) release_com ( (IUnknown **) &i ) +#define RELEASE_COM(i) release_com ((IUnknown **) &i) /* Global variables for DirectWrite. */ static bool direct_write_available = false; @@ -516,7 +516,7 @@ verify_hr (HRESULT hr, const char *msg) return true; } -/* Gets a IDWriteFontFace from a struct font (its HFONT). Returns the +/* Gets a IDWriteFontFace from a struct font (its HFONT). Returns the font size in points. It may fail to get a DirectWrite font, and face will be NULL on return. This happens for some fonts like Courier. @@ -560,10 +560,10 @@ get_font_face (struct font *infont, IDWriteFontFace **face) } /* Cache this FontFace. */ - uniscribe_font->dwrite_font_size = abs (logfont.lfHeight); + uniscribe_font->dwrite_font_size = eabs (logfont.lfHeight); uniscribe_font->dwrite_cache = *face; - return abs (logfont.lfHeight); + return eabs (logfont.lfHeight); } void @@ -642,7 +642,7 @@ text_extents_internal (IDWriteFontFace *dwrite_font_face, if (metrics->rbearing < rbearing) metrics->rbearing = rbearing; } - metrics->width = round(width); + metrics->width = round (width); SAFE_FREE (); return true; } @@ -794,7 +794,6 @@ w32_initialize_direct_write (void) DebPrint (("DirectWrite HRESULT failed: (%d) QueryInterface IDWriteFactory2\n", hr)); RELEASE_COM (dwrite_factory); FreeLibrary (direct_write); - eassert (SUCCEEDED (hr)); return; } @@ -939,12 +938,12 @@ w32_dwrite_draw (HDC hdc, int x, int y, unsigned *glyphs, int len, glyph_run.glyphIndices = indices; glyph_run.glyphCount = len; glyph_run.isSideways = false; - glyph_run.bidiLevel = 0; + glyph_run.bidiLevel = 0; /* we reorder bidi text ourselves */ glyph_run.glyphOffsets = NULL; glyph_run.glyphAdvances = advances; IDWriteColorGlyphRunEnumerator *layers; - /* This call will tell us if we hace to handle any color glyph. */ + /* This call will tell us if we have to handle any color glyphs. */ hr = dwrite_factory2->lpVtbl->TranslateColorGlyphRun (dwrite_factory2, 0, font->ascent, &glyph_run, @@ -965,8 +964,8 @@ w32_dwrite_draw (HDC hdc, int x, int y, unsigned *glyphs, int len, NULL); else { - /* If there were color glyphs, layers contains a list of GlyphRun - with a color and a position for each. We draw them + /* If there were color glyphs, 'layers' contains a list of + GlyphRun with a color and a position for each. We draw them individually. */ if (!verify_hr (hr, "Failed at TranslateColorGlyphRun")) { @@ -1057,11 +1056,13 @@ DirectWrite will be used if it is available and 'w32-inhibit-dwrite' is nil. */ DEFUN ("w32-dwrite-reinit", Fw32_dwrite_reinit, Sw32_dwrite_reinit, 0, 3, 0, doc: /* Reinitialize DirectWrite with the given parameters. If a parameter is not specified, or is out of range, it will take a default -value. Returns nil. +value. + +Return value is nil. -ENHANCED_CONTRAST is in the range [0.0, 1.0] -CLEAR_TYPE_LEVEL is in the range [0.0, 1.0] -GAMMA is in the range (0.0, 256.0] */) +ENHANCED_CONTRAST is in the range [0.0, 1.0], and defaults to 0.0. +CLEAR_TYPE_LEVEL is in the range [0.0, 1.0], and defaults to 0.0. +GAMMA is in the range (0.0, 256.0], and defaults to 2.2. */) (Lisp_Object enhanced_contrast, Lisp_Object clear_type_level, Lisp_Object gamma) { diff --git a/src/w32font.c b/src/w32font.c index 05e5a067f20..a6a6a4459a3 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -712,7 +712,7 @@ w32font_draw (struct glyph_string *s, int from, int to, for (i = 0; i < len; i++) if (!w32_use_direct_write (w32font) || !w32_dwrite_draw (s->hdc, x, y, s->char2b + from, 1, - GetTextColor(s->hdc), s->font)) + GetTextColor (s->hdc), s->font)) { WCHAR c = s->char2b[from + i] & 0xFFFF; ExtTextOutW (s->hdc, x + i, y, options, NULL, &c, 1, NULL); @@ -722,7 +722,7 @@ w32font_draw (struct glyph_string *s, int from, int to, { if (!w32_use_direct_write (w32font) || !w32_dwrite_draw (s->hdc, x, y, - s->char2b + from, len, GetTextColor(s->hdc), + s->char2b + from, len, GetTextColor (s->hdc), s->font)) { /* The number of glyphs in a glyph_string cannot be larger than diff --git a/src/w32font.h b/src/w32font.h index 75e63e4a32e..74552a5bee5 100644 --- a/src/w32font.h +++ b/src/w32font.h @@ -112,7 +112,7 @@ bool w32_dwrite_draw (HDC hdc, int x, int y, unsigned *glyphs, int len, bool w32_dwrite_text_extents (struct font *font, const unsigned *code, int nglyphs, struct font_metrics *metrics); unsigned w32_dwrite_encode_char (struct font *font, int c); -void w32_dwrite_free_cached_face(void *cache); +void w32_dwrite_free_cached_face (void *cache); void syms_of_w32dwrite (void); extern void globals_of_w32font (void); commit edf37e811cafa4092b13969613fa83f6e6d69ab3 Author: Cecilio Pardo Date: Wed Oct 9 11:40:28 2024 +0200 Implement drawing text with DirectWrite on MS-Windows. This adds support for color fonts. * configure.ac: Add src/w32drite to W32_OBJ. * src/w32dwrite.c: New file. (w32-initialize-direct-write): New function, initialize the DirectWrite library if it is available, and required global variables. (w32_use_direct_write): New function, check if DirectWrite is available and activated by the user. (w32_dwrite_encode_char): New function, replacement for HarfBuzz's 'encode_char'. (w32_dwrite_text_extents): New function, replacement for w32font text_extents. (w32_dwrite_draw): New function, replacement for w32font draw. (w32_dwrite_free_cached_face): New function, used in the font deletion process to also delete DirectWrite data. (verify_hr): New function, verify COM method results. (release_com): New function, release a COM object. (w32-dwrite-available): New function, returns true if DirectWrite is available. (w32-dwrite-reinit): New function, reinitialize DirectWrite, optionally setting some rendering parameters. * src/w32font.c (w32font_text_extents): If DirectWrite is enabled, call 'w32_dwrite_text_extents'. (w32font_draw): If DirectWrite is enabled, call 'w32_dwrite_draw'. * src/w32uniscribe.c: (w32hb_encode_char): If DirectWrite is enabled, call 'w32_dwrite_encode_char'. (syms_of_w32uniscribe_for_pdumper): Initialize DirectWrite. (uniscribe_close): Free DirectWrite data for the font. Bug#73730 diff --git a/configure.ac b/configure.ac index 947c2827b8e..1c7545ef984 100644 --- a/configure.ac +++ b/configure.ac @@ -3172,7 +3172,7 @@ if test "${HAVE_W32}" = "yes"; then AC_CHECK_TOOL([WINDRES], [windres], [AC_MSG_ERROR([No resource compiler found.])]) W32_OBJ="w32fns.o w32menu.o w32reg.o w32font.o w32term.o" - W32_OBJ="$W32_OBJ w32xfns.o w32select.o w32uniscribe.o w32cygwinx.o" + W32_OBJ="$W32_OBJ w32xfns.o w32select.o w32uniscribe.o w32dwrite.o w32cygwinx.o" EMACSRES="emacs.res" case "$canonical" in x86_64-*-*) EMACS_MANIFEST="emacs-x64.manifest" ;; diff --git a/etc/NEWS b/etc/NEWS index b9f58c846db..108d96014db 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -785,6 +785,14 @@ This is in addition to drag-n-drop of files, that was already supported. As on X, the user options 'dnd-scroll-margin' and 'dnd-indicate-insertion-point' can be used to customize the process. +--- +** Emacs on MS-Windows now supports color fonts. +On Windows 8.1 and later versions Emacs now uses DirectWrite to draw +text, which supports color fonts. This can be disabled by setting the +variable 'w32-inhibit-dwrite' to t. Also see 'w32-dwrite-available' and +'w32-dwrite-reinit' to check availability and to configure render +parameters. + ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/src/w32dwrite.c b/src/w32dwrite.c new file mode 100644 index 00000000000..9f7b8d96977 --- /dev/null +++ b/src/w32dwrite.c @@ -0,0 +1,1099 @@ +/* Support for using DirectWrite on MS-Windows to draw text. This + allows for color fonts. + Copyright (C) 2024 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 GNU Emacs. If not, see . */ + +/* This requires the HarfBuzz font backend to be available. + + It works by modifying the HarfBuzz backend to use DirectWrite at + some points, if it is available: + + - When encoding characters: w32hb_encode_char + - When measuring text: w32font_text_extents + - When drawing text: w32font_draw + + DirectWrite is setup by calling w32_initialize_direct_write. From + that point, the function w32_use_direct_write will return true if + DirectWrite is to be used. + + DirectWrite is available since Windows 7, but we don't activate it on + versions before 8.1, because color fonts are only available since that. */ + +#include +#include +#include + +#ifndef MINGW_W64 +# define INITGUID +#endif +#include +#include +#include + +#include "frame.h" +#include "w32font.h" +#include "w32common.h" +#include "w32term.h" + +#ifndef MINGW_W64 + +/* The following definitions would be included from dwrite_3.h, but it + is not available when building with mingw.org's MinGW. Methods that + we don't use are declared with the EMACS_DWRITE_UNUSED macro, to + avoid bringing in more types that would need to be declared. */ + +#define EMACS_DWRITE_UNUSED(name) void (STDMETHODCALLTYPE *name)(void) + +#define DWRITE_E_NOCOLOR _HRESULT_TYPEDEF_(0x8898500CL) + +typedef enum DWRITE_PIXEL_GEOMETRY { + DWRITE_PIXEL_GEOMETRY_FLAT = 0, + DWRITE_PIXEL_GEOMETRY_RGB = 1, + DWRITE_PIXEL_GEOMETRY_BGR = 2 +} DWRITE_PIXEL_GEOMETRY; + +typedef enum DWRITE_RENDERING_MODE { + DWRITE_RENDERING_MODE_DEFAULT = 0, + DWRITE_RENDERING_MODE_ALIASED = 1, + DWRITE_RENDERING_MODE_GDI_CLASSIC = 2, + DWRITE_RENDERING_MODE_GDI_NATURAL = 3, + DWRITE_RENDERING_MODE_NATURAL = 4, + DWRITE_RENDERING_MODE_NATURAL_SYMMETRIC = 5, + DWRITE_RENDERING_MODE_OUTLINE = 6 +} DWRITE_RENDERING_MODE; + +typedef enum DWRITE_MEASURING_MODE { + DWRITE_MEASURING_MODE_NATURAL = 0, + DWRITE_MEASURING_MODE_GDI_CLASSIC = 1, + DWRITE_MEASURING_MODE_GDI_NATURAL = 2 +} DWRITE_MEASURING_MODE; + +typedef enum DWRITE_TEXT_ANTIALIAS_MODE { + DWRITE_TEXT_ANTIALIAS_MODE_CLEARTYPE = 0, + DWRITE_TEXT_ANTIALIAS_MODE_GRAYSCALE = 1 +} DWRITE_TEXT_ANTIALIAS_MODE; + +typedef enum DWRITE_FACTORY_TYPE { + DWRITE_FACTORY_TYPE_SHARED = 0, + DWRITE_FACTORY_TYPE_ISOLATED = 1 +} DWRITE_FACTORY_TYPE; + +typedef struct DWRITE_FONT_METRICS { + UINT16 designUnitsPerEm; + UINT16 ascent; + UINT16 descent; + INT16 lineGap; + UINT16 capHeight; + UINT16 xHeight; + INT16 underlinePosition; + UINT16 underlineThickness; + INT16 strikethroughPosition; + UINT16 strikethroughThickness; +} DWRITE_FONT_METRICS; + +typedef struct DWRITE_GLYPH_METRICS { + INT32 leftSideBearing; + UINT32 advanceWidth; + INT32 rightSideBearing; + INT32 topSideBearing; + UINT32 advanceHeight; + INT32 bottomSideBearing; + INT32 verticalOriginY; +} DWRITE_GLYPH_METRICS; + +typedef interface IDWriteRenderingParams IDWriteRenderingParams; +typedef interface IDWriteFont IDWriteFont; +typedef interface IDWriteGdiInterop IDWriteGdiInterop; +typedef interface IDWriteFactory IDWriteFactory; +typedef interface IDWriteFactory2 IDWriteFactory2; +typedef interface IDWriteFontFace IDWriteFontFace; +typedef interface IDWriteBitmapRenderTarget IDWriteBitmapRenderTarget; +typedef interface IDWriteBitmapRenderTarget1 IDWriteBitmapRenderTarget1; +typedef interface IDWriteColorGlyphRunEnumerator IDWriteColorGlyphRunEnumerator; + +DEFINE_GUID(IID_IDWriteBitmapRenderTarget1, 0x791e8298, 0x3ef3, 0x4230, 0x98,0x80, 0xc9,0xbd,0xec,0xc4,0x20,0x64); +DEFINE_GUID(IID_IDWriteFactory2, 0x0439fc60, 0xca44, 0x4994, 0x8d,0xee, 0x3a,0x9a,0xf7,0xb7,0x32,0xec); +DEFINE_GUID(IID_IDWriteFactory, 0xb859ee5a, 0xd838, 0x4b5b, 0xa2,0xe8, 0x1a,0xdc,0x7d,0x93,0xdb,0x48); + +typedef struct DWRITE_GLYPH_OFFSET { + FLOAT advanceOffset; + FLOAT ascenderOffset; +} DWRITE_GLYPH_OFFSET; + +typedef struct DWRITE_GLYPH_RUN { + IDWriteFontFace *fontFace; + FLOAT fontEmSize; + UINT32 glyphCount; + const UINT16 *glyphIndices; + const FLOAT *glyphAdvances; + const DWRITE_GLYPH_OFFSET *glyphOffsets; + WINBOOL isSideways; + UINT32 bidiLevel; +} DWRITE_GLYPH_RUN; + +typedef struct _D3DCOLORVALUE { + float r; + float g; + float b; + float a; +} D3DCOLORVALUE; + +typedef D3DCOLORVALUE DWRITE_COLOR_F; + +typedef struct DWRITE_COLOR_GLYPH_RUN { + DWRITE_GLYPH_RUN glyphRun; + void *glyphRunDescription; + FLOAT baselineOriginX; + FLOAT baselineOriginY; + DWRITE_COLOR_F runColor; + UINT16 paletteIndex; +} DWRITE_COLOR_GLYPH_RUN; + +typedef struct IDWriteFontFaceVtbl { + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteFontFace *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef)(IDWriteFontFace *This); + ULONG (STDMETHODCALLTYPE *Release)(IDWriteFontFace *This); + + EMACS_DWRITE_UNUSED(GetType); + EMACS_DWRITE_UNUSED(GetFiles); + EMACS_DWRITE_UNUSED(GetIndex); + EMACS_DWRITE_UNUSED(GetSimulations); + EMACS_DWRITE_UNUSED(IsSymbolFont); + + void (STDMETHODCALLTYPE *GetMetrics) + (IDWriteFontFace *This, DWRITE_FONT_METRICS *metrics); + + EMACS_DWRITE_UNUSED (GetGlyphCount); + EMACS_DWRITE_UNUSED (GetDesignGlyphMetrics); + + HRESULT (STDMETHODCALLTYPE *GetGlyphIndices) + (IDWriteFontFace *This, const UINT32 *codepoints, UINT32 count, + UINT16 *glyph_indices); + + EMACS_DWRITE_UNUSED (TryGetFontTable); + EMACS_DWRITE_UNUSED (ReleaseFontTable); + EMACS_DWRITE_UNUSED (GetGlyphRunOutline); + EMACS_DWRITE_UNUSED (GetRecommendedRenderingMode); + EMACS_DWRITE_UNUSED (GetGdiCompatibleMetrics); + + HRESULT (STDMETHODCALLTYPE *GetGdiCompatibleGlyphMetrics) + (IDWriteFontFace *This, + FLOAT emSize, + FLOAT pixels_per_dip, + void *transform, + WINBOOL use_gdi_natural, + const UINT16 *glyph_indices, + UINT32 glyph_count, + DWRITE_GLYPH_METRICS *metrics, + WINBOOL is_sideways); + END_INTERFACE +} IDWriteFontFaceVtbl; + +interface IDWriteFontFace { + CONST_VTBL IDWriteFontFaceVtbl* lpVtbl; +}; + +typedef struct IDWriteRenderingParamsVtbl { + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteRenderingParams *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef)(IDWriteRenderingParams *This); + ULONG (STDMETHODCALLTYPE *Release)(IDWriteRenderingParams *This); + + FLOAT (STDMETHODCALLTYPE *GetGamma) + (IDWriteRenderingParams *This); + FLOAT (STDMETHODCALLTYPE *GetEnhancedContrast) + (IDWriteRenderingParams *This); + FLOAT (STDMETHODCALLTYPE *GetClearTypeLevel) + (IDWriteRenderingParams *This); + int (STDMETHODCALLTYPE *GetPixelGeometry) + (IDWriteRenderingParams *This); + END_INTERFACE +} IDWriteRenderingParamsVtbl; + +interface IDWriteRenderingParams { + CONST_VTBL IDWriteRenderingParamsVtbl* lpVtbl; +}; + +typedef struct IDWriteFontVtbl { + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteFont *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef)(IDWriteFont *This); + ULONG (STDMETHODCALLTYPE *Release)(IDWriteFont *This); + + EMACS_DWRITE_UNUSED (GetFontFamily); + EMACS_DWRITE_UNUSED (GetWeight); + EMACS_DWRITE_UNUSED (GetStretch); + EMACS_DWRITE_UNUSED (GetStyle); + EMACS_DWRITE_UNUSED (IsSymbolFont); + EMACS_DWRITE_UNUSED (GetFaceNames); + EMACS_DWRITE_UNUSED (GetInformationalStrings); + EMACS_DWRITE_UNUSED (GetSimulations); + + void (STDMETHODCALLTYPE *GetMetrics) + (IDWriteFont *This, DWRITE_FONT_METRICS *metrics); + + EMACS_DWRITE_UNUSED(HasCharacter); + + HRESULT (STDMETHODCALLTYPE *CreateFontFace) + (IDWriteFont *This, IDWriteFontFace **face); + + END_INTERFACE +} IDWriteFontVtbl; + +interface IDWriteFont { + CONST_VTBL IDWriteFontVtbl* lpVtbl; +}; + +typedef struct IDWriteBitmapRenderTargetVtbl { + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteBitmapRenderTarget *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef)(IDWriteBitmapRenderTarget *This); + ULONG (STDMETHODCALLTYPE *Release)(IDWriteBitmapRenderTarget *This); + + HRESULT (STDMETHODCALLTYPE *DrawGlyphRun) + (IDWriteBitmapRenderTarget *This, + FLOAT baselineOriginX, + FLOAT baselineOriginY, + DWRITE_MEASURING_MODE measuring_mode, + const DWRITE_GLYPH_RUN *glyph_run, + IDWriteRenderingParams *params, + COLORREF textColor, + RECT *blackbox_rect); + + HDC (STDMETHODCALLTYPE *GetMemoryDC)(IDWriteBitmapRenderTarget *This); + + EMACS_DWRITE_UNUSED (GetPixelsPerDip); + + HRESULT (STDMETHODCALLTYPE *SetPixelsPerDip) + (IDWriteBitmapRenderTarget *This, FLOAT pixels_per_dip); + + EMACS_DWRITE_UNUSED (GetCurrentTransform); + EMACS_DWRITE_UNUSED (SetCurrentTransform); + EMACS_DWRITE_UNUSED (GetSize); + EMACS_DWRITE_UNUSED (Resize); + END_INTERFACE +} IDWriteBitmapRenderTargetVtbl; + +interface IDWriteBitmapRenderTarget { + CONST_VTBL IDWriteBitmapRenderTargetVtbl* lpVtbl; +}; + +typedef struct IDWriteBitmapRenderTarget1Vtbl { + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteBitmapRenderTarget1 *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteBitmapRenderTarget1 *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteBitmapRenderTarget1 *This); + + EMACS_DWRITE_UNUSED (DrawGlyphRun); + EMACS_DWRITE_UNUSED (GetMemoryDC); + EMACS_DWRITE_UNUSED (GetPixelsPerDip); + EMACS_DWRITE_UNUSED (SetPixelsPerDip); + EMACS_DWRITE_UNUSED (GetCurrentTransform); + EMACS_DWRITE_UNUSED (SetCurrentTransform); + EMACS_DWRITE_UNUSED (GetSize); + EMACS_DWRITE_UNUSED (Resize); + EMACS_DWRITE_UNUSED (GetTextAntialiasMode); + + HRESULT (STDMETHODCALLTYPE *SetTextAntialiasMode) + (IDWriteBitmapRenderTarget1 *This, DWRITE_TEXT_ANTIALIAS_MODE mode); + + END_INTERFACE +} IDWriteBitmapRenderTarget1Vtbl; + +interface IDWriteBitmapRenderTarget1 { + CONST_VTBL IDWriteBitmapRenderTarget1Vtbl* lpVtbl; +}; + +typedef struct IDWriteGdiInteropVtbl { + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteGdiInterop *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef)(IDWriteGdiInterop *This); + ULONG (STDMETHODCALLTYPE *Release)(IDWriteGdiInterop *This); + + HRESULT (STDMETHODCALLTYPE *CreateFontFromLOGFONT) + (IDWriteGdiInterop *This, const LOGFONTW *logfont, + IDWriteFont **font); + + EMACS_DWRITE_UNUSED (ConvertFontToLOGFONT); + EMACS_DWRITE_UNUSED (ConvertFontFaceToLOGFONT); + EMACS_DWRITE_UNUSED (CreateFontFaceFromHdc); + + HRESULT (STDMETHODCALLTYPE *CreateBitmapRenderTarget) + (IDWriteGdiInterop *This, HDC hdc, UINT32 width, UINT32 height, + IDWriteBitmapRenderTarget **target); + END_INTERFACE +} IDWriteGdiInteropVtbl; + +interface IDWriteGdiInterop { + CONST_VTBL IDWriteGdiInteropVtbl* lpVtbl; +}; + +typedef struct IDWriteFactoryVtbl { + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteFactory *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef)(IDWriteFactory *This); + ULONG (STDMETHODCALLTYPE *Release)(IDWriteFactory *This); + + EMACS_DWRITE_UNUSED (GetSystemFontCollection); + EMACS_DWRITE_UNUSED (CreateCustomFontCollection); + EMACS_DWRITE_UNUSED (RegisterFontCollectionLoader); + EMACS_DWRITE_UNUSED (UnregisterFontCollectionLoader); + EMACS_DWRITE_UNUSED (CreateFontFileReference); + EMACS_DWRITE_UNUSED (CreateCustomFontFileReference); + EMACS_DWRITE_UNUSED (CreateFontFace); + HRESULT (STDMETHODCALLTYPE *CreateRenderingParams) + (IDWriteFactory *This, IDWriteRenderingParams **params); + EMACS_DWRITE_UNUSED (CreateMonitorRenderingParams); + HRESULT (STDMETHODCALLTYPE *CreateCustomRenderingParams) + (IDWriteFactory *This, FLOAT gamma, FLOAT enhancedContrast, + FLOAT cleartype_level, DWRITE_PIXEL_GEOMETRY geometry, + DWRITE_RENDERING_MODE mode, IDWriteRenderingParams **params); + EMACS_DWRITE_UNUSED (RegisterFontFileLoader); + EMACS_DWRITE_UNUSED (UnregisterFontFileLoader); + EMACS_DWRITE_UNUSED (CreateTextFormat); + EMACS_DWRITE_UNUSED (CreateTypography); + HRESULT (STDMETHODCALLTYPE *GetGdiInterop) + (IDWriteFactory *This, IDWriteGdiInterop **gdi_interop); + EMACS_DWRITE_UNUSED (CreateTextLayout); + EMACS_DWRITE_UNUSED (CreateGdiCompatibleTextLayout); + EMACS_DWRITE_UNUSED (CreateEllipsisTrimmingSign); + EMACS_DWRITE_UNUSED (CreateTextAnalyzer); + EMACS_DWRITE_UNUSED (CreateNumberSubstitution); + EMACS_DWRITE_UNUSED (CreateGlyphRunAnalysis); + END_INTERFACE +} IDWriteFactoryVtbl; + +interface IDWriteFactory { CONST_VTBL IDWriteFactoryVtbl* lpVtbl; }; + +typedef struct IDWriteColorGlyphRunEnumeratorVtbl { + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteColorGlyphRunEnumerator *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef)(IDWriteColorGlyphRunEnumerator *This); + ULONG (STDMETHODCALLTYPE *Release)(IDWriteColorGlyphRunEnumerator *This); + + HRESULT (STDMETHODCALLTYPE *MoveNext)( + IDWriteColorGlyphRunEnumerator *This, + WINBOOL *hasRun); + + HRESULT (STDMETHODCALLTYPE *GetCurrentRun)( + IDWriteColorGlyphRunEnumerator *This, + const DWRITE_COLOR_GLYPH_RUN **run); + + END_INTERFACE +} IDWriteColorGlyphRunEnumeratorVtbl; + +interface IDWriteColorGlyphRunEnumerator { + CONST_VTBL IDWriteColorGlyphRunEnumeratorVtbl* lpVtbl; +}; + +typedef struct IDWriteFactory2Vtbl { + BEGIN_INTERFACE + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteFactory2 *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef)(IDWriteFactory2 *This); + ULONG (STDMETHODCALLTYPE *Release)(IDWriteFactory2 *This); + EMACS_DWRITE_UNUSED (GetSystemFontCollection); + EMACS_DWRITE_UNUSED (CreateCustomFontCollection); + EMACS_DWRITE_UNUSED (RegisterFontCollectionLoader); + EMACS_DWRITE_UNUSED (UnregisterFontCollectionLoader); + EMACS_DWRITE_UNUSED (CreateFontFileReference); + EMACS_DWRITE_UNUSED (CreateCustomFontFileReference); + EMACS_DWRITE_UNUSED (CreateFontFace); + EMACS_DWRITE_UNUSED (CreateRenderingParams); + EMACS_DWRITE_UNUSED (CreateMonitorRenderingParams); + EMACS_DWRITE_UNUSED (CreateCustomRenderingParams); + EMACS_DWRITE_UNUSED (RegisterFontFileLoader); + EMACS_DWRITE_UNUSED (UnregisterFontFileLoader); + EMACS_DWRITE_UNUSED (CreateTextFormat); + EMACS_DWRITE_UNUSED (CreateTypography); + EMACS_DWRITE_UNUSED (GetGdiInterop); + EMACS_DWRITE_UNUSED (CreateTextLayout); + EMACS_DWRITE_UNUSED (CreateGdiCompatibleTextLayout); + EMACS_DWRITE_UNUSED (CreateEllipsisTrimmingSign); + EMACS_DWRITE_UNUSED (CreateTextAnalyzer); + EMACS_DWRITE_UNUSED (CreateNumberSubstitution); + EMACS_DWRITE_UNUSED (CreateGlyphRunAnalysis); + + EMACS_DWRITE_UNUSED (GetEudcFontCollection); + EMACS_DWRITE_UNUSED (IDWriteFactory1_CreateCustomRenderingParams); + + EMACS_DWRITE_UNUSED (GetSystemFontFallback); + EMACS_DWRITE_UNUSED (CreateFontFallbackBuilder); + HRESULT (STDMETHODCALLTYPE *TranslateColorGlyphRun) + (IDWriteFactory2 *This, + FLOAT originX, + FLOAT originY, + const DWRITE_GLYPH_RUN *run, + void *rundescr, + DWRITE_MEASURING_MODE mode, + void *transform, + UINT32 palette_index, + IDWriteColorGlyphRunEnumerator **colorlayers); + + EMACS_DWRITE_UNUSED (IDWriteFactory2_CreateCustomRenderingParams); + EMACS_DWRITE_UNUSED (IDWriteFactory2_CreateGlyphRunAnalysis); + END_INTERFACE +} IDWriteFactory2Vtbl; + +interface IDWriteFactory2 { + CONST_VTBL IDWriteFactory2Vtbl* lpVtbl; +}; +#else /* ifndef MINGW_W64 */ +# include +#endif + +/* User configurable variables. If they are lower than 0 use + DirectWrite's defaults, or our defaults. To set them, the user calls + 'w32-dwrite-reinit' */ +static float config_enhanced_contrast = -1.0f; +static float config_clear_type_level = -1.0f; +static float config_gamma = -1.0f; + +/* Values to use for DirectWrite rendering. */ +#define MEASURING_MODE DWRITE_MEASURING_MODE_NATURAL +#define RENDERING_MODE DWRITE_RENDERING_MODE_NATURAL_SYMMETRIC +#define ANTIALIAS_MODE DWRITE_TEXT_ANTIALIAS_MODE_CLEARTYPE + +static void +release_com (IUnknown **i) +{ + if ( *i ) + { + ((IUnknown *) (*i))->lpVtbl->Release (*i); + *i = NULL; + } +} + +#define RELEASE_COM(i) release_com ( (IUnknown **) &i ) + +/* Global variables for DirectWrite. */ +static bool direct_write_available = false; +static IDWriteFactory *dwrite_factory = NULL; +static IDWriteFactory2 *dwrite_factory2 = NULL; +static IDWriteGdiInterop *gdi_interop = NULL; +static IDWriteRenderingParams *rendering_params = NULL; + +static bool +verify_hr (HRESULT hr, const char *msg) +{ + if (FAILED (hr)) + { + DebPrint (("DirectWrite HRESULT failed: (%d) %s\n", hr, msg)); + eassert (SUCCEEDED (hr)); + return false; + } + return true; +} + +/* Gets a IDWriteFontFace from a struct font (its HFONT). Returns the + font size in points. It may fail to get a DirectWrite font, and face + will be NULL on return. This happens for some fonts like Courier. + + Never call Release on the result, as it is cached for reuse on the + struct font. */ +static float +get_font_face (struct font *infont, IDWriteFontFace **face) +{ + HRESULT hr; + LOGFONTW logfont; + IDWriteFont *font; + + struct uniscribe_font_info *uniscribe_font = + (struct uniscribe_font_info *) infont; + + /* Check the cache. */ + *face = uniscribe_font->dwrite_cache; + if (*face) + return uniscribe_font->dwrite_font_size; + + GetObjectW (FONT_HANDLE(infont), sizeof (LOGFONTW), &logfont); + + hr = gdi_interop->lpVtbl->CreateFontFromLOGFONT (gdi_interop, + (const LOGFONTW *) &logfont, + &font); + + if (!verify_hr (hr, "Failed to CreateFontFromLOGFONT")) + { + uniscribe_font->dwrite_skip_font = true; + *face = NULL; + return 0.0; + } + + hr = font->lpVtbl->CreateFontFace (font, face); + RELEASE_COM (font); + if (!verify_hr (hr, "Failed to create DWriteFontFace")) + { + uniscribe_font->dwrite_skip_font = true; + *face = NULL; + return 0.0; + } + + /* Cache this FontFace. */ + uniscribe_font->dwrite_font_size = abs (logfont.lfHeight); + uniscribe_font->dwrite_cache = *face; + + return abs (logfont.lfHeight); +} + +void +w32_dwrite_free_cached_face (void *cache) +{ + if (cache) + RELEASE_COM (cache); +} + +static float +convert_metrics_sz (int sz, float font_size, int units_per_em) +{ + return (float) sz * font_size / units_per_em; +} + +/* Does not fill in the ascent and descent fields of metrics. */ +static bool +text_extents_internal (IDWriteFontFace *dwrite_font_face, + float font_size, const unsigned *code, + int nglyphs, struct font_metrics *metrics) +{ + HRESULT hr; + + USE_SAFE_ALLOCA; + + DWRITE_FONT_METRICS dwrite_font_metrics; + dwrite_font_face->lpVtbl->GetMetrics (dwrite_font_face, + &dwrite_font_metrics); + + UINT16 *indices = SAFE_ALLOCA (nglyphs * sizeof (UINT16)); + for (int i = 0; i < nglyphs; i++) + indices[i] = code[i]; + + DWRITE_GLYPH_METRICS* gmetrics = + SAFE_ALLOCA (nglyphs * sizeof (DWRITE_GLYPH_METRICS)); + + hr = dwrite_font_face->lpVtbl->GetGdiCompatibleGlyphMetrics (dwrite_font_face, + font_size, + 1.0, + NULL, + TRUE, + indices, + nglyphs, + gmetrics, + false); + if (!verify_hr (hr, "Failed to GetGdiCompatibleGlyphMetrics")) + { + SAFE_FREE (); + return false; + } + + float width = 0; + int du_per_em = dwrite_font_metrics.designUnitsPerEm; + + for (int i = 0; i < nglyphs; i++) + { + float advance = + convert_metrics_sz (gmetrics[i].advanceWidth, font_size, du_per_em); + + width += advance; + + float lbearing = + round (convert_metrics_sz (gmetrics[i].leftSideBearing, font_size, + du_per_em)); + float rbearing = + round (advance - + convert_metrics_sz (gmetrics[i].rightSideBearing, + font_size, du_per_em)); + if (i == 0) + { + metrics->lbearing = lbearing; + metrics->rbearing = rbearing; + } + if (metrics->lbearing > lbearing) + metrics->lbearing = lbearing; + if (metrics->rbearing < rbearing) + metrics->rbearing = rbearing; + } + metrics->width = round(width); + SAFE_FREE (); + return true; +} + +unsigned +w32_dwrite_encode_char (struct font *font, int c) +{ + HRESULT hr; + IDWriteFontFace *dwrite_font_face; + UINT16 index; + + get_font_face (font, &dwrite_font_face); + if (dwrite_font_face == NULL) + return FONT_INVALID_CODE; + hr = dwrite_font_face->lpVtbl->GetGlyphIndices (dwrite_font_face, + &c, 1, &index); + if (verify_hr (hr, "Failed to GetGlyphIndices")) + { + if (index == 0) + return FONT_INVALID_CODE; + return index; + } + ((struct uniscribe_font_info *) font)->dwrite_skip_font = true; + return FONT_INVALID_CODE; +} + +bool +w32_dwrite_text_extents (struct font *font, const unsigned *code, int nglyphs, + struct font_metrics *metrics) +{ + IDWriteFontFace *dwrite_font_face; + + float font_size = get_font_face (font, &dwrite_font_face); + + if (dwrite_font_face == NULL) + return false; + + /* We can get fonts with a size of 0. GDI handles this by using a default + size. We do the same. */ + if (font_size <= 0.0f) + font_size = FRAME_LINE_HEIGHT (SELECTED_FRAME ()); + + metrics->ascent = font->ascent; + metrics->descent = font->descent; + + return text_extents_internal (dwrite_font_face, font_size, code, nglyphs, + metrics); +} + +/* Never call Release on the value returned by this function, as it is + reused. */ +static IDWriteBitmapRenderTarget * +get_bitmap_render_target (HDC hdc, int width, int height) +{ + HRESULT hr; + static IDWriteBitmapRenderTarget *brt = NULL; + static SIZE size = {0, 0}; + + if (brt) + { + /* Check if we need to make a bigger one. */ + if (width <= size.cx && height <= size.cy) + return brt; + RELEASE_COM (brt); + } + + if (width > size.cx) + size.cx = width; + if (height > size.cy) + size.cy = height; + + hr = gdi_interop->lpVtbl->CreateBitmapRenderTarget (gdi_interop, + hdc, + size.cx, size.cy, + &brt); + if (!verify_hr (hr, "Failed to CreateBitmapRenderTarget")) + return NULL; + + /* We handle high dpi displays by incresing font size, so override + PixelsPerDip. */ + brt->lpVtbl->SetPixelsPerDip (brt, 1.0); + + /* The SetTextAntialiasMode method is only available in + IDWriteBitmapRenderTarget1. */ + IDWriteBitmapRenderTarget1 *brt1; + hr = brt->lpVtbl->QueryInterface (brt, + &IID_IDWriteBitmapRenderTarget1, + (void **) &brt1); + /* This error should not happen, but is not catastrofic */ + if (verify_hr (hr, "Failed to QueryInterface for IDWriteBitmapRenderTarget1")) + { + brt1->lpVtbl->SetTextAntialiasMode (brt1, ANTIALIAS_MODE); + RELEASE_COM (brt1); + } + + return brt; +} + +void +w32_initialize_direct_write (void) +{ + direct_write_available = false; + + if (dwrite_factory) + { + RELEASE_COM (dwrite_factory); + RELEASE_COM (dwrite_factory2); + RELEASE_COM (gdi_interop); + RELEASE_COM (rendering_params); + } + + HMODULE direct_write = LoadLibrary ("dwrite.dll"); + if (!direct_write) + return; + + /* This is only used here, no need to define it globally. */ + typedef HRESULT (WINAPI *DWCreateFactory) (DWRITE_FACTORY_TYPE f, REFIID r, IUnknown** u); + + DWCreateFactory dw_create_factory + = (DWCreateFactory) get_proc_addr (direct_write, + "DWriteCreateFactory"); + + if (!dw_create_factory) + { + FreeLibrary (direct_write); + return; + } + + HRESULT hr = dw_create_factory (DWRITE_FACTORY_TYPE_SHARED, + &IID_IDWriteFactory, + (IUnknown **) &dwrite_factory); + if (FAILED (hr)) + { + DebPrint (("DirectWrite HRESULT failed: (%d) CreateFactory\n", hr)); + FreeLibrary (direct_write); + eassert (SUCCEEDED (hr)); + return; + } + + /* IDWriteFactory2 is only available on Windows 8.1 and later. + Without this, we can't use color fonts. So we disable DirectWrite + if it is not available. */ + hr = dwrite_factory->lpVtbl->QueryInterface (dwrite_factory, + &IID_IDWriteFactory2, + (void **) &dwrite_factory2); + + if (FAILED (hr)) + { + DebPrint (("DirectWrite HRESULT failed: (%d) QueryInterface IDWriteFactory2\n", hr)); + RELEASE_COM (dwrite_factory); + FreeLibrary (direct_write); + eassert (SUCCEEDED (hr)); + return; + } + + hr = dwrite_factory->lpVtbl->GetGdiInterop (dwrite_factory, + &gdi_interop); + if (FAILED (hr)) + { + DebPrint (("DirectWrite HRESULT failed: (%d) GetGdiInterop\n", hr)); + RELEASE_COM (dwrite_factory); + RELEASE_COM (dwrite_factory2); + FreeLibrary (direct_write); + eassert (SUCCEEDED (hr)); + return; + } + + IDWriteRenderingParams *def; + + hr = dwrite_factory->lpVtbl->CreateRenderingParams (dwrite_factory, + &def); + if (FAILED (hr)) + { + DebPrint (("DirectWrite HRESULT failed: (%d) CreateRenderingParams\n", hr)); + RELEASE_COM (dwrite_factory); + RELEASE_COM (dwrite_factory2); + RELEASE_COM (gdi_interop); + FreeLibrary (direct_write); + eassert (SUCCEEDED (hr)); + return; + } + + /* range: [0.0, 1.0] */ + if (config_enhanced_contrast < 0.0f || config_enhanced_contrast > 1.0f) + config_enhanced_contrast = def->lpVtbl->GetEnhancedContrast (def); + + /* range: [0.0, 1.0] */ + if (config_clear_type_level < 0.0f || config_clear_type_level > 1.0f) + config_clear_type_level = def->lpVtbl->GetClearTypeLevel (def); + + /* range: (0.0, 256.0] */ + /* We change the default value of 2.2 for gamma to 1.4, that looks + very similar to GDI. The default looks too dim for emacs, + subjectively. */ + if (config_gamma <= 0.0f || config_gamma > 256.0f) + config_gamma = 1.4; /* def->lpVtbl->GetGamma (def); */ + + hr = dwrite_factory->lpVtbl->CreateCustomRenderingParams (dwrite_factory, + config_gamma, + config_enhanced_contrast, + config_clear_type_level, + def->lpVtbl->GetPixelGeometry(def), + RENDERING_MODE, + &rendering_params); + + RELEASE_COM (def); + + if (FAILED (hr)) + { + DebPrint (("DirectWrite HRESULT failed: (%d) CreateCustomRenderingParams\n", hr)); + RELEASE_COM (dwrite_factory); + RELEASE_COM (dwrite_factory2); + RELEASE_COM (gdi_interop); + FreeLibrary (direct_write); + eassert (SUCCEEDED (hr)); + return; + } + + direct_write_available = true; + + w32_inhibit_dwrite = false; +} + +bool +w32_dwrite_draw (HDC hdc, int x, int y, unsigned *glyphs, int len, + COLORREF color, struct font *font) +{ + HRESULT hr; + IDWriteFontFace *dwrite_font_face; + + USE_SAFE_ALLOCA; + + struct uniscribe_font_info *uniscribe_font = + (struct uniscribe_font_info *) font; + + /* What we get as y is the baseline position. */ + y -= font->ascent; + + float font_size = get_font_face (font, &dwrite_font_face); + if (dwrite_font_face == NULL) + return false; + + struct font_metrics metrics; + if (!text_extents_internal (dwrite_font_face, font_size, glyphs, len, + &metrics)) + { + uniscribe_font->dwrite_skip_font = true; + return false; + } + + int bitmap_width = metrics.width + metrics.rbearing; + int bitmap_height = font->ascent + font->descent; + + /* We never release this, get_bitmap_render_target reuses it. */ + IDWriteBitmapRenderTarget *bitmap_render_target = + get_bitmap_render_target (hdc, bitmap_width, bitmap_height); + + /* If this fails, completely disable DirectWrite. */ + if (bitmap_render_target == NULL) + { + direct_write_available = false; + return false; + } + + /* This DC can't be released. */ + HDC text_dc = bitmap_render_target->lpVtbl->GetMemoryDC + (bitmap_render_target); + + /* Copy the background pixel to the render target bitmap. */ + BitBlt (text_dc, 0, 0, bitmap_width, bitmap_height, hdc, x, y, SRCCOPY); + + UINT16 *indices = SAFE_ALLOCA (len * sizeof (UINT16)); + + for (int i = 0; i < len; i++) + indices[i] = glyphs[i]; + + FLOAT *advances = SAFE_ALLOCA (len * sizeof (FLOAT)); + + for (int i = 0; i < len; i++) + { + if (!text_extents_internal (dwrite_font_face, font_size, glyphs + i, 1, + &metrics)) + { + uniscribe_font->dwrite_skip_font = true; + SAFE_FREE (); + return false; + } + advances[i] = metrics.width; + } + + DWRITE_GLYPH_RUN glyph_run; + glyph_run.fontFace = dwrite_font_face; + glyph_run.fontEmSize = font_size; + glyph_run.glyphIndices = indices; + glyph_run.glyphCount = len; + glyph_run.isSideways = false; + glyph_run.bidiLevel = 0; + glyph_run.glyphOffsets = NULL; + glyph_run.glyphAdvances = advances; + + IDWriteColorGlyphRunEnumerator *layers; + /* This call will tell us if we hace to handle any color glyph. */ + hr = dwrite_factory2->lpVtbl->TranslateColorGlyphRun (dwrite_factory2, + 0, font->ascent, + &glyph_run, + NULL, + MEASURING_MODE, + NULL, + 0, + &layers); + + /* No color. Just draw the GlyphRun. */ + if (hr == DWRITE_E_NOCOLOR) + bitmap_render_target->lpVtbl->DrawGlyphRun (bitmap_render_target, + 0, font->ascent, + MEASURING_MODE, + &glyph_run, + rendering_params, + color, + NULL); + else + { + /* If there were color glyphs, layers contains a list of GlyphRun + with a color and a position for each. We draw them + individually. */ + if (!verify_hr (hr, "Failed at TranslateColorGlyphRun")) + { + uniscribe_font->dwrite_skip_font = true; + RELEASE_COM (layers); + SAFE_FREE (); + return false; + } + for (;;) + { + HRESULT hr; + BOOL more_layers; + const DWRITE_COLOR_GLYPH_RUN *layer; + + hr = layers->lpVtbl->MoveNext (layers, &more_layers); + if (!verify_hr (hr, "Failed at MoveNext")) + { + uniscribe_font->dwrite_skip_font = true; + RELEASE_COM (layers); + SAFE_FREE (); + return false; + } + if (!more_layers) + break; + hr = layers->lpVtbl->GetCurrentRun (layers, &layer); + if (!verify_hr (hr, "Failed at GetCurrentRun")) + { + uniscribe_font->dwrite_skip_font = true; + RELEASE_COM (layers); + SAFE_FREE (); + return false; + } + hr = bitmap_render_target->lpVtbl->DrawGlyphRun + (bitmap_render_target, + layer->baselineOriginX, + layer->baselineOriginY, + MEASURING_MODE, + &layer->glyphRun, + rendering_params, + RGB (layer->runColor.r * 255, + layer->runColor.g * 255, + layer->runColor.b * 255), + NULL); + if (!verify_hr (hr, "Failed at GetCurrentRun")) + { + uniscribe_font->dwrite_skip_font = true; + RELEASE_COM (layers); + SAFE_FREE (); + return false; + } + } + RELEASE_COM (layers); + } + + /* Finally, copy the rendered text back to the original DC. */ + BitBlt (hdc, x, y, bitmap_width, bitmap_height, text_dc, 0, 0, SRCCOPY); + SAFE_FREE (); + return true; +} + +/* Returns true if DirectWrite is to be used: + - It is available. + - The font is handled by HarfBuzz. + - w32-inhibit-dwrite is false. + - The font has not been marked after a failed DirectWrite operation. +*/ +bool +w32_use_direct_write (struct w32font_info *w32font) +{ +#ifdef HAVE_HARFBUZZ + return direct_write_available + && w32font->font.driver == &harfbuzz_font_driver + && !w32_inhibit_dwrite + && !((struct uniscribe_font_info *) w32font)->dwrite_skip_font; +#else + return false; +#endif +} + +DEFUN ("w32-dwrite-available", Fw32_dwrite_available, Sw32_dwrite_available, 0, 0, 0, + doc: /* Returns t if DirectWrite is available. +DirectWrite will be used if it is available and 'w32-inhibit-dwrite' is nil. */) + (void) +{ + return direct_write_available ? Qt : Qnil; +} + +DEFUN ("w32-dwrite-reinit", Fw32_dwrite_reinit, Sw32_dwrite_reinit, 0, 3, 0, + doc: /* Reinitialize DirectWrite with the given parameters. +If a parameter is not specified, or is out of range, it will take a default +value. Returns nil. + +ENHANCED_CONTRAST is in the range [0.0, 1.0] +CLEAR_TYPE_LEVEL is in the range [0.0, 1.0] +GAMMA is in the range (0.0, 256.0] */) + (Lisp_Object enhanced_contrast, Lisp_Object clear_type_level, + Lisp_Object gamma) +{ + config_enhanced_contrast = -1.0f; + if (FLOATP (enhanced_contrast)) + config_enhanced_contrast = XFLOAT_DATA (enhanced_contrast); + if (FIXNUMP (enhanced_contrast)) + config_enhanced_contrast = XFIXNUM (enhanced_contrast); + + config_clear_type_level = -1.0f; + if (FLOATP (clear_type_level)) + config_clear_type_level = XFLOAT_DATA (clear_type_level); + if (FIXNUMP (clear_type_level)) + config_clear_type_level = XFIXNUM (clear_type_level); + + config_gamma = -1.0f; + if (FLOATP (gamma)) + config_gamma = XFLOAT_DATA (gamma); + if (FIXNUMP (gamma)) + config_gamma = XFIXNUM (gamma); + + w32_initialize_direct_write (); + + return Qnil; +} + +void +syms_of_w32dwrite (void) +{ + DEFVAR_BOOL ("w32-inhibit-dwrite", w32_inhibit_dwrite, + doc: /* If t, don't use DirectWrite. */); + + defsubr (&Sw32_dwrite_reinit); + defsubr (&Sw32_dwrite_available); +} diff --git a/src/w32font.c b/src/w32font.c index efb42d80336..05e5a067f20 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -452,6 +452,10 @@ w32font_text_extents (struct font *font, const unsigned *code, memset (metrics, 0, sizeof (struct font_metrics)); + if (w32_use_direct_write (w32_font)) + if (w32_dwrite_text_extents (font, code, nglyphs, metrics)) + return; + for (i = 0, first = true; i < nglyphs; i++) { struct w32_metric_cache *char_metric; @@ -706,22 +710,31 @@ w32font_draw (struct glyph_string *s, int from, int to, int i; for (i = 0; i < len; i++) - { - WCHAR c = s->char2b[from + i] & 0xFFFF; - ExtTextOutW (s->hdc, x + i, y, options, NULL, &c, 1, NULL); - } + if (!w32_use_direct_write (w32font) || + !w32_dwrite_draw (s->hdc, x, y, s->char2b + from, 1, + GetTextColor(s->hdc), s->font)) + { + WCHAR c = s->char2b[from + i] & 0xFFFF; + ExtTextOutW (s->hdc, x + i, y, options, NULL, &c, 1, NULL); + } } else { - /* The number of glyphs in a glyph_string cannot be larger than - the maximum value of the 'used' member of a glyph_row, so we - are OK using alloca here. */ - eassert (len <= SHRT_MAX); - WCHAR *chars = alloca (len * sizeof (WCHAR)); - int j; - for (j = 0; j < len; j++) - chars[j] = s->char2b[from + j] & 0xFFFF; - ExtTextOutW (s->hdc, x, y, options, NULL, chars, len, NULL); + if (!w32_use_direct_write (w32font) || + !w32_dwrite_draw (s->hdc, x, y, + s->char2b + from, len, GetTextColor(s->hdc), + s->font)) + { + /* The number of glyphs in a glyph_string cannot be larger than + the maximum value of the 'used' member of a glyph_row, so we + are OK using alloca here. */ + eassert (len <= SHRT_MAX); + WCHAR *chars = alloca (len * sizeof (WCHAR)); + int j; + for (j = 0; j < len; j++) + chars[j] = s->char2b[from + j] & 0xFFFF; + ExtTextOutW (s->hdc, x, y, options, NULL, chars, len, NULL); + } } /* Restore clip region. */ diff --git a/src/w32font.h b/src/w32font.h index 3f780c1d866..75e63e4a32e 100644 --- a/src/w32font.h +++ b/src/w32font.h @@ -57,6 +57,26 @@ struct w32font_info HFONT hfont; }; +/* Extension of w32font_info used by Uniscribe and HarfBuzz backends. */ +struct uniscribe_font_info +{ + struct w32font_info w32_font; + /* This is used by the Uniscribe backend as a pointer to the script + cache, and by the HarfBuzz backend as a pointer to a hb_font_t + object. */ + void *cache; + /* This is used by the HarfBuzz backend to store the font scale. */ + double scale; + /* This is used by DirectWrite to store the FontFace object. + DirectWrite works on top of the HarfBuzz backend, modifying some + calls. If there are problems manipulating this font, + dwrite_skip_font is set to true. Future operations will not use + DirectWrite and fall back to the HarfBuzz backend. */ + void *dwrite_cache; + float dwrite_font_size; + bool dwrite_skip_font; +}; + /* Macros for getting OS specific information from a font struct. */ #define FONT_HANDLE(f) (((struct w32font_info *)(f))->hfont) #define FONT_TEXTMETRIC(f) (((struct w32font_info *)(f))->metrics) @@ -84,6 +104,17 @@ int uniscribe_check_otf (LOGFONT *font, Lisp_Object otf_spec); Lisp_Object intern_font_name (char *); +/* Function prototypes for DirectWrite. */ +void w32_initialize_direct_write (void); +bool w32_use_direct_write (struct w32font_info *w32font); +bool w32_dwrite_draw (HDC hdc, int x, int y, unsigned *glyphs, int len, + COLORREF color, struct font *font ); +bool w32_dwrite_text_extents (struct font *font, const unsigned *code, + int nglyphs, struct font_metrics *metrics); +unsigned w32_dwrite_encode_char (struct font *font, int c); +void w32_dwrite_free_cached_face(void *cache); +void syms_of_w32dwrite (void); + extern void globals_of_w32font (void); #endif diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index b77bf56b8cf..015214b1e39 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c @@ -44,18 +44,6 @@ along with GNU Emacs. If not, see . */ #include "pdumper.h" #include "w32common.h" -/* Extension of w32font_info used by Uniscribe and HarfBuzz backends. */ -struct uniscribe_font_info -{ - struct w32font_info w32_font; - /* This is used by the Uniscribe backend as a pointer to the script - cache, and by the HarfBuzz backend as a pointer to a hb_font_t - object. */ - void *cache; - /* This is used by the HarfBuzz backend to store the font scale. */ - double scale; -}; - int uniscribe_available = 0; /* EnumFontFamiliesEx callback. */ @@ -200,6 +188,9 @@ uniscribe_open (struct frame *f, Lisp_Object font_entity, int pixel_size) /* Initialize the cache for this font. */ uniscribe_font->cache = NULL; + uniscribe_font->dwrite_cache = NULL; + + uniscribe_font->dwrite_skip_font = false; /* Uniscribe and HarfBuzz backends use glyph indices. */ uniscribe_font->w32_font.glyph_idx = ETO_GLYPH_INDEX; @@ -221,6 +212,7 @@ uniscribe_close (struct font *font) = (struct uniscribe_font_info *) font; #ifdef HAVE_HARFBUZZ + w32_dwrite_free_cached_face (uniscribe_font->dwrite_cache); if (uniscribe_font->w32_font.font.driver == &harfbuzz_font_driver && uniscribe_font->cache) hb_font_destroy ((hb_font_t *) uniscribe_font->cache); @@ -1372,6 +1364,17 @@ w32hb_encode_char (struct font *font, int c) struct uniscribe_font_info *uniscribe_font = (struct uniscribe_font_info *) font; eassert (uniscribe_font->w32_font.font.driver == &harfbuzz_font_driver); + + if (w32_use_direct_write (&uniscribe_font->w32_font)) + { + unsigned encoded = w32_dwrite_encode_char (font, c); + + /* The call to w32_dwrite_encode_char may fail, disabling + DirectWrite for this font. So check again. */ + if (w32_use_direct_write (&uniscribe_font->w32_font)) + return encoded; + } + hb_font_t *hb_font = uniscribe_font->cache; /* First time we use this font with HarfBuzz, create the hb_font_t @@ -1510,6 +1513,7 @@ static void syms_of_w32uniscribe_for_pdumper (void); void syms_of_w32uniscribe (void) { + syms_of_w32dwrite (); pdumper_do_now_and_after_load (syms_of_w32uniscribe_for_pdumper); } @@ -1624,5 +1628,8 @@ syms_of_w32uniscribe_for_pdumper (void) harfbuzz_font_driver.combining_capability = hbfont_combining_capability; harfbuzz_font_driver.begin_hb_font = w32hb_begin_font; register_font_driver (&harfbuzz_font_driver, NULL); + + w32_initialize_direct_write (); + #endif /* HAVE_HARFBUZZ */ } commit 517711c373b9c80811371014fc5a7786aa7548eb Author: Eli Zaretskii Date: Fri Oct 25 13:41:27 2024 +0300 ; * etc/NEWS: Fix wording of recently-added entry. diff --git a/etc/NEWS b/etc/NEWS index b7f13e770d5..b9f58c846db 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -782,7 +782,7 @@ and later versions. --- ** Emacs on MS-Windows now supports drag-n-drop of text into a buffer. This is in addition to drag-n-drop of files, that was already -supported. The configuration variables 'dnd-scroll-margin' and +supported. As on X, the user options 'dnd-scroll-margin' and 'dnd-indicate-insertion-point' can be used to customize the process. commit 3eb2a85d10e0ad7b50e96ee4e80ba08b3a71b9ae Author: Cecilio Pardo Date: Wed Oct 23 14:41:24 2024 +0200 Improve drag and drop on MS-Windows (bug#3468) Add support for 'dnd-scroll-margin' and 'dnd-indicate-insertion-point' by calling 'dnd-handle-movement' when dragging the mouse. * lisp/term/w32-win.el (w32-drag-n-drop): Call 'dnd-handle-movement' when applicable. * src/w32fns.c (w32_handle_drag_movement): New function, sends a WM_EMACS_DRAGOVER message. (w32_drop_target_DragEnter): Call 'w32_handle_drag_movement'. (w32_drop_target_DragOver): Call 'w32_handle_drag_movement'. * src/w32term.c: (w32_read_socket): Handle WM_EMACS_DRAGOVER, sending a drag-n-drop event. * src/w32term.h: Define new WM_EMACS_DRAGOVER message. diff --git a/etc/NEWS b/etc/NEWS index a4a036cbb50..b7f13e770d5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -781,7 +781,9 @@ and later versions. --- ** Emacs on MS-Windows now supports drag-n-drop of text into a buffer. -This is in addition to drag-n-drop of files, that was already supported. +This is in addition to drag-n-drop of files, that was already +supported. The configuration variables 'dnd-scroll-margin' and +'dnd-indicate-insertion-point' can be used to customize the process. ---------------------------------------------------------------------- diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 541fef2ced3..75f8530010c 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -137,35 +137,40 @@ buffers, and switch to the buffer that visits the last dropped file. If EVENT is for text, insert that text at point into the buffer shown in the window that is the target of the drop; if that buffer is read-only, add the dropped text to kill-ring. +If EVENT payload is nil, then this is a drag event. If the optional argument NEW-FRAME is non-nil, perform the drag-n-drop action in a newly-created frame using its selected-window and that window's buffer." (interactive "e") - (save-excursion - ;; Make sure the drop target has positive co-ords - ;; before setting the selected frame - otherwise it - ;; won't work. - (let* ((window (posn-window (event-start event))) - (coords (posn-x-y (event-start event))) - (arg (car (cdr (cdr event)))) - (x (car coords)) - (y (cdr coords))) - (if (and (> x 0) (> y 0)) - (set-frame-selected-window nil window)) - - (when new-frame - (select-frame (make-frame))) - (raise-frame) - (setq window (selected-window)) - - ;; arg (the payload of the event) is a string when the drop is - ;; text, and a list of strings when the drop is one or more files. - (if (stringp arg) - (dnd-insert-text window 'copy arg) - (dnd-handle-multiple-urls - window - (mapcar #'w32-dropped-file-to-url arg) - 'private))))) + ;; Make sure the drop target has positive co-ords + ;; before setting the selected frame - otherwise it + ;; won't work. + (let* ((window (posn-window (event-start event))) + (coords (posn-x-y (event-start event))) + (arg (car (cdr (cdr event)))) + (x (car coords)) + (y (cdr coords))) + + (if (and (> x 0) (> y 0) (window-live-p window)) + (set-frame-selected-window nil window)) + ;; Don't create new frame if we are just dragging + (and arg new-frame + (select-frame (make-frame))) + (raise-frame) + (setq window (selected-window)) + + ;; arg (the payload of the event) is a string when the drop is + ;; text, and a list of strings when the drop is one or more files. + ;; It is nil if the event is a drag event. + (if arg + (save-excursion + (if (stringp arg) + (dnd-insert-text window 'copy arg) + (dnd-handle-multiple-urls + window + (mapcar #'w32-dropped-file-to-url arg) + 'private))) + (dnd-handle-movement (event-start event))))) (defun w32-drag-n-drop-other-frame (event) "Edit the files listed in the drag-n-drop EVENT, in other frames. diff --git a/src/w32fns.c b/src/w32fns.c index 3ee13dcbbdd..eb42d3b61b2 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -2505,7 +2505,6 @@ process_dropfiles (DROPFILES *files) return lisp_files; } - /* This function can be called ONLY between calls to block_input/unblock_input. It is used in w32_read_socket. */ Lisp_Object @@ -2572,6 +2571,19 @@ w32_drop_target_Release (IDropTarget *This) return 0; } +static void +w32_handle_drag_movement (IDropTarget *This, POINTL pt) +{ + struct w32_drop_target *target = (struct w32_drop_target *)This; + + W32Msg msg = {0}; + msg.dwModifiers = w32_get_modifiers (); + msg.msg.time = GetMessageTime (); + msg.msg.pt.x = pt.x; + msg.msg.pt.y = pt.y; + my_post_msg (&msg, target->hwnd, WM_EMACS_DRAGOVER, 0, 0 ); +} + static HRESULT STDMETHODCALLTYPE w32_drop_target_DragEnter (IDropTarget *This, IDataObject *pDataObj, DWORD grfKeyState, POINTL pt, DWORD *pdwEffect) @@ -2581,6 +2593,7 @@ w32_drop_target_DragEnter (IDropTarget *This, IDataObject *pDataObj, happen on drop. We send COPY because our use cases don't modify or link to the original data. */ *pdwEffect = DROPEFFECT_COPY; + w32_handle_drag_movement (This, pt); return S_OK; } @@ -2590,6 +2603,7 @@ w32_drop_target_DragOver (IDropTarget *This, DWORD grfKeyState, POINTL pt, { /* See comment in w32_drop_target_DragEnter. */ *pdwEffect = DROPEFFECT_COPY; + w32_handle_drag_movement (This, pt); return S_OK; } @@ -3607,6 +3621,7 @@ w32_name_of_message (UINT msg) M (WM_EMACS_PAINT), M (WM_EMACS_IME_STATUS), M (WM_CHAR), + M (WM_EMACS_DRAGOVER), M (WM_EMACS_DROP), #undef M { 0, 0 } diff --git a/src/w32term.c b/src/w32term.c index 3a627308137..88622700386 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -5629,6 +5629,24 @@ w32_read_socket (struct terminal *terminal, } break; + case WM_EMACS_DRAGOVER: + { + f = w32_window_to_frame (dpyinfo, msg.msg.hwnd); + if (!f) + break; + XSETFRAME (inev.frame_or_window, f); + inev.kind = DRAG_N_DROP_EVENT; + inev.code = 0; + inev.timestamp = msg.msg.time; + inev.modifiers = msg.dwModifiers; + ScreenToClient (msg.msg.hwnd, &msg.msg.pt); + XSETINT (inev.x, msg.msg.pt.x); + XSETINT (inev.y, msg.msg.pt.y); + /* This is a drag movement. */ + inev.arg = Qnil; + break; + } + case WM_HSCROLL: { struct scroll_bar *bar = diff --git a/src/w32term.h b/src/w32term.h index 39e2262e2a8..cad9fcf8cb1 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -711,8 +711,9 @@ do { \ #define WM_EMACS_INPUT_READY (WM_EMACS_START + 24) #define WM_EMACS_FILENOTIFY (WM_EMACS_START + 25) #define WM_EMACS_IME_STATUS (WM_EMACS_START + 26) -#define WM_EMACS_DROP (WM_EMACS_START + 27) -#define WM_EMACS_END (WM_EMACS_START + 28) +#define WM_EMACS_DRAGOVER (WM_EMACS_START + 27) +#define WM_EMACS_DROP (WM_EMACS_START + 28) +#define WM_EMACS_END (WM_EMACS_START + 29) #define WND_FONTWIDTH_INDEX (0) #define WND_LINEHEIGHT_INDEX (4) commit 8e37b537160c1560048ac53529ef09de7561963c Author: Eli Zaretskii Date: Fri Oct 25 13:34:53 2024 +0300 Skip *.dylib files in 'loaddefs-generate' * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Add .dylib to extensions of files that are skipped. (Bug#74001) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 50e90cdf94c..bc075fd296d 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -591,7 +591,7 @@ instead of just updating them with the new/changed autoloads." ;; we don't want to depend on whether Emacs was ;; built with or without modules support, nor ;; what is the suffix for the underlying OS. - (unless (string-match "\\.\\(elc\\|so\\|dll\\)" suf) + (unless (string-match "\\.\\(elc\\|so\\|dll\\|dylib\\)" suf) (push suf tmp))) (concat "\\`[^=.].*" (regexp-opt tmp t) "\\'"))) (files (apply #'nconc commit df677f65fd1b4f0d16e59d5df9735139d2a667c8 Author: Sean Whitton Date: Fri Oct 25 12:43:23 2024 +0800 save-buffers-kill-emacs: Adjust confirmation prompt when restarting * lisp/files.el (save-buffers-kill-emacs): When restarting, ask "Really restart Emacs?". diff --git a/lisp/files.el b/lisp/files.el index 114ddc9c259..9c105dbe1a5 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -8490,7 +8490,8 @@ If RESTART, restart Emacs after killing the current Emacs process." ;; Query the user for other things, perhaps. (run-hook-with-args-until-failure 'kill-emacs-query-functions) (or (null confirm) - (funcall confirm "Really exit Emacs? ")) + (funcall confirm (format "Really %s Emacs? " + (if restart "restart" "exit")))) (kill-emacs nil restart)))) (defun save-buffers-kill-terminal (&optional arg) commit 9729353ba019d9e7f603515dbf88cbc8807bb120 Author: Sean Whitton Date: Fri Oct 25 11:13:46 2024 +0800 vc-modify-change-comment: Revert Log View buffer * lisp/vc/vc.el (vc-modify-change-comment): Revert the Log View buffer after modifying the change comment. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index ebe3de5c6c4..e0fe4931e63 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2517,7 +2517,17 @@ the variable `vc-BACKEND-header'." (lambda () (vc-call-backend backend 'log-edit-mode)) (lambda (files comment) (vc-call-backend backend - 'modify-change-comment files rev comment)) + 'modify-change-comment files rev comment) + ;; We are now back in `vc-parent-buffer'. + ;; If this is Log View, then revision IDs might now be + ;; out-of-date, which could be hazardous if the user immediately + ;; tries to use `log-view-modify-change-comment' a second time. + ;; E.g. with Git, `vc-git-modify-change-comment' could create an + ;; "amend!" commit referring to a commit which no longer exists + ;; on the branch, such that it wouldn't be autosquashed. + ;; So refresh the view. + (when (derived-mode-p 'log-view-mode) + (revert-buffer))) nil backend))) ;;;###autoload commit 0d8d5f10ffc62da35c4d317ed4363995e5e62f65 Author: Vincenzo Pupillo Date: Wed Oct 23 20:45:48 2024 +0200 Highlight namespace name in "use" clause. * lisp/progmodes/php-ts-mode.el (php-ts-mode--font-lock-settings): New rule to highlight namespace name in "use" clause. (Bug#73975) diff --git a/lisp/progmodes/php-ts-mode.el b/lisp/progmodes/php-ts-mode.el index 1c5fdb6f617..ce8cf8aa340 100644 --- a/lisp/progmodes/php-ts-mode.el +++ b/lisp/progmodes/php-ts-mode.el @@ -967,6 +967,7 @@ characters of the current line." ,@(when (not (php-ts-mode--test-namespace-use-group-clause-p)) '((namespace_use_group (namespace_use_clause (name) @font-lock-type-face)))) + (namespace_use_clause (name) @font-lock-type-face) (namespace_name "\\" @font-lock-delimiter-face) (namespace_name (name) @font-lock-type-face) (use_declaration (name) @font-lock-property-use-face) commit f33bc659c9110682174157086c60203d55725d20 Author: Eli Zaretskii Date: Thu Oct 24 17:41:02 2024 +0300 Fix error message in charset.c * src/charset.c (Fdefine_charset_internal): Don't reference uninitialized value in error message. (Bug#73985) diff --git a/src/charset.c b/src/charset.c index e8d0826f4c2..f7d80cc3f3e 100644 --- a/src/charset.c +++ b/src/charset.c @@ -1007,7 +1007,8 @@ usage: (define-charset-internal ...) */) i = CODE_POINT_TO_INDEX (&charset, charset.max_code); if (MAX_CHAR - charset.code_offset < i) - error ("Unsupported max char: %d", charset.max_char); + error ("Unsupported max char: %d + %ud > MAX_CHAR (%d)", + i, charset.max_code, MAX_CHAR); charset.max_char = i + charset.code_offset; i = CODE_POINT_TO_INDEX (&charset, charset.min_code); charset.min_char = i + charset.code_offset; commit fefc3005d46f4ac41af624d4591b052df92e4bd0 Author: Sean Whitton Date: Thu Oct 24 21:15:28 2024 +0800 ; Touch up & fix documentation changes from last commit diff --git a/etc/NEWS b/etc/NEWS index 12053fffc57..a4a036cbb50 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -614,15 +614,17 @@ even though Emacs thinks it is dangerous. So far, this applies only to using 'e' from Log View mode for Git. +--- *** 'vc-clone' is now an interactive command. When called interactively, 'vc-clone' now prompts for the remote -repository address, the backend for cloning, if it has not been -determined automatically according to the URL, and the directory to -clone the repository into. +repository address, and the directory into which to clone the +repository. It tries to automatically determine the VC backend for +cloning, or prompts for that, too. +--- *** 'vc-clone' now accepts an optional argument OPEN-DIR. When the argument is non-nil, the function switches to a buffer visiting -directory to which the repository was cloned. +the directory into which the repository was cloned. * New Modes and Packages in Emacs 31.1 diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index ae183cc9f72..d30f616f6ea 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -71,7 +71,7 @@ "Default VC backend to use for cloning package repositories. `package-vc-install' uses this backend when you specify neither the backend nor a repository URL that's recognized via -`package-vc-heuristic-alist'. +`vc-clone-heuristic-alist'. The value must be a member of `vc-handled-backends' that supports the `clone' VC function." @@ -809,7 +809,7 @@ If PACKAGE is a string, it specifies the URL of the package repository. In this case, optional argument BACKEND specifies the VC backend to use for cloning the repository; if it's nil, this function tries to infer which backend to use according to -the value of `package-vc-heuristic-alist' and if that fails it +the value of `vc-clone-heuristic-alist' and if that fails it uses `package-vc-default-backend'. Optional argument NAME specifies the package name in this case; if it's nil, this package uses `file-name-base' on the URL to obtain the package diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 6320af1e79f..38df2a23cac 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -24112,7 +24112,7 @@ If PACKAGE is a string, it specifies the URL of the package repository. In this case, optional argument BACKEND specifies the VC backend to use for cloning the repository; if it's nil, this function tries to infer which backend to use according to -the value of `package-vc-heuristic-alist' and if that fails it +the value of `vc-clone-heuristic-alist' and if that fails it uses `package-vc-default-backend'. Optional argument NAME specifies the package name in this case; if it's nil, this package uses `file-name-base' on the URL to obtain the package diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 9c85dee9129..ebe3de5c6c4 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3884,17 +3884,17 @@ If successful, return the string with the directory of the checkout; otherwise return nil. REMOTE should be a string, the URL of the remote repository or the name of a directory (if the repository is local). + +When called interactively, prompt for REMOTE, BACKEND and DIRECTORY, +except attempt to determine BACKEND automatically based on REMOTE. + If DIRECTORY is nil or omitted, it defaults to `default-directory'. If BACKEND is nil or omitted, the function iterates through every known backend in `vc-handled-backends' until one succeeds to clone REMOTE. If REV is non-nil, it indicates a specific revision to check out after cloning; the syntax of REV depends on what BACKEND accepts. -If OPEN-DIR is non-nil, switches to a buffer visiting DIRECTORY to -which the repository was cloned. It would be useful in scripts, but not -in regular code. -If called interactively, prompt for REMOTE, DIRECTORY and BACKEND, -if BACKEND has not been automatically determined according to the REMOTE -URL, in the minibuffer." +If OPEN-DIR is non-nil, as it is interactively, also switches to a +buffer visiting DIRECTORY." (interactive (let* ((url (read-string "Remote: " nil 'vc--remotes-history)) (backend (or (vc-guess-url-backend url) commit be29879850028d316592ba82cd859d31a67c1ffe Author: Aleksandr Vityazev Date: Thu Oct 24 15:19:34 2024 +0300 vc-clone: Make interactive; call vc-guess-url-backend * lisp/vc/vc.el (vc-clone): Make interactive. Call vc-guess-url-backend. Always return DIRECTORY if it names a directory. New optional argument OPEN-DIR. (vc--remotes-history): New defvar. * etc/NEWS: Announce these changes. diff --git a/etc/NEWS b/etc/NEWS index 64e4f22b9d3..12053fffc57 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -614,6 +614,16 @@ even though Emacs thinks it is dangerous. So far, this applies only to using 'e' from Log View mode for Git. +*** 'vc-clone' is now an interactive command. +When called interactively, 'vc-clone' now prompts for the remote +repository address, the backend for cloning, if it has not been +determined automatically according to the URL, and the directory to +clone the repository into. + +*** 'vc-clone' now accepts an optional argument OPEN-DIR. +When the argument is non-nil, the function switches to a buffer visiting +directory to which the repository was cloned. + * New Modes and Packages in Emacs 31.1 diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index dfbb5743eb2..9c85dee9129 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3876,7 +3876,9 @@ to provide the `find-revision' operation instead." (interactive) (vc-call-backend (vc-backend buffer-file-name) 'check-headers)) -(defun vc-clone (remote &optional backend directory rev) +(defvar vc--remotes-history) + +(defun vc-clone (remote &optional backend directory rev open-dir) "Clone repository REMOTE using version-control BACKEND, into DIRECTORY. If successful, return the string with the directory of the checkout; otherwise return nil. @@ -3886,20 +3888,42 @@ If DIRECTORY is nil or omitted, it defaults to `default-directory'. If BACKEND is nil or omitted, the function iterates through every known backend in `vc-handled-backends' until one succeeds to clone REMOTE. If REV is non-nil, it indicates a specific revision to check out after -cloning; the syntax of REV depends on what BACKEND accepts." - (setq directory (expand-file-name (or directory default-directory))) - (if backend - (progn - (unless (memq backend vc-handled-backends) - (error "Unknown VC backend %s" backend)) - (vc-call-backend backend 'clone remote directory rev)) - (catch 'ok - (dolist (backend vc-handled-backends) - (ignore-error vc-not-supported - (when-let* ((res (vc-call-backend - backend 'clone - remote directory rev))) - (throw 'ok res))))))) +cloning; the syntax of REV depends on what BACKEND accepts. +If OPEN-DIR is non-nil, switches to a buffer visiting DIRECTORY to +which the repository was cloned. It would be useful in scripts, but not +in regular code. +If called interactively, prompt for REMOTE, DIRECTORY and BACKEND, +if BACKEND has not been automatically determined according to the REMOTE +URL, in the minibuffer." + (interactive + (let* ((url (read-string "Remote: " nil 'vc--remotes-history)) + (backend (or (vc-guess-url-backend url) + (intern (completing-read + "Backend: " vc-handled-backends nil t))))) + (list url backend + (read-directory-name + "Clone into new or empty directory: " nil nil + (lambda (dir) (or (not (file-exists-p dir)) + (directory-empty-p dir)))) + nil t))) + (let* ((directory (expand-file-name (or directory default-directory))) + (backend (or backend (vc-guess-url-backend remote))) + (directory (if backend + (progn + (unless (memq backend vc-handled-backends) + (error "Unknown VC backend %s" backend)) + (vc-call-backend backend 'clone remote directory rev)) + (catch 'ok + (dolist (backend vc-handled-backends) + (ignore-error vc-not-supported + (when-let* ((res (vc-call-backend + backend 'clone + remote directory rev))) + (throw 'ok res)))))))) + (when (file-directory-p directory) + (when open-dir + (find-file directory)) + directory))) (declare-function log-view-current-tag "log-view" (&optional pos)) (defun vc-default-last-change (_backend file line) commit 98b02f56d12f2f39a6667d33d50f9e551a267d6d Author: Aleksandr Vityazev Date: Thu Oct 24 15:11:44 2024 +0300 Move package-vc-heuristic-alist and related to vc.el * lisp/emacs-lisp/package-vc.el (package-vc--backend-type) (package-vc-heuristic-alist, package-vc--guess-backend): Rename to vc-cloneable-backends-custom-type, vc-clone-heuristic-alist and vc-guess-url-backend respectively, and move to lisp/vc/vc.el. Make package-vc-heuristic-alist an obsolete alias. (package-vc--clone, package-vc--read-package-name) (package-vc-install, package-vc-checkout): Use vc-guess-url-backend. * lisp/vc/vc.el (vc-cloneable-backends-custom-type) (vc-clone-heuristic-alist, vc-guess-url-backend): New defconst, defcustom and defun, respectively: renamed and moved here from lisp/emacs-lisp/package-vc.el. diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index 894bc9c8c37..ae183cc9f72 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -63,61 +63,9 @@ (defconst package-vc--elpa-packages-version 1 "Version number of the package specification format understood by package-vc.") -(defconst package-vc--backend-type - `(choice :convert-widget - ,(lambda (widget) - (let (opts) - (dolist (be vc-handled-backends) - (when (or (vc-find-backend-function be 'clone) - (alist-get 'clone (get be 'vc-functions))) - (push (widget-convert (list 'const be)) opts))) - (widget-put widget :args opts)) - widget)) - "The type of VC backends that support cloning package VCS repositories.") - -(defcustom package-vc-heuristic-alist - `((,(rx bos "http" (? "s") "://" - (or (: (? "www.") "github.com" - "/" (+ (or alnum "-" "." "_")) - "/" (+ (or alnum "-" "." "_"))) - (: "codeberg.org" - "/" (+ (or alnum "-" "." "_")) - "/" (+ (or alnum "-" "." "_"))) - (: (? "www.") "gitlab" (+ "." (+ alnum)) - "/" (+ (or alnum "-" "." "_")) - "/" (+ (or alnum "-" "." "_"))) - (: "git.sr.ht" - "/~" (+ (or alnum "-" "." "_")) - "/" (+ (or alnum "-" "." "_"))) - (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/" - (or "r" "git") "/" - (+ (or alnum "-" "." "_")) (? "/"))) - (or (? "/") ".git") eos) - . Git) - (,(rx bos "http" (? "s") "://" - (or (: "hg.sr.ht" - "/~" (+ (or alnum "-" "." "_")) - "/" (+ (or alnum "-" "." "_"))) - (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/" - (+ (or alnum "-" "." "_")) (? "/"))) - eos) - . Hg) - (,(rx bos "http" (? "s") "://" - (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/" - (+ (or alnum "-" "." "_")) (? "/"))) - eos) - . Bzr)) - "Alist mapping repository URLs to VC backends. -`package-vc-install' consults this alist to determine the VC -backend from the repository URL when you call it without -specifying a backend. Each element of the alist has the form -\(URL-REGEXP . BACKEND). `package-vc-install' will use BACKEND of -the first association for which the URL of the repository matches -the URL-REGEXP of the association. If no match is found, -`package-vc-install' uses `package-vc-default-backend' instead." - :type `(alist :key-type (regexp :tag "Regular expression matching URLs") - :value-type ,package-vc--backend-type) - :version "29.1") +(define-obsolete-variable-alias + 'package-vc-heuristic-alist + 'vc-clone-heuristic-alist "31.1") (defcustom package-vc-default-backend 'Git "Default VC backend to use for cloning package repositories. @@ -127,7 +75,7 @@ the backend nor a repository URL that's recognized via The value must be a member of `vc-handled-backends' that supports the `clone' VC function." - :type package-vc--backend-type + :type vc-cloneable-backends-custom-type :version "29.1") (defcustom package-vc-register-as-project t @@ -626,13 +574,6 @@ documentation and marking the package as installed." ""))) t)) -(defun package-vc--guess-backend (url) - "Guess the VC backend for URL. -This function will internally query `package-vc-heuristic-alist' -and return nil if it cannot reasonably guess." - (and url (alist-get url package-vc-heuristic-alist - nil nil #'string-match-p))) - (declare-function project-remember-projects-under "project" (dir &optional recursive)) (defun package-vc--clone (pkg-desc pkg-spec dir rev) @@ -646,7 +587,7 @@ attribute in PKG-SPEC." (unless (file-exists-p dir) (make-directory (file-name-directory dir) t) (let ((backend (or (plist-get pkg-spec :vc-backend) - (package-vc--guess-backend url) + (vc-guess-url-backend url) (plist-get (alist-get (package-desc-archive pkg-desc) package-vc--archive-data-alist nil nil #'string=) @@ -753,7 +694,7 @@ VC packages that have already been installed." ;; pointing towards a repository, and use that as a backup (and-let* ((extras (package-desc-extras (cadr pkg))) (url (alist-get :url extras)) - ((package-vc--guess-backend url))))))) + ((vc-guess-url-backend url))))))) (not allow-url))) (defun package-vc--read-package-desc (prompt &optional installed) @@ -917,7 +858,7 @@ installs takes precedence." (cdr package) rev)) ((and-let* (((stringp package)) - (backend (or backend (package-vc--guess-backend package)))) + (backend (or backend (vc-guess-url-backend package)))) (package-vc--unpack (package-desc-create :name (or name (intern (file-name-base package))) @@ -930,7 +871,7 @@ installs takes precedence." (or (package-vc--desc->spec (cadr desc)) (and-let* ((extras (package-desc-extras (cadr desc))) (url (alist-get :url extras)) - (backend (package-vc--guess-backend url))) + (backend (vc-guess-url-backend url))) (list :vc-backend backend :url url)) (user-error "Package `%s' has no VC data" package)) rev))) @@ -958,7 +899,7 @@ for the last released version of the package." (let ((pkg-spec (or (package-vc--desc->spec pkg-desc) (and-let* ((extras (package-desc-extras pkg-desc)) (url (alist-get :url extras)) - (backend (package-vc--guess-backend url))) + (backend (vc-guess-url-backend url))) (list :vc-backend backend :url url)) (user-error "Package `%s' has no VC data" (package-desc-name pkg-desc))))) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 6498b8522fd..dfbb5743eb2 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -944,6 +944,61 @@ value other than `ask' if you have a strong grasp of the VCS in use." (const :tag "Allow without prompting" t)) :version "31.1") +(defconst vc-cloneable-backends-custom-type + `(choice :convert-widget + ,(lambda (widget) + (let (opts) + (dolist (be vc-handled-backends) + (when (or (vc-find-backend-function be 'clone) + (alist-get 'clone (get be 'vc-functions))) + (push (widget-convert (list 'const be)) opts))) + (widget-put widget :args opts)) + widget)) + "The type of VC backends that support cloning VCS repositories.") + +(defcustom vc-clone-heuristic-alist + `((,(rx bos "http" (? "s") "://" + (or (: (? "www.") "github.com" + "/" (+ (or alnum "-" "." "_")) + "/" (+ (or alnum "-" "." "_"))) + (: "codeberg.org" + "/" (+ (or alnum "-" "." "_")) + "/" (+ (or alnum "-" "." "_"))) + (: (? "www.") "gitlab" (+ "." (+ alnum)) + "/" (+ (or alnum "-" "." "_")) + "/" (+ (or alnum "-" "." "_"))) + (: "git.sr.ht" + "/~" (+ (or alnum "-" "." "_")) + "/" (+ (or alnum "-" "." "_"))) + (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/" + (or "r" "git") "/" + (+ (or alnum "-" "." "_")) (? "/"))) + (or (? "/") ".git") eos) + . Git) + (,(rx bos "http" (? "s") "://" + (or (: "hg.sr.ht" + "/~" (+ (or alnum "-" "." "_")) + "/" (+ (or alnum "-" "." "_"))) + (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/" + (+ (or alnum "-" "." "_")) (? "/"))) + eos) + . Hg) + (,(rx bos "http" (? "s") "://" + (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/" + (+ (or alnum "-" "." "_")) (? "/"))) + eos) + . Bzr)) + "Alist mapping repository URLs to VC backends. +`vc-clone' consults this alist to determine the VC +backend from the repository URL when you call it without +specifying a backend. Each element of the alist has the form +\(URL-REGEXP . BACKEND). `vc-clone' will use BACKEND of +the first association for which the URL of the repository matches +the URL-REGEXP of the association." + :type `(alist :key-type (regexp :tag "Regular expression matching URLs") + :value-type ,vc-cloneable-backends-custom-type) + :version "31.1") + ;; File property caching @@ -1033,6 +1088,13 @@ use." (vc-call-backend bk 'create-repo)) (throw 'found bk)))) +(defun vc-guess-url-backend (url) + "Guess the VC backend for URL. +This function will internally query `vc-clone-heuristic-alist' +and return nil if it cannot reasonably guess." + (and url (alist-get url vc-clone-heuristic-alist + nil nil #'string-match-p))) + ;;;###autoload (defun vc-responsible-backend (file &optional no-error) "Return the name of a backend system that is responsible for FILE. commit db587ae8ba7d7b281f6935ed5d038b7ecf4abd5d Author: Sean Whitton Date: Thu Oct 24 17:19:41 2024 +0800 ; Drop two outdated calls to 'require' * lisp/emacs-lisp/backtrace.el (require): * lisp/wid-edit.el (require): Don't require subr-x. if-let, when-let and friends have all been in subr.el for a while. diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index 120972d6cd8..84d9e20abe9 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -33,7 +33,6 @@ (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'pcase)) -(eval-when-compile (require 'subr-x)) ; if-let (require 'find-func) (require 'help-mode) ; Define `help-function-def' button type. (require 'lisp-mode) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 6fbf6257232..ba99847f488 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -56,7 +56,6 @@ ;;; Code: (require 'cl-lib) -(eval-when-compile (require 'subr-x)) ; when-let ;; The `string' widget completion uses this. (declare-function ispell-get-word "ispell" commit 767493ccb693f65cf8621cd82f0ecf92be976f55 Author: Michael Albinus Date: Thu Oct 24 11:11:03 2024 +0200 * doc/misc/tramp.texi (Bug Reports): Explain bisecting. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 1b40ce6fa62..96ec6d60b9e 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5173,6 +5173,17 @@ contents of files and directories will be included in the debug buffer. Passwords typed in @value{tramp} will never be included there. +If you find, that using @value{tramp} with @command{emacs -Q} doesn't +cause any problem, you might check your init file for the suspicious +configuration by bisecting it. That is, comment out about half of the +init file, and check whether the problem still arises when calling +@command{emacs}. If yes, comment out half of the still active code. +Otherwise, comment out the active code, and uncomment the just +commented code. + +Call @command{emacs}, again. Reiterate, until you find the suspicious +configuaration. + @node Frequently Asked Questions @chapter Frequently Asked Questions commit 8903106bb783c2825233c149b6799960aacdea57 Author: Sean Whitton Date: Thu Oct 24 16:50:07 2024 +0800 Mark if-let and when-let obsolete * lisp/subr.el (if-let*, when-let*, if-let, when-let): Mark if-let and when-let obsolete (bug#73853 and elsewhere). Move docstring text around so that if-let* and when-let* descriptions no longer refer to if-let and when-let. * etc/NEWS: Announce the change. * admin/admin.el (reminder-for-release-blocking-bugs): * doc/misc/erc.texi (display-buffer): * lisp/ansi-color.el (ansi-color-apply) (ansi-color--face-vec-face): * lisp/ansi-osc.el (ansi-osc-apply-on-region) (ansi-osc-hyperlink): * lisp/arc-mode.el (archive-goto-file) (archive-next-file-displayer): * lisp/auth-source-pass.el (auth-source-pass-search) (auth-source-pass--parse-data) (auth-source-pass--find-match-many): * lisp/autorevert.el (auto-revert-notify-rm-watch): * lisp/buff-menu.el (Buffer-menu-unmark-all-buffers) (Buffer-menu-group-by-root): * lisp/calendar/parse-time.el (parse-iso8601-time-string): * lisp/cedet/pulse.el (pulse-tick): * lisp/comint.el (comint--fontify-input-ppss-flush-indirect) (comint--intersect-regions): * lisp/completion-preview.el (completion-preview--try-table) (completion-preview--capf-wrapper, completion-preview--update): * lisp/cus-edit.el (setopt--set) (custom-dirlocals-maybe-update-cons, custom-dirlocals-validate): * lisp/custom.el (load-theme): * lisp/descr-text.el (describe-char): * lisp/desktop.el (desktop--emacs-pid-running-p): * lisp/dired-x.el (menu): * lisp/dired.el (dired-font-lock-keywords) (dired-insert-directory, dired--insert-disk-space, dired-mode): * lisp/dnd.el (dnd-handle-multiple-urls): * lisp/dom.el (dom-remove-attribute): * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): * lisp/emacs-lisp/bytecomp.el (bytecomp--custom-declare): * lisp/emacs-lisp/comp-common.el (comp-function-type-spec): * lisp/emacs-lisp/comp-cstr.el (comp--all-classes) (comp-cstr-set-range-for-arithm, comp--cstr-union-1-no-mem) (comp-cstr-intersection-no-mem, comp-cstr-fixnum-p) (comp-cstr-type-p): * lisp/emacs-lisp/comp-run.el (comp-subr-trampoline-install) (native--compile-async): * lisp/emacs-lisp/comp.el (comp--get-function-cstr) (comp--function-pure-p, comp--intern-func-in-ctxt) (comp--addr-to-bb-name, comp--emit-assume, comp--maybe-add-vmvar) (comp--add-call-cstr, comp--compute-dominator-tree) (comp--dom-tree-walker, comp--ssa-rename) (comp--function-call-maybe-fold, comp--fwprop-call) (comp--call-optim-func): * lisp/emacs-lisp/edebug.el (edebug-global-prefix) (edebug-remove-instrumentation): * lisp/emacs-lisp/eieio.el (initialize-instance): * lisp/emacs-lisp/ert-x.el (ert-resource-directory): * lisp/emacs-lisp/ert.el (ert--expand-should-1) (ert-test-location, ert-write-junit-test-report) (ert-test--erts-test): * lisp/emacs-lisp/icons.el (icon-complete-spec, icon-string) (icons--create): * lisp/emacs-lisp/lisp-mode.el (lisp--local-defform-body-p): * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--make-autoload) (loaddefs-generate--parse-file): * lisp/emacs-lisp/multisession.el (multisession-edit-mode--revert, multisession-edit-value): * lisp/emacs-lisp/package-vc.el (package-vc--read-archive-data) (package-vc--version, package-vc--clone): * lisp/emacs-lisp/package.el (package--reload-previously-loaded): * lisp/emacs-lisp/pp.el (pp--insert-lisp): * lisp/emacs-lisp/subr-x.el (add-display-text-property): * lisp/emacs-lisp/tabulated-list.el (tabulated-list-print): * lisp/emacs-lisp/timer.el (run-at-time): * lisp/emacs-lisp/vtable.el (vtable-goto-table) (vtable-goto-column, vtable-update-object, vtable--insert-line) (vtable--compute-widths, vtable--make-keymap): * lisp/emacs-lisp/warnings.el (display-warning): * lisp/epa-file.el (epa-file-insert-file-contents): * lisp/epa.el (epa-show-key): * lisp/erc/erc-backend.el (erc--split-line, erc--conceal-prompt) (PRIVMSG, erc--get-isupport-entry): * lisp/erc/erc-button.el (erc-button-add-nickname-buttons) (erc--button-next): * lisp/erc/erc-common.el (erc--find-group): * lisp/erc/erc-fill.el (erc-fill, erc-fill-static) (erc-fill--wrap-escape-hidden-speaker) (erc-fill--wrap-unmerge-on-date-stamp) (erc-fill--wrap-massage-initial-message-post-clear) (erc-fill-wrap, erc-fill--wrap-rejigger-region): * lisp/erc/erc-goodies.el (erc--scrolltobottom-all) (erc--keep-place-indicator-on-window-buffer-change) (keep-place-indicator, erc--keep-place-indicator-adjust-on-clear) (erc-keep-place-move, erc--command-indicator-display): * lisp/erc/erc-ibuffer.el (erc-members): * lisp/erc/erc-join.el (erc-join--remove-requested-channel) (erc-autojoin--join): * lisp/erc/erc-networks.el (erc-networks--id-qualifying-init-parts, erc-networks--id-reload) (erc-networks--id-ensure-comparable) (erc-networks--reclaim-orphaned-target-buffers) (erc-networks--server-select): * lisp/erc/erc-nicks.el (erc-nicks-invert) (erc-nicks--redirect-face-widget-link, erc-nicks--highlight) (erc-nicks--highlight-button) (erc-nicks--list-faces-help-button-action, erc-nicks-list-faces) (erc-nicks-refresh, erc-nicks--colors-from-faces) (erc-nicks--track-prioritize) (erc-nicks--remember-face-for-track): * lisp/erc/erc-notify.el (querypoll, erc--querypoll-get-next) (erc--querypoll-on-352, erc--querypoll-send): * lisp/erc/erc-sasl.el (erc-sasl--read-password): * lisp/erc/erc-services.el (erc-services-issue-ghost-and-retry-nick): * lisp/erc/erc-speedbar.el (erc-speedbar--ensure, nickbar) (erc-speedbar-toggle-nicknames-window-lock) (erc-speedbar--compose-nicks-face): * lisp/erc/erc-stamp.el (erc-stamp--recover-on-reconnect) (erc-stamp-prefix-log-filter, erc--conceal-prompt) (erc--insert-timestamp-left, erc-insert-timestamp-right) (erc-stamp--defer-date-insertion-on-post-modify) (erc-insert-timestamp-left-and-right) (erc-stamp--redo-right-stamp-post-clear) (erc-stamp--reset-on-clear, erc-stamp--dedupe-date-stamps): * lisp/erc/erc-status-sidebar.el (bufbar) (erc-status-sidebar-prefer-target-as-name) (erc-status-sidebar-default-allsort, erc-status-sidebar-click): * lisp/erc/erc-track.el (erc-track--shortened-names-get) (erc-track--setup, erc-track--select-mode-line-face) (erc-track-modified-channels, erc-track--collect-faces-in) (erc-track--switch-buffer, erc-track--replace-killed-buffer): * lisp/erc/erc-truncate.el (erc-truncate--setup) (erc-truncate-buffer): * lisp/erc/erc.el (erc--ensure-query-member) (erc--ensure-query-members, erc--remove-channel-users-but) (erc--cusr-change-status, erc--find-mode, erc--update-modules) (erc-log-irc-protocol, erc--refresh-prompt) (erc--restore-important-text-props) (erc--order-text-properties-from-hash, erc-send-input-line) (erc-cmd-IGNORE, erc--unignore-user, erc-cmd-QUERY) (erc-cmd-BANLIST, erc--speakerize-nick) (erc--format-speaker-input-message, erc-channel-receive-names) (erc-send-current-line, erc-format-target-and/or-network) (erc-kill-buffer-function, erc-restore-text-properties) (erc--get-eq-comparable-cmd): * lisp/eshell/em-alias.el (eshell-maybe-replace-by-alias--which) (eshell-maybe-replace-by-alias): * lisp/eshell/em-glob.el (eshell-glob-convert): * lisp/eshell/em-pred.el (eshell-pred-user-or-group) (eshell-pred-file-time, eshell-pred-file-type) (eshell-pred-file-mode, eshell-pred-file-links) (eshell-pred-file-size): * lisp/eshell/em-prompt.el (eshell-forward-paragraph) (eshell-next-prompt): * lisp/eshell/esh-arg.el (eshell-resolve-current-argument): * lisp/eshell/esh-cmd.el (eshell-do-eval, eshell/which) (eshell-plain-command--which, eshell-plain-command): * lisp/eshell/esh-io.el (eshell-duplicate-handles) (eshell-protect-handles, eshell-get-target, eshell-close-target): * lisp/eshell/esh-proc.el (eshell-sentinel): * lisp/eshell/esh-var.el (eshell-parse-variable-ref) (eshell-get-variable, eshell-set-variable): * lisp/faces.el (face-at-point): * lisp/ffap.el (ffap-in-project): * lisp/filenotify.el (file-notify--rm-descriptor): * lisp/files-x.el (read-dir-locals-file) (connection-local-update-profile-variables) (connection-local-value): * lisp/files.el (file-remote-p, abbreviate-file-name) (set-auto-mode, hack-local-variables) (revert-buffer-restore-read-only): * lisp/find-dired.el (find-dired-sort-by-filename): * lisp/font-lock.el (font-lock--filter-keywords): * lisp/gnus/gnus-art.el (article-emojize-symbols): * lisp/gnus/gnus-int.el (gnus-close-server): * lisp/gnus/gnus-search.el (gnus-search-transform) (gnus-search-indexed-parse-output, gnus-search-server-to-engine): * lisp/gnus/gnus-sum.el (gnus-collect-urls, gnus-shorten-url): * lisp/gnus/gnus.el (gnus-check-backend-function): * lisp/gnus/message.el (message-send-mail): * lisp/gnus/mml.el (mml-generate-mime, mml-insert-mime-headers): * lisp/gnus/nnatom.el (nnatom--read-feed, nnatom--read-article) (nnatom--read-article-or-group-authors, nnatom--read-publish) (nnatom--read-update, nnatom--read-links): * lisp/gnus/nnfeed.el (nnfeed--read-server, nnfeed--write-server) (nnfeed--parse-feed, nnfeed--group-data, nnfeed-retrieve-article) (nnfeed-retrieve-headers, nnfeed--print-part) (nnfeed-request-article, nnfeed-request-group) (nnfeed-request-list, nnfeed--group-description) (nnfeed-request-group-description) (nnfeed-request-list-newsgroups, nnfeed-request-rename-group): * lisp/gnus/nnmh.el (nnmh-update-gnus-unreads): * lisp/help-fns.el (help-find-source) (help-fns--insert-menu-bindings, help-fns--mention-first-release) (help-fns--mention-shortdoc-groups) (help-fns--customize-variable-version) (help-fns--face-custom-version-info, describe-mode): * lisp/help-mode.el (help-make-xrefs): * lisp/help.el (help-key-description, help--describe-command): * lisp/hfy-cmap.el (htmlfontify-load-rgb-file): * lisp/ibuf-ext.el (ibuffer-jump-to-filter-group) (ibuffer-kill-filter-group, ibuffer-kill-line) (ibuffer-save-filter-groups, ibuffer-save-filters, filename) (basename, file-extension, ibuffer-diff-buffer-with-file-1) (ibuffer-mark-by-file-name-regexp) (ibuffer-mark-by-content-regexp): * lisp/ibuf-macs.el (ibuffer-aif, ibuffer-awhen): * lisp/ibuffer.el (ibuffer-mouse-toggle-mark) (ibuffer-toggle-marks, ibuffer-mark-interactive) (ibuffer-compile-format, process, ibuffer-map-lines): * lisp/image.el (image--compute-map) (image--compute-original-map): * lisp/image/exif.el (exif-parse-buffer): * lisp/image/image-converter.el (image-convert-p, image-convert) (image-converter--find-converter): * lisp/image/image-dired-util.el (image-dired-file-name-at-point): * lisp/image/image-dired.el (image-dired-track-original-file) (image-dired--on-file-in-dired-buffer) (image-dired--with-thumbnail-buffer) (image-dired-jump-original-dired-buffer) (image-dired--slideshow-step, image-dired-display-image): * lisp/image/wallpaper.el (wallpaper--init-action-kill) (wallpaper--find-setter, wallpaper--find-command) (wallpaper--find-command-args, wallpaper--x-monitor-name): * lisp/info-look.el (info-lookup-interactive-arguments) (info-complete)::(:mode): * lisp/info.el (info-pop-to-buffer, Info-read-node-name-1): * lisp/international/emoji.el (emoji--adjust-displayable-1) (emoji--add-recent): * lisp/jsonrpc.el (jsonrpc--call-deferred) (jsonrpc--process-sentinel, jsonrpc--remove): * lisp/keymap.el (keymap-local-lookup): * lisp/mail/emacsbug.el (report-emacs-bug-hook) (submit-emacs-patch): * lisp/mail/ietf-drums.el (ietf-drums-parse-addresses): * lisp/mail/mailclient.el (mailclient-send-it): * lisp/mail/rfc6068.el (rfc6068-parse-mailto-url): * lisp/mail/undigest.el (rmail-digest-parse-mixed-mime): * lisp/minibuffer.el (completion-metadata-get) (completions--after-change) (minibuffer-visible-completions--filter): * lisp/net/browse-url.el (browse-url-url-at-point) (browse-url-file-url, browse-url-emacs): * lisp/net/dbus.el (dbus-byte-array-to-string) (dbus-monitor-goto-serial): * lisp/net/dictionary.el (dictionary-search): * lisp/net/eww.el (eww--download-directory) (eww-auto-rename-buffer, eww-open-in-new-buffer, eww-submit) (eww-follow-link, eww-read-alternate-url) (eww-copy-alternate-url): * lisp/net/goto-addr.el (goto-address-at-point): * lisp/net/mailcap.el (mailcap-mime-info): * lisp/net/rcirc.el (rcirc, rcirc-connect, rcirc-send-string) (rcirc-kill-buffer-hook, rcirc-print, rcirc-when) (rcirc-color-attributes, rcirc-handler-NICK) (rcirc-handler-TAGMSG, rcirc-handler-BATCH): * lisp/net/shr.el (shr-descend, shr-adaptive-fill-function) (shr-correct-dom-case, shr-tag-a): * lisp/net/sieve.el (sieve-manage-quit): * lisp/outline.el (outline-cycle-buffer): * lisp/pcmpl-git.el (pcmpl-git--tracked-file-predicate): * lisp/proced.el (proced-auto-update-timer): * lisp/progmodes/bug-reference.el (bug-reference-try-setup-from-vc): * lisp/progmodes/c-ts-common.el (c-ts-common--fill-paragraph): * lisp/progmodes/c-ts-mode.el (c-ts-mode--preproc-offset) (c-ts-mode--anchor-prev-sibling, c-ts-mode-indent-defun): * lisp/progmodes/compile.el (compilation-error-properties) (compilation-find-file-1): * lisp/progmodes/eglot.el (eglot--check-object) (eglot--read-server, eglot-upgrade-eglot) (eglot-handle-notification, eglot--CompletionParams) (eglot-completion-at-point, eglot--sig-info) (eglot-register-capability): * lisp/progmodes/elisp-mode.el (emacs-lisp-native-compile-and-load) (elisp-eldoc-var-docstring-with-value): * lisp/progmodes/erts-mode.el (erts-mode--goto-start-of-test): * lisp/progmodes/flymake.el (flymake--update-eol-overlays) (flymake-eldoc-function): * lisp/progmodes/gdb-mi.el (gdb-breakpoints-list-handler-custom) (gdb-frame-handler): * lisp/progmodes/go-ts-mode.el (go-ts-mode-docstring) (go-ts-mode--comment-on-previous-line-p) (go-ts-mode--get-test-regexp-at-point) (go-ts-mode-test-this-file): * lisp/progmodes/grep.el (lgrep, rgrep-default-command) (grep-file-at-point): * lisp/progmodes/perl-mode.el (perl--end-of-format-p): * lisp/progmodes/php-ts-mode.el (php-ts-mode--anchor-prev-sibling, php-ts-mode--indent-defun): * lisp/progmodes/project.el (project--other-place-command) (project--find-default-from, project--transplant-file-name) (project-prefixed-buffer-name, project--remove-from-project-list) (project-prompt-project-name, project-remember-projects-under) (project--switch-project-command) (project-uniquify-dirname-transform, project-mode-line-format): * lisp/progmodes/python.el (python-font-lock-keywords-maximum-decoration) (python--treesit-fontify-union-types) (python-shell-get-process-name, python-shell-restart) (python-shell-completion-at-point, python-ffap-module-path) (python-util-comint-end-of-output-p, python--import-sources) (python-add-import, python-remove-import, python-fix-imports): * lisp/progmodes/xref.el (xref--add-log-current-defun): * lisp/repeat.el (repeat-echo-message-string): * lisp/saveplace.el (save-place-dired-hook): * lisp/server.el (server-save-buffers-kill-terminal): * lisp/shadowfile.el (shadow-make-fullname) (shadow-contract-file-name, shadow-define-literal-group): * lisp/shell.el (shell-highlight-undef-mode): * lisp/simple.el (command-completion-using-modes-p) (command-execute, file-user-uid, file-group-gid) (first-completion, last-completion, switch-to-completions): * lisp/startup.el (startup--load-user-init-file): * lisp/tab-line.el (tab-line-tabs-buffer-group-by-project): * lisp/tar-mode.el (tar-goto-file, tar-next-file-displayer): * lisp/term/android-win.el (android-encode-select-string) (gui-backend-set-selection): * lisp/term/haiku-win.el (haiku-dnd-convert-string) (haiku-select-encode-xstring, haiku-select-encode-utf-8-string): * lisp/textmodes/emacs-news-mode.el (emacs-news--buttonize): * lisp/textmodes/ispell.el (ispell-completion-at-point): * lisp/textmodes/sgml-mode.el (sgml-validate) (html-mode--complete-at-point): * lisp/textmodes/tex-mode.el (tex-recenter-output-buffer) (xref-backend-references): * lisp/thingatpt.el (thing-at-point-file-at-point) (thing-at-point-face-at-point): * lisp/thread.el (thread-list--get-status): * lisp/time.el (world-clock-copy-time-as-kill, world-clock): * lisp/touch-screen.el (touch-screen-handle-touch): * lisp/treesit.el (treesit-language-at, treesit-node-at) (treesit-node-on, treesit-buffer-root-node) (treesit-node-field-name, treesit-local-parsers-at) (treesit-local-parsers-on, treesit--cleanup-local-range-overlays) (treesit-font-lock-recompute-features) (treesit-font-lock-fontify-region, treesit-transpose-sexps) (treesit-add-log-current-defun, treesit-major-mode-setup) (treesit--explorer-refresh, treesit-install-language-grammar): * lisp/url/url.el (url-retrieve-synchronously): * lisp/vc/smerge-mode.el (smerge-diff): * lisp/vc/vc-dir.el (vc-dir): * lisp/vc/vc-dispatcher.el (vc-do-async-command): * lisp/vc/vc-git.el (vc-git-dir--branch-headers) (vc-git-dir--stash-headers, vc-git--log-edit-summary-check) (vc-git-stash-list): * lisp/vc/vc.el (vc-responsible-backend, vc-buffer-sync-fileset) (vc-clone): * lisp/visual-wrap.el (visual-wrap--apply-to-line): * lisp/wid-edit.el (widget-text) (widget-editable-list-insert-before): * lisp/window-tool-bar.el (window-tool-bar--keymap-entry-to-string): * lisp/window.el (display-buffer, display-buffer-full-frame) (window-point-context-set, window-point-context-use) (window-point-context-use-default-function): * lisp/xdg.el (xdg-current-desktop): * lisp/xwidget.el (xwidget-webkit-callback): * lisp/yank-media.el (yank-media--get-selection) (yank-media-types): * test/lisp/comint-tests.el (comint-tests/test-password-function): * test/lisp/completion-preview-tests.el (completion-preview-tests--capf): * test/lisp/cus-edit-tests.el (with-cus-edit-test): * test/lisp/erc/erc-scenarios-base-local-modules.el (-phony-sblm-): * test/lisp/erc/erc-scenarios-stamp.el (erc-scenarios-stamp--on-post-modify): * test/lisp/erc/erc-services-tests.el (erc-services-tests--asp-parse-entry): * test/lisp/erc/erc-tests.el (erc-modules--internal-property) (erc--find-mode, erc-tests--update-modules): * test/lisp/erc/resources/erc-d/erc-d-i.el (erc-d-i--parse-message): * test/lisp/erc/resources/erc-d/erc-d-t.el (erc-d-t-kill-related-buffers, erc-d-t-with-cleanup): * test/lisp/erc/resources/erc-d/erc-d-tests.el (erc-d-i--parse-message--irc-parser-tests): * test/lisp/erc/resources/erc-d/erc-d-u.el (erc-d-u--read-exchange-slowly): * test/lisp/erc/resources/erc-d/erc-d.el (erc-d--expire) (erc-d--finalize-done, erc-d--command-handle-all): * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common-with-cleanup): * test/lisp/erc/resources/erc-tests-common.el (erc-tests--common-display-message) (erc-tests-common-create-subprocess): * test/lisp/ibuffer-tests.el (ibuffer-test-Bug25058): * test/lisp/international/mule-tests.el (mule-cmds-tests--ucs-names-missing-names): * test/lisp/progmodes/python-tests.el (python-tests-get-shell-interpreter) (python-tests--get-interpreter-info): * test/lisp/progmodes/ruby-ts-mode-tests.el (ruby-ts-resource-file): * test/lisp/replace-tests.el (replace-tests-with-undo): * test/src/emacs-tests.el (emacs-tests--seccomp-debug): * test/src/process-tests.el (process-tests--emacs-command) (process-tests--emacs-binary, process-tests--dump-file): * test/src/treesit-tests.el (treesit--ert-test-defun-navigation): Replace use of the now-obsolete if-let and when-let. diff --git a/admin/admin.el b/admin/admin.el index b3f63eef5bb..4a152cdc26b 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -1169,12 +1169,12 @@ changes (in a non-trivial way). This function does not check for that." (declare-function mail-position-on-field "sendmail" (field &optional soft)) (declare-function mail-text "sendmail" ()) - (when-let ((id (alist-get version debbugs-gnu-emacs-blocking-reports - nil nil #'string-equal)) - (status-id (debbugs-get-status id)) - (blockedby-ids (debbugs-get-attribute (car status-id) 'blockedby)) - (blockedby-status - (apply #'debbugs-get-status (sort blockedby-ids #'<)))) + (when-let* ((id (alist-get version debbugs-gnu-emacs-blocking-reports + nil nil #'string-equal)) + (status-id (debbugs-get-status id)) + (blockedby-ids (debbugs-get-attribute (car status-id) 'blockedby)) + (blockedby-status + (apply #'debbugs-get-status (sort blockedby-ids #'<)))) (reporter-submit-bug-report "" ; to-address diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index a3802c8c6bf..0f6b6b8c5be 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -1915,8 +1915,8 @@ interactve contexts covered by the option @lisp (defun my-erc-interactive-display-buffer (buffer action) "Pop to BUFFER when running \\[erc-tls], clicking a link, etc." - (when-let ((alist (cdr action)) - (found (alist-get 'erc-interactive-display alist))) + (when-let* ((alist (cdr action)) + (found (alist-get 'erc-interactive-display alist))) (if (eq found 'erc-tls) (pop-to-buffer-same-window buffer action) (pop-to-buffer buffer action)))) diff --git a/etc/NEWS b/etc/NEWS index a6c2c895985..64e4f22b9d3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -641,6 +641,13 @@ All the characters that belong to the 'symbol' script (according to cc-compat.el, info-edit.el, meese.el, otodo-mode.el, rcompile.el, sup-mouse.el, terminal.el, vi.el, vip.el, ws-mode.el, and yow.el. ++++ +** 'if-let' and 'when-let' are now obsolete. +Use 'if-let*', 'when-let*' and 'and-let*' instead. + +This effectively obsoletes the old '(if-let (SYMBOL SOMETHING) ...)' +single binding syntax, which we'd kept only for backwards compatibility. + * Lisp Changes in Emacs 31.1 diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index b492eb8f07c..4c0969492a0 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -532,7 +532,7 @@ This function can be added to `comint-preoutput-filter-functions'." (while (setq end (string-match ansi-color-control-seq-regexp string start)) (let ((esc-end (match-end 0))) ;; Colorize the old block from start to end using old face. - (when-let ((face (ansi-color--face-vec-face face-vec))) + (when-let* ((face (ansi-color--face-vec-face face-vec))) (put-text-property start end 'font-lock-face face string)) (push (substring string start end) result) @@ -550,7 +550,7 @@ This function can be added to `comint-preoutput-filter-functions'." (when (<= cur-pos esc-end) (string-to-number (match-string 1 string)))))))))) ;; if the rest of the string should have a face, put it there - (when-let ((face (ansi-color--face-vec-face face-vec))) + (when-let* ((face (ansi-color--face-vec-face face-vec))) (put-text-property start (length string) 'font-lock-face face string)) ;; save context, add the remainder of the string to the result @@ -597,7 +597,7 @@ code. It is usually stored as the car of the variable (bright (and ansi-color-bold-is-bright (aref basic-faces 1))) (faces nil)) - (when-let ((fg (car colors))) + (when-let* ((fg (car colors))) (push `(:foreground ,(or (ansi-color--code-as-hex fg) @@ -608,7 +608,7 @@ code. It is usually stored as the car of the variable (mod fg 8)) nil 'default))) faces)) - (when-let ((bg (cadr colors))) + (when-let* ((bg (cadr colors))) (push `(:background ,(or (ansi-color--code-as-hex bg) diff --git a/lisp/ansi-osc.el b/lisp/ansi-osc.el index 8dbaeb45132..6c647c879ad 100644 --- a/lisp/ansi-osc.el +++ b/lisp/ansi-osc.el @@ -84,7 +84,7 @@ located." pos1 (match-beginning 0)))) (setq ansi-osc--marker nil) (delete-region pos0 (point)) - (when-let ((fun (cdr (assoc-string code ansi-osc-handlers)))) + (when-let* ((fun (cdr (assoc-string code ansi-osc-handlers)))) (funcall fun code text))) (put-text-property pos0 end 'invisible t) (setq ansi-osc--marker (copy-marker pos0))))))) @@ -137,7 +137,7 @@ and `shell-dirtrack-mode'." (define-button-type 'ansi-osc-hyperlink 'keymap ansi-osc-hyperlink-map 'help-echo (lambda (_ buffer pos) - (when-let ((url (get-text-property pos 'browse-url-data buffer))) + (when-let* ((url (get-text-property pos 'browse-url-data buffer))) (format "mouse-2, C-c RET: Open %s" url)))) (defvar-local ansi-osc-hyperlink--state nil) diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index bf9def681c3..978c07dfddc 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -1075,7 +1075,7 @@ return nil. Otherwise point is returned." (while (and (not found) (not (eobp))) (forward-line 1) - (when-let ((descr (archive-get-descr t))) + (when-let* ((descr (archive-get-descr t))) (when (equal (archive--file-desc-ext-file-name descr) file) (setq found t)))) (if (not found) @@ -1097,7 +1097,7 @@ return nil. Otherwise point is returned." (beginning-of-line) (bobp))))) (archive-next-line n) - (when-let ((descr (archive-get-descr t))) + (when-let* ((descr (archive-get-descr t))) (let ((candidate (archive--file-desc-ext-file-name descr)) (buffer (current-buffer))) (when (and candidate diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index dd93d414d5e..08abcf6b572 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -88,7 +88,7 @@ HOST, USER, PORT, REQUIRE, and MAX." (auth-source-pass-extra-query-keywords (auth-source-pass--build-result-many host port user require max)) (t - (when-let ((result (auth-source-pass--build-result host port user))) + (when-let* ((result (auth-source-pass--build-result host port user))) (list result))))) (defun auth-source-pass--build-result (hosts port user) @@ -220,7 +220,7 @@ CONTENTS is the contents of a password-store formatted file." (let ((lines (cdr (split-string contents "\n" t "[ \t]+")))) (seq-remove #'null (mapcar (lambda (line) - (when-let ((pos (seq-position line ?:))) + (when-let* ((pos (seq-position line ?:))) (cons (string-trim (substring line 0 pos)) (string-trim (substring line (1+ pos)))))) lines)))) @@ -291,7 +291,7 @@ HOSTS can be a string or a list of strings." (dolist (user (or users (list u))) (dolist (port (or ports (list p))) (dolist (e entries) - (when-let + (when-let* ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed seen e (integerp port)))) ((equal host (plist-get m :host))) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 94082df4502..8ffe7f07cee 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -643,10 +643,10 @@ will use an up-to-date value of `auto-revert-interval'." (defun auto-revert-notify-rm-watch () "Disable file notification for current buffer's associated file." - (when-let ((desc - ;; Don't disable notifications if this is an indirect buffer. - (and (null (buffer-base-buffer)) - auto-revert-notify-watch-descriptor))) + (when-let* ((desc + ;; Don't disable notifications if this is an indirect buffer. + (and (null (buffer-base-buffer)) + auto-revert-notify-watch-descriptor))) (setq auto-revert--buffer-by-watch-descriptor (assoc-delete-all desc auto-revert--buffer-by-watch-descriptor)) (ignore-errors diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 9bd15dde59d..6c617566cd7 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -480,7 +480,7 @@ When called interactively prompt for MARK; RET remove all marks." (save-excursion (goto-char (point-min)) (while (not (eobp)) - (when-let ((entry (tabulated-list-get-entry))) + (when-let* ((entry (tabulated-list-get-entry))) (let ((xmarks (list (aref entry 0) (aref entry 2)))) (when (or (char-equal mark ?\r) (member (char-to-string mark) xmarks)) @@ -891,7 +891,7 @@ See more at `Buffer-menu-filter-predicate'." (declare-function project-root "project" (project)) (defun Buffer-menu-group-by-root (entry) (with-current-buffer (car entry) - (if-let ((project (project-current))) + (if-let* ((project (project-current))) (project-root project) default-directory))) diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index f6fc7a8c162..e6d8b672413 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -214,7 +214,7 @@ This function is like `parse-time-string' except that it returns a Lisp timestamp when successful. See `decode-time' for the meaning of FORM." - (when-let ((time (parse-time-string date-string form))) + (when-let* ((time (parse-time-string date-string form))) (encode-time time))) (provide 'parse-time) diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el index 53256ba3a81..235e09d83c2 100644 --- a/lisp/cedet/pulse.el +++ b/lisp/cedet/pulse.el @@ -167,7 +167,7 @@ Optional argument FACE specifies the face to do the highlighting." (defun pulse-tick (colors stop-time) (if (time-less-p nil stop-time) - (when-let (color (elt colors pulse-momentary-iteration)) + (when-let* ((color (elt colors pulse-momentary-iteration))) (set-face-background 'pulse-highlight-face color) (setq pulse-momentary-iteration (1+ pulse-momentary-iteration))) (pulse-momentary-unhighlight))) diff --git a/lisp/comint.el b/lisp/comint.el index 4961c4e3226..4268fa8dad2 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -4111,7 +4111,7 @@ setting." (font-lock-flush)) (defun comint--fontify-input-ppss-flush-indirect (beg &rest rest) - (when-let ((buf (comint-indirect-buffer t))) + (when-let* ((buf (comint-indirect-buffer t))) (with-current-buffer buf (when (memq #'syntax-ppss-flush-cache before-change-functions) (apply #'syntax-ppss-flush-cache beg rest))))) @@ -4170,7 +4170,7 @@ function called, or nil, if no function was called (if BEG = END)." (text-property-not-all beg1 end 'field 'output) (text-property-any beg1 end 'field 'output)) end)) - (when-let ((fun (if is-output fun-output fun-input))) + (when-let* ((fun (if is-output fun-output fun-input))) (save-restriction (let ((beg2 beg1) (end2 end1)) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index d379b3a1fa6..4564812e8a9 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -380,11 +380,11 @@ candidates or if there are multiple matching completions and (prefix (substring string base))) (when last (setcdr last nil) - (when-let ((sorted (funcall sort-fn - (delete prefix (all-completions prefix all)))) - (common (try-completion prefix sorted)) - (lencom (length common)) - (suffixes sorted)) + (when-let* ((sorted (funcall sort-fn + (delete prefix (all-completions prefix all)))) + (common (try-completion prefix sorted)) + (lencom (length common)) + (suffixes sorted)) (unless (and (cdr suffixes) completion-preview-exact-match-only) ;; Remove the common prefix from each candidate. (while sorted @@ -398,8 +398,8 @@ candidates or if there are multiple matching completions and (and (consp res) (not (functionp res)) (seq-let (beg end table &rest plist) res - (or (when-let ((data (completion-preview--try-table - table beg end plist))) + (or (when-let* ((data (completion-preview--try-table + table beg end plist))) `(,(+ beg (length (car data))) ,end ,plist ,@data)) (unless (eq 'no (plist-get plist :exclusive)) ;; Return non-nil to exclude other capfs. @@ -411,7 +411,7 @@ candidates or if there are multiple matching completions and (run-hook-wrapped 'completion-at-point-functions #'completion-preview--capf-wrapper) - (when-let ((suffix (car suffixes))) + (when-let* ((suffix (car suffixes))) (set-text-properties 0 (length suffix) (list 'face (if (cdr suffixes) 'completion-preview diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index b25dbad5919..8eba4270bcb 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1075,7 +1075,7 @@ even if it doesn't match the type.) (defun setopt--set (variable value) (custom-load-symbol variable) ;; Check that the type is correct. - (when-let ((type (get variable 'custom-type))) + (when-let* ((type (get variable 'custom-type))) (unless (widget-apply (widget-convert type) :match value) (warn "Value `%S' for variable `%s' does not match its type \"%s\"" value variable type))) @@ -5927,7 +5927,7 @@ The appropriate types are: (defun custom-dirlocals-maybe-update-cons () "If focusing out from the first widget in a cons widget, update its value." - (when-let ((w (widget-at))) + (when-let* ((w (widget-at))) (when (widget-get w :custom-dirlocals-symbol) (widget-value-set (widget-get w :parent) (cons (widget-value w) "")) @@ -6018,7 +6018,7 @@ Moves point into the widget that holds the value." If at least an option doesn't validate, signals an error and moves point to the widget with the invalid value." (dolist (opt (custom-dirlocals-get-options)) - (when-let ((w (widget-apply opt :validate))) + (when-let* ((w (widget-apply opt :validate))) (goto-char (widget-get w :from)) (error "%s" (widget-get w :error)))) t) diff --git a/lisp/custom.el b/lisp/custom.el index 1eb6bb7d64d..63d2eea4d94 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1362,7 +1362,7 @@ Return t if THEME was successfully loaded, nil otherwise." t)))) (t (error "Unable to load theme `%s'" theme)))) - (when-let ((obs (get theme 'byte-obsolete-info))) + (when-let* ((obs (get theme 'byte-obsolete-info))) (display-warning 'initialization (format "The `%s' theme is obsolete%s" theme diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 524a6474cd4..1f8b79f5258 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -673,10 +673,10 @@ The character information includes: (if display (format "terminal code %s" display) "not encodable for terminal")))))) - ,@(when-let ((composition-name - (and composition-string - (eq (aref char-script-table char) 'emoji) - (emoji-describe composition-string)))) + ,@(when-let* ((composition-name + (and composition-string + (eq (aref char-script-table char) 'emoji) + (emoji-describe composition-string)))) (list (list "composition name" composition-name))) ,@(let ((face (if (not (or disp-vector composition)) diff --git a/lisp/desktop.el b/lisp/desktop.el index 06f0bbb946e..3ca684efb49 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -699,7 +699,7 @@ DIRNAME omitted or nil means use `desktop-dirname'." (defun desktop--emacs-pid-running-p (pid) "Return non-nil if an Emacs process whose ID is PID might still be running." - (when-let ((attr (process-attributes pid))) + (when-let* ((attr (process-attributes pid))) (let ((proc-cmd (alist-get 'comm attr)) (my-cmd (file-name-nondirectory (car command-line-args))) (case-fold-search t)) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 98cf09945da..1b78b2e2925 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -218,7 +218,7 @@ toggle between those two." ;;; Menu bindings -(when-let ((menu (lookup-key dired-mode-map [menu-bar]))) +(when-let* ((menu (lookup-key dired-mode-map [menu-bar]))) (easy-menu-add-item menu '("Operate") ["Find Files" dired-do-find-marked-files :help "Find current or marked files"] diff --git a/lisp/dired.el b/lisp/dired.el index 625de019d3b..f79a2220bea 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -861,7 +861,7 @@ Set it to nil for remote directories, which suffer from a slow connection." (if (not (connection-local-value dired-check-symlinks)) (search-forward-regexp "\\(.+-> ?\\)\\(.+\\)" end t) - (when-let ((file (dired-file-name-at-point))) + (when-let* ((file (dired-file-name-at-point))) (let ((truename (ignore-errors (file-truename file)))) (and (or (not truename) (not (file-directory-p truename))) @@ -1741,11 +1741,11 @@ see `dired-use-ls-dired' for more details.") (executable-find "sh"))) (switch (if remotep "-c" shell-command-switch))) ;; Enable globstar - (when-let ((globstar dired-maybe-use-globstar) - (enable-it - (assoc-default - (file-truename sh) dired-enable-globstar-in-shell - (lambda (reg shell) (string-match reg shell))))) + (when-let* ((globstar dired-maybe-use-globstar) + (enable-it + (assoc-default + (file-truename sh) dired-enable-globstar-in-shell + (lambda (reg shell) (string-match reg shell))))) (setq script (format "%s; %s" enable-it script))) (unless (zerop @@ -1863,7 +1863,7 @@ see `dired-use-ls-dired' for more details.") ;; Replace "total" with "total used in directory" to ;; avoid confusion. (replace-match "total used in directory" nil nil nil 1)) - (if-let ((available (get-free-disk-space file))) + (if-let* ((available (get-free-disk-space file))) (cond ((eq dired-free-space 'separate) (end-of-line) @@ -2803,7 +2803,7 @@ Keybindings: (let ((point (window-point w))) (save-excursion (goto-char point) - (if-let ((f (dired-get-filename nil t))) + (if-let* ((f (dired-get-filename nil t))) `((dired-filename . ,f)) `((position . ,(point))))))))) (setq-local window-point-context-use-function @@ -2811,9 +2811,9 @@ Keybindings: (with-current-buffer (window-buffer w) (let ((point (window-point w))) (save-excursion - (if-let ((f (alist-get 'dired-filename context))) + (if-let* ((f (alist-get 'dired-filename context))) (dired-goto-file f) - (when-let ((p (alist-get 'position context))) + (when-let* ((p (alist-get 'position context))) (goto-char p))) (setq point (point))) (set-window-point w point))))) diff --git a/lisp/dnd.el b/lisp/dnd.el index 411f0d5774c..bf8d3908619 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -270,8 +270,8 @@ for it will be modified." ;; assigned their own handlers. (dolist (leftover urls) (setq return-value 'private) - (if-let ((handler (browse-url-select-handler leftover - 'internal))) + (if-let* ((handler (browse-url-select-handler leftover + 'internal))) (funcall handler leftover action) (dnd-insert-text window action leftover))) (or return-value 'private)))) diff --git a/lisp/dom.el b/lisp/dom.el index b329379fdc3..616778051bf 100644 --- a/lisp/dom.el +++ b/lisp/dom.el @@ -65,7 +65,7 @@ (defun dom-remove-attribute (node attribute) "Remove ATTRIBUTE from NODE." (setq node (dom-ensure-node node)) - (when-let ((old (assoc attribute (cadr node)))) + (when-let* ((old (assoc attribute (cadr node)))) (setcar (cdr node) (delq old (cadr node))))) (defmacro dom-attr (node attr) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index d8dbfa62bf9..0a89a33cbc3 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -483,7 +483,7 @@ There can be multiple entries for the same NAME if it has several aliases.") `(,fn ,name . ,optimized-rest))) ((guard (when for-effect - (if-let ((tmp (byte-opt--fget fn 'side-effect-free))) + (if-let* ((tmp (byte-opt--fget fn 'side-effect-free))) (or byte-compile-delete-errors (eq tmp 'error-free))))) (byte-compile-log " %s called for effect; deleted" fn) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 29e7882c851..f058fc48cc7 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5470,9 +5470,9 @@ FORM is used to provide location, `bytecomp--cus-function' and (setq byte-compile-current-group name)) ;; Check :local - (when-let ((val (and (eq fun 'custom-declare-variable) - (plist-get keyword-args :local))) - (_ (not (member val '(t 'permanent 'permanent-only))))) + (when-let* ((val (and (eq fun 'custom-declare-variable) + (plist-get keyword-args :local))) + (_ (not (member val '(t 'permanent 'permanent-only))))) (bytecomp--cus-warn form ":local keyword does not accept %S" val)))) (byte-compile-normal-call form)) diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index e9b94681a4b..78720949b67 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -510,13 +510,13 @@ comes from `comp-primitive-type-specifiers' or the function type declaration itself." (let ((kind 'declared) type-spec) - (when-let ((res (assoc function comp-primitive-type-specifiers))) + (when-let* ((res (assoc function comp-primitive-type-specifiers))) ;; Declared primitive (setf type-spec (cadr res))) (let ((f (and (symbolp function) (symbol-function function)))) (when (and f (null type-spec)) - (if-let ((delc-type (function-get function 'function-type))) + (if-let* ((delc-type (function-get function 'function-type))) ;; Declared Lisp function (setf type-spec delc-type) (when (native-comp-function-p f) diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 3f70b42774f..e1350370750 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -89,10 +89,10 @@ Integer values are handled in the `range' slot.") "Return all non built-in type names currently defined." (let (res) (mapatoms (lambda (x) - (when-let ((class (cl-find-class x)) - ;; Ignore EIEIO classes as they can be - ;; redefined at runtime. - (gate (not (eq 'eieio--class (type-of class))))) + (when-let* ((class (cl-find-class x)) + ;; Ignore EIEIO classes as they can be + ;; redefined at runtime. + (gate (not (eq 'eieio--class (type-of class))))) (push x res))) obarray) res)) @@ -528,8 +528,8 @@ Return them as multiple value." `(with-comp-cstr-accessors (if (or (neg src1) (neg src2)) (setf (typeset ,dst) '(number)) - (when-let ((r1 (range ,src1)) - (r2 (range ,src2))) + (when-let* ((r1 (range ,src1)) + (r2 (range ,src2))) (let* ((l1 (comp-cstr-smallest-in-range r1)) (l2 (comp-cstr-smallest-in-range r2)) (h1 (comp-cstr-greatest-in-range r1)) @@ -620,7 +620,7 @@ DST is returned." ;; Check first if we are in the simple case of all input non-negate ;; or negated so we don't have to cons. - (when-let ((res (comp--cstrs-homogeneous srcs))) + (when-let* ((res (comp--cstrs-homogeneous srcs))) (apply #'comp--cstr-union-homogeneous range dst srcs) (cl-return-from comp--cstr-union-1-no-mem dst)) @@ -805,7 +805,7 @@ Non memoized version of `comp-cstr-intersection-no-mem'." (range dst) () (neg dst) nil) (cl-return-from comp-cstr-intersection-no-mem dst))) - (when-let ((res (comp--cstrs-homogeneous srcs))) + (when-let* ((res (comp--cstrs-homogeneous srcs))) (if (eq res 'neg) (apply #'comp--cstr-union-homogeneous t dst srcs) (apply #'comp-cstr-intersection-homogeneous dst srcs)) @@ -917,7 +917,7 @@ Non memoized version of `comp-cstr-intersection-no-mem'." (when (and (null (neg cstr)) (null (valset cstr)) (null (typeset cstr))) - (when-let (range (range cstr)) + (when-let* ((range (range cstr))) (let* ((low (caar range)) (high (cdar (last range)))) (unless (or (eq low '-) @@ -949,7 +949,7 @@ Non memoized version of `comp-cstr-intersection-no-mem'." (or (null (typeset cstr)) (equal (typeset cstr) '(integer))))))) (t - (if-let ((pred (get type 'cl-deftype-satisfies))) + (if-let* ((pred (get type 'cl-deftype-satisfies))) (and (null (range cstr)) (null (neg cstr)) (if (null (typeset cstr)) diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index 3c7802c2ee0..b4f8b46b93a 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -370,8 +370,8 @@ Return the trampoline if found or nil otherwise." (memq subr-name native-comp-never-optimize-functions) (gethash subr-name comp-installed-trampolines-h)) (cl-assert (subr-primitive-p subr)) - (when-let ((trampoline (or (comp--trampoline-search subr-name) - (comp-trampoline-compile subr-name)))) + (when-let* ((trampoline (or (comp--trampoline-search subr-name) + (comp-trampoline-compile subr-name)))) (comp--install-trampoline subr-name trampoline))))) ;;;###autoload @@ -423,7 +423,7 @@ bytecode definition was not changed in the meantime)." (t (signal 'native-compiler-error (list "Not a file nor directory" file-or-dir))))) (dolist (file file-list) - (if-let ((entry (seq-find (lambda (x) (string= file (car x))) comp-files-queue))) + (if-let* ((entry (seq-find (lambda (x) (string= file (car x))) comp-files-queue))) ;; Most likely the byte-compiler has requested a deferred ;; compilation, so update `comp-files-queue' to reflect that. (unless (or (null load) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 96341b0a39f..da351e99d91 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -201,9 +201,9 @@ Useful to hook into pass checkers.") "Given FUNCTION return the corresponding `comp-constraint'." (when (symbolp function) (or (gethash function comp-primitive-func-cstr-h) - (when-let ((type (or (when-let ((f (comp--symbol-func-to-fun function))) - (comp-func-declared-type f)) - (function-get function 'function-type)))) + (when-let* ((type (or (when-let* ((f (comp--symbol-func-to-fun function))) + (comp-func-declared-type f)) + (function-get function 'function-type)))) (comp-type-spec-to-cstr type))))) ;; Keep it in sync with the `cl-deftype-satisfies' property set in @@ -617,7 +617,7 @@ In use by the back-end." (defun comp--function-pure-p (f) "Return t if F is pure." (or (get f 'pure) - (when-let ((func (comp--symbol-func-to-fun f))) + (when-let* ((func (comp--symbol-func-to-fun f))) (comp-func-pure func)))) (defun comp--alloc-class-to-container (alloc-class) @@ -819,7 +819,7 @@ clashes." (defun comp--intern-func-in-ctxt (_ obj) "Given OBJ of type `byte-to-native-lambda', create a function in `comp-ctxt'." - (when-let ((byte-func (byte-to-native-lambda-byte-func obj))) + (when-let* ((byte-func (byte-to-native-lambda-byte-func obj))) (let* ((lap (byte-to-native-lambda-lap obj)) (top-l-form (cl-loop for form in (comp-ctxt-top-level-forms comp-ctxt) @@ -1705,7 +1705,7 @@ into the C code forwarding the compilation unit." ;; FIXME Actually we could have another hash for this. (cl-flet ((pred (bb) (equal (comp-block-lap-addr bb) addr))) - (if-let ((pending (cl-find-if #'pred + (if-let* ((pending (cl-find-if #'pred (comp-limplify-pending-blocks comp-pass)))) (comp-block-name pending) (cl-loop for bb being the hash-value in (comp-func-blocks comp-func) @@ -1882,9 +1882,9 @@ The assume is emitted at the beginning of the block BB." rhs))) (comp-block-insns bb)))) ((pred comp--arithm-cmp-fun-p) - (when-let ((kind (if negated - (comp--negate-arithm-cmp-fun kind) - kind))) + (when-let* ((kind (if negated + (comp--negate-arithm-cmp-fun kind) + kind))) (push `(assume ,(make--comp-mvar :slot lhs-slot) (,kind ,lhs ,(if-let* ((vld (comp-cstr-imm-vld-p rhs)) @@ -1900,10 +1900,10 @@ The assume is emitted at the beginning of the block BB." (defun comp--maybe-add-vmvar (op cmp-res insns-seq) "If CMP-RES is clobbering OP emit a new constrained mvar and return it. Return OP otherwise." - (if-let ((match (eql (comp-mvar-slot op) (comp-mvar-slot cmp-res))) - (new-mvar (make--comp-mvar - :slot - (- (cl-incf (comp-func-vframe-size comp-func)))))) + (if-let* ((match (eql (comp-mvar-slot op) (comp-mvar-slot cmp-res))) + (new-mvar (make--comp-mvar + :slot + (- (cl-incf (comp-func-vframe-size comp-func)))))) (progn (push `(assume ,new-mvar ,op) (cdr insns-seq)) new-mvar) @@ -2139,14 +2139,14 @@ TARGET-BB-SYM is the symbol name of the target block." for bb being each hash-value of (comp-func-blocks comp-func) do (comp--loop-insn-in-block bb - (when-let ((match - (pcase insn - (`(set ,lhs (,(pred comp--call-op-p) ,f . ,args)) - (when-let ((cstr-f (comp--get-function-cstr f))) - (cl-values f cstr-f lhs args))) - (`(,(pred comp--call-op-p) ,f . ,args) - (when-let ((cstr-f (comp--get-function-cstr f))) - (cl-values f cstr-f nil args)))))) + (when-let* ((match + (pcase insn + (`(set ,lhs (,(pred comp--call-op-p) ,f . ,args)) + (when-let* ((cstr-f (comp--get-function-cstr f))) + (cl-values f cstr-f lhs args))) + (`(,(pred comp--call-op-p) ,f . ,args) + (when-let* ((cstr-f (comp--get-function-cstr f))) + (cl-values f cstr-f nil args)))))) (cl-multiple-value-bind (f cstr-f lhs args) match (cl-loop with gen = (comp--lambda-list-gen (comp-cstr-f-args cstr-f)) @@ -2340,14 +2340,14 @@ blocks." finger2 (comp-block-post-num b2)))) b1)) (first-processed (l) - (if-let ((p (cl-find-if #'comp-block-idom l))) + (if-let* ((p (cl-find-if #'comp-block-idom l))) p (signal 'native-ice '("can't find first preprocessed"))))) - (when-let ((blocks (comp-func-blocks comp-func)) - (entry (gethash 'entry blocks)) - ;; No point to go on if the only bb is 'entry'. - (bb0 (gethash 'bb_0 blocks))) + (when-let* ((blocks (comp-func-blocks comp-func)) + (entry (gethash 'entry blocks)) + ;; No point to go on if the only bb is 'entry'. + (bb0 (gethash 'bb_0 blocks))) (cl-loop with rev-bb-list = (comp--collect-rev-post-order entry) with changed = t @@ -2450,7 +2450,7 @@ blocks." PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (when pre-lambda (funcall pre-lambda bb)) - (when-let ((out-edges (comp-block-out-edges bb))) + (when-let* ((out-edges (comp-block-out-edges bb))) (cl-loop for ed in out-edges for child = (comp-edge-dst ed) when (eq bb (comp-block-idom child)) @@ -2508,7 +2508,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." do (comp--ssa-rename-insn insn in-frame)) (setf (comp-block-final-frame bb) (copy-sequence in-frame)) - (when-let ((out-edges (comp-block-out-edges bb))) + (when-let* ((out-edges (comp-block-out-edges bb))) (cl-loop for ed in out-edges for child = (comp-edge-dst ed) @@ -2668,7 +2668,7 @@ Return non-nil if the function is folded successfully." ;; should do basic block pruning in order to be sure that this ;; is not dead-code. This is now left to gcc, to be ;; implemented only if we want a reliable diagnostic here. - (let* ((f (if-let (f-in-ctxt (comp--symbol-func-to-fun f)) + (let* ((f (if-let* ((f-in-ctxt (comp--symbol-func-to-fun f))) ;; If the function is IN the compilation ctxt ;; and know to be pure. (comp-func-byte-func f-in-ctxt) @@ -2685,7 +2685,7 @@ Fold the call in case." (comp-cstr-imm-vld-p (car args))) (setf f (comp-cstr-imm (car args)) args (cdr args))) - (when-let ((cstr-f (comp--get-function-cstr f))) + (when-let* ((cstr-f (comp--get-function-cstr f))) (let ((cstr (comp-cstr-f-ret cstr-f))) (when (comp-cstr-empty-p cstr) ;; Store it to be rewritten as non local exit. @@ -2968,14 +2968,14 @@ FUNCTION can be a function-name or byte compiled function." do (comp--loop-insn-in-block b (pcase insn (`(set ,lval (callref funcall ,f . ,rest)) - (when-let ((ok (comp-cstr-imm-vld-p f)) - (new-form (comp--call-optim-form-call - (comp-cstr-imm f) rest))) + (when-let* ((ok (comp-cstr-imm-vld-p f)) + (new-form (comp--call-optim-form-call + (comp-cstr-imm f) rest))) (setf insn `(set ,lval ,new-form)))) (`(callref funcall ,f . ,rest) - (when-let ((ok (comp-cstr-imm-vld-p f)) - (new-form (comp--call-optim-form-call - (comp-cstr-imm f) rest))) + (when-let* ((ok (comp-cstr-imm-vld-p f)) + (new-form (comp--call-optim-form-call + (comp-cstr-imm f) rest))) (setf insn new-form))))))) (defun comp--call-optim (_) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index deebe5109bd..b96d2437b8a 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3922,8 +3922,8 @@ be installed in `emacs-lisp-mode-map'.") (define-obsolete-variable-alias 'global-edebug-prefix 'edebug-global-prefix "28.1") (defvar edebug-global-prefix - (when-let ((binding - (car (where-is-internal 'Control-X-prefix (list global-map))))) + (when-let* ((binding + (car (where-is-internal 'Control-X-prefix (list global-map))))) (concat binding [?X])) "Prefix key for global edebug commands, available from any buffer.") @@ -4659,8 +4659,8 @@ instrumentation for, defaulting to all functions." functions))))) ;; Remove instrumentation. (dolist (symbol functions) - (when-let ((unwrapped - (edebug--unwrap*-symbol-function symbol))) + (when-let* ((unwrapped + (edebug--unwrap*-symbol-function symbol))) (edebug--strip-plist symbol) (defalias symbol unwrapped))) (message "Removed edebug instrumentation from %s" diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 74f5e21db7d..98d9a2d2f4f 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -769,10 +769,10 @@ dynamically set from ARGS." (let* ((slot (aref slots i)) (slot-name (eieio-slot-descriptor-name slot)) (initform (cl--slot-descriptor-initform slot))) - (unless (or (when-let ((initarg - (car (rassq slot-name - (eieio--class-initarg-tuples - this-class))))) + (unless (or (when-let* ((initarg + (car (rassq slot-name + (eieio--class-initarg-tuples + this-class))))) (plist-get initargs initarg)) ;; Those slots whose initform is constant already have ;; the right value set in the default-object. diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index cd60f9f457f..8469440c982 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -395,8 +395,8 @@ variable `ert-resource-directory-format'. Before formatting, the file name will be trimmed using `string-trim' with arguments `ert-resource-directory-trim-left-regexp' and `ert-resource-directory-trim-right-regexp'." - `(when-let ((testfile ,(or (macroexp-file-name) - buffer-file-name))) + `(when-let* ((testfile ,(or (macroexp-file-name) + buffer-file-name))) (let ((default-directory (file-name-directory testfile))) (file-truename (if (file-accessible-directory-p "resources/") diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index fa1b7a60a90..97aa233f6e2 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -328,8 +328,8 @@ DATA is displayed to the user and should state the reason for skipping." (unless (eql ,value ',default-value) (list :value ,value)) (unless (eql ,value ',default-value) - (when-let ((-explainer- - (ert--get-explainer ',fn-name))) + (when-let* ((-explainer- + (ert--get-explainer ',fn-name))) (list :explanation (apply -explainer- ,args))))) value) @@ -1352,10 +1352,10 @@ RESULT must be an `ert-test-result-with-condition'." (defun ert-test-location (test) "Return a string description the source location of TEST." - (when-let ((loc - (ignore-errors - (find-function-search-for-symbol - (ert-test-name test) 'ert-deftest (ert-test-file-name test))))) + (when-let* ((loc + (ignore-errors + (find-function-search-for-symbol + (ert-test-name test) 'ert-deftest (ert-test-file-name test))))) (let* ((buffer (car loc)) (point (cdr loc)) (file (file-relative-name (buffer-file-name buffer))) @@ -1548,11 +1548,11 @@ test packages depend on each other, it might be helpful.") "Write a JUnit test report, generated from STATS." ;; https://www.ibm.com/docs/en/developer-for-zos/14.1.0?topic=formats-junit-xml-format ;; https://llg.cubic.org/docs/junit/ - (when-let ((symbol (car (apropos-internal "" #'ert-test-boundp))) - (test-file (symbol-file symbol 'ert--test)) - (test-report - (file-name-with-extension - (or ert-load-file-name test-file) "xml"))) + (when-let* ((symbol (car (apropos-internal "" #'ert-test-boundp))) + (test-file (symbol-file symbol 'ert--test)) + (test-report + (file-name-with-extension + (or ert-load-file-name test-file) "xml"))) (with-temp-file test-report (insert "\n") (insert (format "\n" @@ -2906,10 +2906,10 @@ write erts files." (setq end-before end-after start-after start-before)) ;; Update persistent specs. - (when-let ((point-char (assq 'point-char specs))) + (when-let* ((point-char (assq 'point-char specs))) (setq gen-specs (map-insert gen-specs 'point-char (cdr point-char)))) - (when-let ((code (cdr (assq 'code specs)))) + (when-let* ((code (cdr (assq 'code specs)))) (setq gen-specs (map-insert gen-specs 'code (car (read-from-string code))))) ;; Get the "after" strings. @@ -2917,12 +2917,12 @@ write erts files." (insert-buffer-substring file-buffer start-after end-after) (ert--erts-unquote) ;; Remove the newline at the end of the buffer. - (when-let ((no-newline (cdr (assq 'no-after-newline specs)))) + (when-let* ((no-newline (cdr (assq 'no-after-newline specs)))) (goto-char (point-min)) (when (re-search-forward "\n\\'" nil t) (delete-region (match-beginning 0) (match-end 0)))) ;; Get the expected "after" point. - (when-let ((point-char (cdr (assq 'point-char gen-specs)))) + (when-let* ((point-char (cdr (assq 'point-char gen-specs)))) (goto-char (point-min)) (when (search-forward point-char nil t) (delete-region (match-beginning 0) (match-end 0)) @@ -2933,13 +2933,13 @@ write erts files." (insert-buffer-substring file-buffer start-before end-before) (ert--erts-unquote) ;; Remove the newline at the end of the buffer. - (when-let ((no-newline (cdr (assq 'no-before-newline specs)))) + (when-let* ((no-newline (cdr (assq 'no-before-newline specs)))) (goto-char (point-min)) (when (re-search-forward "\n\\'" nil t) (delete-region (match-beginning 0) (match-end 0)))) (goto-char (point-min)) ;; Place point in the specified place. - (when-let ((point-char (cdr (assq 'point-char gen-specs)))) + (when-let* ((point-char (cdr (assq 'point-char gen-specs)))) (when (search-forward point-char nil t) (delete-region (match-beginning 0) (match-end 0)))) (let ((code (cdr (assq 'code gen-specs)))) diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index 847ef53a1cb..144b60a2c1d 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -119,7 +119,7 @@ If OBJECT is an icon, return the icon properties." (setq spec (icons--copy-spec spec)) ;; Let the Customize theme override. (unless inhibit-theme - (when-let ((theme-spec (cadr (car (get icon 'theme-icon))))) + (when-let* ((theme-spec (cadr (car (get icon 'theme-icon))))) (setq spec (icons--merge-spec (icons--copy-spec theme-spec) spec)))) ;; Inherit from the parent spec (recursively). (unless inhibit-inheritance @@ -149,15 +149,15 @@ If OBJECT is an icon, return the icon properties." ;; Go through all the variations in this section ;; and return the first one we can display. (dolist (icon (icon-spec-values type-spec)) - (when-let ((result - (icons--create type icon type-keywords))) + (when-let* ((result + (icons--create type icon type-keywords))) (throw 'found - (if-let ((face (plist-get type-keywords :face))) + (if-let* ((face (plist-get type-keywords :face))) (propertize result 'face face) result))))))))) (unless icon-string (error "Couldn't find any way to display the %s icon" name)) - (when-let ((help (plist-get keywords :help-echo))) + (when-let* ((help (plist-get keywords :help-echo))) (setq icon-string (propertize icon-string 'help-echo help))) (propertize icon-string 'rear-nonsticky t))))) @@ -200,18 +200,18 @@ present if the icon is represented by an image." " " 'display (let ((props (append - (if-let ((height (plist-get keywords :height))) + (if-let* ((height (plist-get keywords :height))) (list :height (if (eq height 'line) (window-default-line-height) height))) - (if-let ((width (plist-get keywords :width))) + (if-let* ((width (plist-get keywords :width))) (list :width (if (eq width 'font) (default-font-width) width))) '(:scale 1) - (if-let ((rotation (plist-get keywords :rotation))) + (if-let* ((rotation (plist-get keywords :rotation))) (list :rotation rotation)) - (if-let ((margin (plist-get keywords :margin))) + (if-let* ((margin (plist-get keywords :margin))) (list :margin margin)) (list :ascent (if (plist-member keywords :ascent) (plist-get keywords :ascent) @@ -219,10 +219,10 @@ present if the icon is represented by an image." (apply 'create-image file nil nil props)))))) (cl-defmethod icons--create ((_type (eql 'emoji)) icon _keywords) - (when-let ((font (and (display-multi-font-p) - ;; FIXME: This is not enough for ensuring - ;; display of color Emoji. - (car (internal-char-font nil ?🟠))))) + (when-let* ((font (and (display-multi-font-p) + ;; FIXME: This is not enough for ensuring + ;; display of color Emoji. + (car (internal-char-font nil ?🟠))))) (and (font-has-char-p font (aref icon 0)) icon))) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 601cc7bf712..220bb5175ea 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1153,7 +1153,7 @@ is the buffer position of the start of the containing expression." (defun lisp--local-defform-body-p (state) "Return non-nil when at local definition body according to STATE. STATE is the `parse-partial-sexp' state for current position." - (when-let ((start-of-innermost-containing-list (nth 1 state))) + (when-let* ((start-of-innermost-containing-list (nth 1 state))) (let* ((parents (nth 9 state)) (first-cons-after (cdr parents)) (second-cons-after (cdr first-cons-after)) @@ -1171,11 +1171,11 @@ STATE is the `parse-partial-sexp' state for current position." (let (local-definitions-starting-point) (and (save-excursion (goto-char (1+ second-order-parent)) - (when-let ((head (ignore-errors - ;; FIXME: This does not distinguish - ;; between reading nil and a read error. - ;; We don't care but still, better fix this. - (read (current-buffer))))) + (when-let* ((head (ignore-errors + ;; FIXME: This does not distinguish + ;; between reading nil and a read error. + ;; We don't care but still, better fix this. + (read (current-buffer))))) (when (memq head '( cl-flet cl-labels cl-macrolet cl-flet* cl-symbol-macrolet)) ;; In what follows, we rely on (point) returning non-nil. diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 50e90cdf94c..1ac7aecdb66 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -295,7 +295,7 @@ expression, in which case we want to handle forms differently." (null (plist-get props :set)) (error nil))) ;; Propagate the :safe property to the loaddefs file. - ,@(when-let ((safe (plist-get props :safe))) + ,@(when-let* ((safe (plist-get props :safe))) `((put ',varname 'safe-local-variable ,safe)))))) ;; Extract theme properties. @@ -413,8 +413,8 @@ don't include." (save-excursion ;; Since we're "open-coding", we have to repeat more ;; complicated logic in `hack-local-variables'. - (when-let ((beg - (re-search-forward "read-symbol-shorthands: *" nil t))) + (when-let* ((beg + (re-search-forward "read-symbol-shorthands: *" nil t))) ;; `read-symbol-shorthands' alist ends with two parens. (let* ((end (re-search-forward ")[;\n\s]*)")) (commentless (replace-regexp-in-string @@ -499,7 +499,7 @@ don't include." (when (and autoload-compute-prefixes compute-prefixes) (with-demoted-errors "%S" - (when-let + (when-let* ((form (loaddefs-generate--compute-prefixes load-name))) ;; This output needs to always go in the main loaddefs.el, ;; regardless of `generated-autoload-file'. diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el index c923c29bbf7..71be928e30f 100644 --- a/lisp/emacs-lisp/multisession.el +++ b/lisp/emacs-lisp/multisession.el @@ -428,8 +428,8 @@ storage method to list." (tabulated-list-print t) (goto-char (point-min)) (when id - (when-let ((match - (text-property-search-forward 'tabulated-list-id id t))) + (when-let* ((match + (text-property-search-forward 'tabulated-list-id id t))) (goto-char (prop-match-beginning match)))))) (defun multisession-delete-value (id) @@ -456,7 +456,7 @@ storage method to list." (let* ((object (or ;; If the multisession variable already exists, use ;; it (so that we update it). - (if-let (sym (intern-soft (cdr id))) + (if-let* ((sym (intern-soft (cdr id)))) (and (boundp sym) (symbol-value sym)) nil) ;; Create a new object. diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index e168096e153..894bc9c8c37 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -247,8 +247,8 @@ This function is meant to be used as a hook for `package-read-archive-hook'." (car spec))) (setf (alist-get (intern archive) package-vc--archive-data-alist) (cdr spec)) - (when-let ((default-vc (plist-get (cdr spec) :default-vc)) - ((not (memq default-vc vc-handled-backends)))) + (when-let* ((default-vc (plist-get (cdr spec) :default-vc)) + ((not (memq default-vc vc-handled-backends)))) (warn "Archive `%S' expects missing VC backend %S" archive (plist-get (cdr spec) :default-vc))))))))) @@ -279,7 +279,7 @@ asynchronously." (defun package-vc--version (pkg) "Return the version number for the VC package PKG." (cl-assert (package-vc-p pkg)) - (if-let ((main-file (package-vc--main-file pkg))) + (if-let* ((main-file (package-vc--main-file pkg))) (with-temp-buffer (insert-file-contents main-file) (package-strip-rcs-id @@ -663,7 +663,7 @@ attribute in PKG-SPEC." ;; Check out the latest release if requested (when (eq rev :last-release) - (if-let ((release-rev (package-vc--release-rev pkg-desc))) + (if-let* ((release-rev (package-vc--release-rev pkg-desc))) (vc-retrieve-tag dir release-rev) (message "No release revision was found, continuing..."))))) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 90d6150ed0b..af07ba44e28 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -858,22 +858,22 @@ byte-compilation of the new package to fail." (cl-remove-if-not #'stringp (mapcar #'car load-history))))) (dolist (file files) - (when-let ((library (package--library-stem - (file-relative-name file dir))) - (canonical (locate-library library nil effective-path)) - (truename (file-truename canonical)) - ;; Normally, all files in a package are compiled by - ;; now, but don't assume that. E.g. different - ;; versions can add or remove `no-byte-compile'. - (altname (if (string-suffix-p ".el" truename) - (replace-regexp-in-string - "\\.el\\'" ".elc" truename t) - (replace-regexp-in-string - "\\.elc\\'" ".el" truename t))) - (found (or (member truename history) - (and (not (string= altname truename)) - (member altname history)))) - (recent-index (length found))) + (when-let* ((library (package--library-stem + (file-relative-name file dir))) + (canonical (locate-library library nil effective-path)) + (truename (file-truename canonical)) + ;; Normally, all files in a package are compiled by + ;; now, but don't assume that. E.g. different + ;; versions can add or remove `no-byte-compile'. + (altname (if (string-suffix-p ".el" truename) + (replace-regexp-in-string + "\\.el\\'" ".elc" truename t) + (replace-regexp-in-string + "\\.elc\\'" ".el" truename t))) + (found (or (member truename history) + (and (not (string= altname truename)) + (member altname history)))) + (recent-index (length found))) (unless (equal (file-name-base library) (format "%s-autoloads" (package-desc-name pkg-desc))) (push (cons (expand-file-name library dir) recent-index) result)))) diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 12346b3d285..e246e4211bb 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -491,8 +491,8 @@ the bounds of a region containing Lisp code to pretty-print." (cons (cond ((consp (cdr sexp)) (let ((head (car sexp))) - (if-let (((null (cddr sexp))) - (syntax-entry (assq head pp--quoting-syntaxes))) + (if-let* (((null (cddr sexp))) + (syntax-entry (assq head pp--quoting-syntaxes))) (progn (insert (cdr syntax-entry)) (pp--insert-lisp (cadr sexp))) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 3b4907b8f43..2427d76734e 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -475,7 +475,7 @@ this defaults to the current buffer." (t disp))) ;; Remove any old instances. - (when-let ((old (assoc prop disp))) + (when-let* ((old (assoc prop disp))) (setq disp (delete old disp))) (setq disp (cons (list prop value) disp)) (when vector diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 30397137efb..eaf3c5cb561 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -492,8 +492,8 @@ changing `tabulated-list-sort-key'." (if groups (dolist (group groups) (insert (car group) ?\n) - (when-let ((saved-pt-new (tabulated-list-print-entries - (cdr group) sorter update entry-id))) + (when-let* ((saved-pt-new (tabulated-list-print-entries + (cdr group) sorter update entry-id))) (setq saved-pt saved-pt-new))) (setq saved-pt (tabulated-list-print-entries entries sorter update entry-id))) diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index f6f2a8d87c0..166755e4dcc 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -407,7 +407,7 @@ This function returns a timer object which you can use in ;; Handle relative times like "2 hours 35 minutes". (when (stringp time) - (when-let ((secs (timer-duration time))) + (when-let* ((secs (timer-duration time))) (setq time (timer-relative-time nil secs)))) ;; Handle "11:23pm" and the like. Interpret it as meaning today diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index d58c6894c16..925961f012c 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -271,7 +271,7 @@ If TABLE is found, return the position of the start of the table. If it can't be found, return nil and don't move point." (let ((start (point))) (goto-char (point-min)) - (if-let ((match (text-property-search-forward 'vtable table t))) + (if-let* ((match (text-property-search-forward 'vtable table t))) (goto-char (prop-match-beginning match)) (goto-char start) nil))) @@ -279,7 +279,7 @@ If it can't be found, return nil and don't move point." (defun vtable-goto-column (column) "Go to COLUMN on the current line." (beginning-of-line) - (if-let ((match (text-property-search-forward 'vtable-column column t))) + (if-let* ((match (text-property-search-forward 'vtable-column column t))) (goto-char (prop-match-beginning match)) (end-of-line))) @@ -311,10 +311,10 @@ is signaled." ;; FIXME: If the table's buffer has no visible window, or if its ;; width has changed since the table was updated, the cache key will ;; not match and the object can't be updated. (Bug #69837). - (if-let ((line-number (seq-position (car (vtable--cache table)) old-object - (lambda (a b) - (equal (car a) b)))) - (line (elt (car (vtable--cache table)) line-number))) + (if-let* ((line-number (seq-position (car (vtable--cache table)) old-object + (lambda (a b) + (equal (car a) b)))) + (line (elt (car (vtable--cache table)) line-number))) (progn (setcar line object) (setcdr line (vtable--compute-cached-line table object)) @@ -638,7 +638,7 @@ This also updates the displayed table." (insert "\n") (put-text-property start (point) 'vtable-object (car line)) (unless column-colors - (when-let ((row-colors (slot-value table '-cached-colors))) + (when-let* ((row-colors (slot-value table '-cached-colors))) (add-face-text-property start (point) (elt row-colors (mod line-number (length row-colors)))))))) @@ -865,13 +865,13 @@ If NEXT, do the next column." (nth 1 (elt (cdr elem) index))) cache))))) ;; Let min-width/max-width specs have their say. - (when-let ((min-width (and (vtable-column-min-width column) - (vtable--compute-width - table (vtable-column-min-width column))))) + (when-let* ((min-width (and (vtable-column-min-width column) + (vtable--compute-width + table (vtable-column-min-width column))))) (setq width (max width min-width))) - (when-let ((max-width (and (vtable-column-max-width column) - (vtable--compute-width - table (vtable-column-max-width column))))) + (when-let* ((max-width (and (vtable-column-max-width column) + (vtable--compute-width + table (vtable-column-max-width column))))) (setq width (min width max-width))) width)) (vtable-columns table)) @@ -904,7 +904,7 @@ If NEXT, do the next column." (vtable-keymap table)) (copy-keymap vtable-map) vtable-map))) - (when-let ((actions (vtable-actions table))) + (when-let* ((actions (vtable-actions table))) (while actions (funcall (lambda (key binding) (keymap-set map key diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index 68db33bfa68..b11e1ebeb70 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -285,7 +285,7 @@ entirely by setting `warning-suppress-types' or (unless buffer-name (setq buffer-name "*Warnings*")) (with-suppressed-warnings ((obsolete warning-level-aliases)) - (when-let ((new (cdr (assq level warning-level-aliases)))) + (when-let* ((new (cdr (assq level warning-level-aliases)))) (warn "Warning level `%s' is obsolete; use `%s' instead" level new) (setq level new))) (or (< (warning-numeric-level level) diff --git a/lisp/epa-file.el b/lisp/epa-file.el index 90cc91e99a0..ee0a665aa62 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -177,7 +177,7 @@ encryption is used." (nth 3 error))) (let ((exists (file-exists-p local-file))) (when exists - (if-let ((wrong-password (epa--wrong-password-p context))) + (if-let* ((wrong-password (epa--wrong-password-p context))) ;; Don't display the *error* buffer if we just ;; have a wrong password; let the later error ;; handler notify the user. diff --git a/lisp/epa.el b/lisp/epa.el index c29df18bb58..e7856f8463b 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -498,7 +498,7 @@ If SECRET is non-nil, list secret keys instead of public keys." (defun epa-show-key () "Show a key on the current line." (interactive) - (if-let ((key (get-text-property (point) 'epa-key))) + (if-let* ((key (get-text-property (point) 'epa-key))) (save-selected-window (epa--show-key key)) (error "No key on this line"))) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 16e8cae4733..e72fa036f17 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -605,7 +605,7 @@ escape hatch for inhibiting their transmission.") (concat "Unbreakable line encountered " "(Recover input with \\[erc-previous-command])")))) (goto-char upper)) - (when-let ((cmp (find-composition (point) (1+ (point))))) + (when-let* ((cmp (find-composition (point) (1+ (point))))) (if (= (car cmp) (point-min)) (goto-char (nth 1 cmp)) (goto-char (car cmp))))) @@ -1057,9 +1057,9 @@ Conditionally try to reconnect and take appropriate action." (setq erc--hidden-prompt-overlay nil))) (cl-defmethod erc--conceal-prompt () - (when-let (((null erc--hidden-prompt-overlay)) - (ov (make-overlay erc-insert-marker (1- erc-input-marker) - nil 'front-advance))) + (when-let* (((null erc--hidden-prompt-overlay)) + (ov (make-overlay erc-insert-marker (1- erc-input-marker) + nil 'front-advance))) (defvar erc-prompt-hidden) (overlay-put ov 'display erc-prompt-hidden) (setq erc--hidden-prompt-overlay ov))) @@ -2078,12 +2078,12 @@ like `erc-insert-modify-hook'.") (defvar erc-receive-query-display) (defvar erc-receive-query-display-defer) (if privp - (when-let ((erc-join-buffer - (or (and (not erc-receive-query-display-defer) - erc-receive-query-display) - (and erc-ensure-target-buffer-on-privmsg - (or erc-receive-query-display - erc-join-buffer))))) + (when-let* ((erc-join-buffer + (or (and (not erc-receive-query-display-defer) + erc-receive-query-display) + (and erc-ensure-target-buffer-on-privmsg + (or erc-receive-query-display + erc-join-buffer))))) (push `(erc-receive-query-display . ,(intern cmd)) erc--display-context) (setq buffer (erc--open-target nick))) @@ -2262,12 +2262,12 @@ primitive value." (if-let* ((table (or erc--isupport-params (erc-with-server-buffer erc--isupport-params))) (value (with-memoization (gethash key table) - (when-let ((v (assoc (symbol-name key) - (or erc-server-parameters - (erc-with-server-buffer + (when-let* ((v (assoc (symbol-name key) + (or erc-server-parameters + (erc-with-server-buffer erc-server-parameters))))) - (if-let ((val (cdr v)) - ((not (string-empty-p val)))) + (if-let* ((val (cdr v)) + ((not (string-empty-p val)))) (erc--parse-isupport-value val) '--empty--))))) (pcase value diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index c158b443b89..b4a94321947 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -462,18 +462,18 @@ retrieve it during buttonizing via (defun erc-button-add-nickname-buttons (entry) "Search through the buffer for nicknames, and add buttons." - (when-let ((form (nth 2 entry)) - ;; Spoof `form' slot of default legacy `nicknames' entry - ;; so `erc-button--extract-form' sees a function value. - (form (let ((erc-button-buttonize-nicks - (and erc-button-buttonize-nicks - erc-button--modify-nick-function))) - (erc-button--extract-form form))) - (oncep (if-let ((erc-button-highlight-nick-once) - (c (erc--check-msg-prop 'erc--cmd)) - ((memq c erc-button-highlight-nick-once))) - 1 0)) - (seen 0)) + (when-let* ((form (nth 2 entry)) + ;; Spoof `form' slot of default legacy `nicknames' entry + ;; so `erc-button--extract-form' sees a function value. + (form (let ((erc-button-buttonize-nicks + (and erc-button-buttonize-nicks + erc-button--modify-nick-function))) + (erc-button--extract-form form))) + (oncep (if-let* ((erc-button-highlight-nick-once) + (c (erc--check-msg-prop 'erc--cmd)) + ((memq c erc-button-highlight-nick-once))) + 1 0)) + (seen 0)) (goto-char (point-min)) (while-let (((or (zerop seen) (zerop oncep))) @@ -665,14 +665,14 @@ greater than `point-min' with a text property of `erc-callback'.") (p start)) (while (progn ;; Break out of current search context. - (when-let ((low (max (point-min) (1- (pos-bol)))) - (high (min (point-max) (1+ (pos-eol)))) - (prop (get-text-property p 'erc-callback)) - (q (if nextp - (text-property-not-all p high - 'erc-callback prop) - (funcall search-fn p 'erc-callback nil low))) - ((< low q high))) + (when-let* ((low (max (point-min) (1- (pos-bol)))) + (high (min (point-max) (1+ (pos-eol)))) + (prop (get-text-property p 'erc-callback)) + (q (if nextp + (text-property-not-all p high + 'erc-callback prop) + (funcall search-fn p 'erc-callback nil low))) + ((< low q high))) (setq p q)) ;; Assume that buttons occur frequently enough that ;; omitting LIMIT is acceptable. diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 057e7981515..9bb3f650b9b 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -267,9 +267,9 @@ instead of a `set' state, which precludes any actual saving." (rassq known custom-current-group-alist))) (throw 'found known)) (when (setq known (intern-soft (concat "erc-" downed "-mode"))) - (when-let ((found (custom-group-of-mode known))) + (when-let* ((found (custom-group-of-mode known))) (throw 'found found)))) - (when-let ((found (get (erc--normalize-module-symbol s) 'erc-group))) + (when-let* ((found (get (erc--normalize-module-symbol s) 'erc-group))) (throw 'found found))) 'erc)) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 1e81adbf6ba..13f1dbf266c 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -172,8 +172,8 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'." (save-restriction (narrow-to-region (point) (point-max)) (funcall (or erc-fill--function erc-fill-function)) - (when-let ((erc-fill-line-spacing) - (p (point-min))) + (when-let* ((erc-fill-line-spacing) + (p (point-min))) (widen) (when (or (erc--check-msg-prop 'erc--spkr) (save-excursion @@ -186,9 +186,9 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'." "Fills a text such that messages start at column `erc-fill-static-center'." (save-restriction (goto-char (point-min)) - (when-let (((looking-at "^\\(\\S-+\\)")) - ((not (erc--check-msg-prop 'erc--msg 'datestamp))) - (nick (match-string 1))) + (when-let* (((looking-at "^\\(\\S-+\\)")) + ((not (erc--check-msg-prop 'erc--msg 'datestamp))) + (nick (match-string 1))) (progn (let ((fill-column (- erc-fill-column (erc-timestamp-offset))) (fill-prefix (make-string erc-fill-static-center 32))) @@ -322,13 +322,13 @@ command." "Move to start of message text when left of speaker. Basically mimic what `move-beginning-of-line' does with invisible text. Stay put if OLD-POINT lies within hidden region." - (when-let ((erc-fill-wrap-merge) - (prop (get-text-property (point) 'erc-fill--wrap-merge)) - ((or (member prop '("" t)) - (eq 'margin (car-safe (car-safe prop))))) - (end (text-property-not-all (point) (pos-eol) - 'erc-fill--wrap-merge prop)) - ((or (null old-point) (>= old-point end)))) + (when-let* ((erc-fill-wrap-merge) + (prop (get-text-property (point) 'erc-fill--wrap-merge)) + ((or (member prop '("" t)) + (eq 'margin (car-safe (car-safe prop))))) + (end (text-property-not-all (point) (pos-eol) + 'erc-fill--wrap-merge prop)) + ((or (null old-point) (>= old-point end)))) (goto-char end))) (defun erc-fill--wrap-beginning-of-line (arg) @@ -672,10 +672,10 @@ Also cover region with text prop `erc-fill--wrap-merge' set to t." (let ((next-beg (point-max))) (save-restriction (widen) - (when-let (((get-text-property next-beg 'erc-fill--wrap-merge)) - (end (erc--get-inserted-msg-bounds next-beg)) - (beg (pop end)) - (erc-fill--wrap-continued-predicate #'ignore)) + (when-let* (((get-text-property next-beg 'erc-fill--wrap-merge)) + (end (erc--get-inserted-msg-bounds next-beg)) + (beg (pop end)) + (erc-fill--wrap-continued-predicate #'ignore)) (erc-fill--wrap-rejigger-region (1- beg) (1+ end) nil 'repairp)))))) (defun erc-fill--wrap-massage-initial-message-post-clear (beg end) @@ -684,14 +684,14 @@ Also cover region with text prop `erc-fill--wrap-merge' set to t." (erc-stamp--redo-right-stamp-post-clear beg end) ;; With other non-date stamp-insertion functions, remove hidden ;; speaker continuation on first spoken message in buffer. - (when-let (((< end (1- erc-insert-marker))) - (next (text-property-not-all end (min erc-insert-marker - (+ 4096 end)) - 'erc--msg nil)) - (bounds (erc--get-inserted-msg-bounds next)) - (found (text-property-not-all (car bounds) (cdr bounds) - 'erc-fill--wrap-merge nil)) - (erc-fill--wrap-continued-predicate #'ignore)) + (when-let* (((< end (1- erc-insert-marker))) + (next (text-property-not-all end (min erc-insert-marker + (+ 4096 end)) + 'erc--msg nil)) + (bounds (erc--get-inserted-msg-bounds next)) + (found (text-property-not-all (car bounds) (cdr bounds) + 'erc-fill--wrap-merge nil)) + (erc-fill--wrap-continued-predicate #'ignore)) (erc-fill--wrap-rejigger-region (max (1- (car bounds)) (point-min)) (min (1+ (cdr bounds)) erc-insert-marker) nil 'repairp)))) @@ -707,11 +707,11 @@ See `erc-fill-wrap-mode' for details." (funcall erc-fill--wrap-length-function)) (and-let* ((msg-prop (erc--check-msg-prop 'erc--msg)) ((not (eq msg-prop 'unknown)))) - (when-let ((e (erc--get-speaker-bounds)) - (b (pop e)) - ((or erc-fill--wrap-action-dedent-p - (not (erc--check-msg-prop 'erc--ctcp - 'ACTION))))) + (when-let* ((e (erc--get-speaker-bounds)) + (b (pop e)) + ((or erc-fill--wrap-action-dedent-p + (not (erc--check-msg-prop 'erc--ctcp + 'ACTION))))) (goto-char e)) (skip-syntax-forward "^-") (forward-char) @@ -776,18 +776,18 @@ With REPAIRP, destructively fill gaps and re-merge speakers." (end (text-property-not-all beg finish 'line-prefix val))) ;; If this is a left-side stamp on its own line. (remove-text-properties beg (1+ end) '(line-prefix nil wrap-prefix nil)) - (when-let ((repairp) - (dbeg (text-property-not-all beg end - 'erc-fill--wrap-merge nil)) - ((get-text-property (1+ dbeg) 'erc--speaker)) - (dval (get-text-property dbeg 'erc-fill--wrap-merge))) + (when-let* ((repairp) + (dbeg (text-property-not-all beg end + 'erc-fill--wrap-merge nil)) + ((get-text-property (1+ dbeg) 'erc--speaker)) + (dval (get-text-property dbeg 'erc-fill--wrap-merge))) (remove-list-of-text-properties dbeg (text-property-not-all dbeg end 'erc-fill--wrap-merge dval) '(display erc-fill--wrap-merge))) ;; This "should" work w/o `front-sticky' and `rear-nonsticky'. - (let* ((pos (if-let (((eq 'erc-timestamp (field-at-pos beg))) - (b (field-beginning beg)) - ((eq 'datestamp (get-text-property b 'erc--msg)))) + (let* ((pos (if-let* (((eq 'erc-timestamp (field-at-pos beg))) + (b (field-beginning beg)) + ((eq 'datestamp (get-text-property b 'erc--msg)))) b beg)) (erc--msg-props (map-into (text-properties-at pos) 'hash-table)) @@ -802,8 +802,8 @@ With REPAIRP, destructively fill gaps and re-merge speakers." (funcall on-next)) ;; Skip to end of message upon encountering accidental gaps ;; introduced by third parties (or bugs). - (if-let (((/= ?\n (char-after end))) - (next (erc--get-inserted-msg-end beg))) + (if-let* (((/= ?\n (char-after end))) + (next (erc--get-inserted-msg-end beg))) (progn (cl-assert (= ?\n (char-after next))) (when repairp ; eol <= next diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 93d0dc6fd0e..5d1aab4910d 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -141,7 +141,7 @@ or send-related hooks. When recentering has not been performed, attempt to restore last `window-start', if known." (dolist (window (get-buffer-window-list nil nil 'visible)) (with-selected-window window - (when-let + (when-let* ((erc--scrolltobottom-window-info) (found (assq window erc--scrolltobottom-window-info)) ((not (erc--scrolltobottom-confirm (nth 2 found))))) @@ -350,19 +350,19 @@ Do so only when switching to a new buffer in the same window if the replaced buffer is no longer visible in another window and its `window-start' at the time of switching is strictly greater than the indicator's position." - (when-let ((erc-keep-place-indicator-follow) - (window (selected-window)) - ((not (eq window (active-minibuffer-window)))) - (old-buffer (window-old-buffer window)) - ((buffer-live-p old-buffer)) - ((not (eq old-buffer (current-buffer)))) - (ov (buffer-local-value 'erc--keep-place-indicator-overlay - old-buffer)) - ((not (get-buffer-window old-buffer 'visible))) - (prev (assq old-buffer (window-prev-buffers window))) - (old-start (nth 1 prev)) - (old-inmkr (buffer-local-value 'erc-insert-marker old-buffer)) - ((< (overlay-end ov) old-start old-inmkr))) + (when-let* ((erc-keep-place-indicator-follow) + (window (selected-window)) + ((not (eq window (active-minibuffer-window)))) + (old-buffer (window-old-buffer window)) + ((buffer-live-p old-buffer)) + ((not (eq old-buffer (current-buffer)))) + (ov (buffer-local-value 'erc--keep-place-indicator-overlay + old-buffer)) + ((not (get-buffer-window old-buffer 'visible))) + (prev (assq old-buffer (window-prev-buffers window))) + (old-start (nth 1 prev)) + (old-inmkr (buffer-local-value 'erc-insert-marker old-buffer)) + ((< (overlay-end ov) old-start old-inmkr))) (with-current-buffer old-buffer (erc-keep-place-move old-start)))) @@ -392,15 +392,15 @@ and `keep-place-indicator' in different buffers." (progn (erc--restore-initialize-priors erc-keep-place-indicator-mode erc--keep-place-indicator-overlay (make-overlay 0 0)) - (when-let (((memq erc-keep-place-indicator-style '(t arrow))) - (ov-property (if (zerop (fringe-columns 'left)) - 'after-string - 'before-string)) - (display (if (zerop (fringe-columns 'left)) - `((margin left-margin) ,overlay-arrow-string) - '(left-fringe right-triangle - erc-keep-place-indicator-arrow))) - (bef (propertize " " 'display display))) + (when-let* (((memq erc-keep-place-indicator-style '(t arrow))) + (ov-property (if (zerop (fringe-columns 'left)) + 'after-string + 'before-string)) + (display (if (zerop (fringe-columns 'left)) + `((margin left-margin) ,overlay-arrow-string) + '(left-fringe right-triangle + erc-keep-place-indicator-arrow))) + (bef (propertize " " 'display display))) (overlay-put erc--keep-place-indicator-overlay ov-property bef)) (when (memq erc-keep-place-indicator-style '(t face)) (overlay-put erc--keep-place-indicator-overlay 'face @@ -440,11 +440,11 @@ Do this by simulating `keep-place' in all buffers where (defun erc--keep-place-indicator-adjust-on-clear (beg end) "Either shrink region bounded by BEG to END to preserve overlay, or reset." - (when-let ((pos (overlay-start erc--keep-place-indicator-overlay)) - ((<= beg pos end))) + (when-let* ((pos (overlay-start erc--keep-place-indicator-overlay)) + ((<= beg pos end))) (if (and erc-keep-place-indicator-truncation (not erc--called-as-input-p)) - (when-let ((pos (erc--get-inserted-msg-beg pos))) + (when-let* ((pos (erc--get-inserted-msg-beg pos))) (set-marker end pos)) (let (erc--keep-place-move-hook) ;; Move earlier than `beg', which may delimit date stamps, etc. @@ -473,7 +473,7 @@ window's first line. Interpret an integer as an offset in lines." (let ((inhibit-field-text-motion t)) (when pos (goto-char pos)) - (when-let ((pos (erc--get-inserted-msg-beg))) + (when-let* ((pos (erc--get-inserted-msg-beg))) (goto-char pos)) (run-hooks 'erc--keep-place-move-hook) (move-overlay erc--keep-place-indicator-overlay @@ -638,8 +638,8 @@ Do nothing if the variable `erc-command-indicator' is nil." (map-into `((erc--msg . slash-cmd) ,@(reverse ovs)) 'hash-table))))) - (when-let ((string (erc-command-indicator)) - (erc-input-marker (copy-marker erc-input-marker))) + (when-let* ((string (erc-command-indicator)) + (erc-input-marker (copy-marker erc-input-marker))) (erc-display-prompt nil nil string 'erc-command-indicator-face) (remove-text-properties insert-position (point) '(field nil erc-prompt nil)) diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el index 6e8a196255b..2874e2a4a00 100644 --- a/lisp/erc/erc-ibuffer.el +++ b/lisp/erc/erc-ibuffer.el @@ -121,10 +121,10 @@ (define-ibuffer-column erc-members (:name "Users") - (if-let ((table (or erc-channel-users erc-server-users)) - ((hash-table-p table)) - (count (hash-table-count table)) - ((> count 0))) + (if-let* ((table (or erc-channel-users erc-server-users)) + ((hash-table-p table)) + (count (hash-table-count table)) + ((> count 0))) (number-to-string count) "")) diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index cb57d8a00a1..9d08121fee6 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -157,8 +157,8 @@ network or a network ID). Return nil on failure." ;; encountering errors, like a 475 ERR_BADCHANNELKEY. (defun erc-join--remove-requested-channel (_ parsed) "Remove channel from `erc-join--requested-channels'." - (when-let ((channel (cadr (erc-response.command-args parsed))) - ((member channel erc-join--requested-channels))) + (when-let* ((channel (cadr (erc-response.command-args parsed))) + ((member channel erc-join--requested-channels))) (setq erc-join--requested-channels (delete channel erc-join--requested-channels))) nil) @@ -175,7 +175,7 @@ network or a network ID). Return nil on failure." (defun erc-autojoin--join () ;; This is called in the server buffer (pcase-dolist (`(,name . ,channels) erc-autojoin-channels-alist) - (when-let ((match (erc-autojoin-server-match name))) + (when-let* ((match (erc-autojoin-server-match name))) (dolist (chan channels) (let ((buf (erc-get-buffer chan erc-server-process))) (unless (and buf (with-current-buffer buf diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index a5ca05b137a..75de68a284c 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -904,8 +904,8 @@ aside) that aren't also `eq'.") (defun erc-networks--id-qualifying-init-parts () "Return opaque list of atoms to serve as canonical identifier." - (when-let ((network (erc-network)) - (nick (erc-current-nick))) + (when-let* ((network (erc-network)) + (nick (erc-current-nick))) (vector network (erc-downcase nick)))) (defvar erc-networks--id-sep "/" @@ -986,7 +986,7 @@ object." (erc-networks--rename-server-buffer (or proc erc-server-process) parsed) (erc-networks--shrink-ids-and-buffer-names-any) (erc-with-all-buffers-of-server erc-server-process #'erc-target - (when-let + (when-let* ((new-name (erc-networks--reconcile-buffer-names erc--target nid)) ((not (equal (buffer-name) new-name)))) (rename-buffer new-name 'unique)))) @@ -1002,7 +1002,7 @@ object." ((nid erc-networks--id-qualifying) (other erc-networks--id-qualifying)) "Grow NID along with that of the current buffer. Rename the current buffer if its NID has grown." - (when-let ((n (erc-networks--id-qualifying-prefix-length other nid))) + (when-let* ((n (erc-networks--id-qualifying-prefix-length other nid))) (while (and (<= (erc-networks--id-qualifying-len nid) n) (erc-networks--id-qualifying-grow-id nid))) ;; Grow and rename a visited buffer and all its targets @@ -1387,9 +1387,9 @@ Expect ANNOUNCED to be the server's reported host name." (string= erc-server-announced-name announced))) ;; If a target buffer exists for the current process, kill this ;; stale one after transplanting its content; else reinstate. - (if-let ((actual (erc-get-buffer (erc--target-string erc--target) - new-proc)) - (erc-networks--target-transplant-in-progress-p t)) + (if-let* ((actual (erc-get-buffer (erc--target-string erc--target) + new-proc)) + (erc-networks--target-transplant-in-progress-p t)) (progn (funcall erc-networks--transplant-target-buffer-function (current-buffer) actual) @@ -1593,7 +1593,7 @@ return the host alone sans URL formatting (for compatibility)." erc-server-alist))))) (s-choose (lambda (entry) (and (equal (nth 1 entry) net) - (if-let ((b (string-search ": " (car entry)))) + (if-let* ((b (string-search ": " (car entry)))) (cons (format "%s (%s)" (nth 2 entry) (substring (car entry) (+ b 2))) (cdr entry)) diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el index 6282242f4ac..e2cbe613d99 100644 --- a/lisp/erc/erc-nicks.el +++ b/lisp/erc/erc-nicks.el @@ -309,10 +309,10 @@ lower it to the upper bound of `erc-nicks-contrast-range'." "Invert COLOR based on the CAR of `erc-nicks-contrast-range'. Don't bother if the inverted color has less contrast than the input." - (if-let ((con-input (erc-nicks--get-contrast color)) - ((< con-input (car erc-nicks-contrast-range))) - (flipped (mapcar (lambda (c) (- 1.0 c)) color)) - ((> (erc-nicks--get-contrast flipped) con-input))) + (if-let* ((con-input (erc-nicks--get-contrast color)) + ((< con-input (car erc-nicks-contrast-range))) + (flipped (mapcar (lambda (c) (- 1.0 c)) color)) + ((> (erc-nicks--get-contrast flipped) con-input))) flipped color)) @@ -365,8 +365,8 @@ input." (defun erc-nicks--redirect-face-widget-link (args) (pcase args (`(,widget face-link . ,plist) - (when-let ((face (widget-value widget)) - ((get face 'erc-nicks--custom-face))) + (when-let* ((face (widget-value widget)) + ((get face 'erc-nicks--custom-face))) (unless (symbol-file face) (setf (plist-get plist :action) (lambda (&rest _) (erc-nicks--create-defface-template face)))) @@ -518,17 +518,17 @@ Abandon search after examining LIMIT faces." (defun erc-nicks--highlight (nickname &optional base-face) "Return face for NICKNAME unless it or BASE-FACE is blacklisted." - (when-let ((trimmed (erc-nicks--trim nickname)) - ((not (member trimmed erc-nicks--downcased-skip-nicks))) - ((not (and base-face - (erc-nicks--skip-p base-face erc-nicks-skip-faces - erc-nicks--max-skip-search)))) - (key (erc-nicks--gen-key-from-format-spec trimmed))) + (when-let* ((trimmed (erc-nicks--trim nickname)) + ((not (member trimmed erc-nicks--downcased-skip-nicks))) + ((not (and base-face + (erc-nicks--skip-p base-face erc-nicks-skip-faces + erc-nicks--max-skip-search)))) + (key (erc-nicks--gen-key-from-format-spec trimmed))) (erc-nicks--get-face trimmed key))) (defun erc-nicks--highlight-button (nick-object) "Possibly add face to `erc-button--nick-user' NICK-OBJECT." - (when-let + (when-let* ((nick-object) (face (get-text-property (car (erc-button--nick-bounds nick-object)) 'font-lock-face)) @@ -628,13 +628,13 @@ Abandon search after examining LIMIT faces." (customize-face new-face))) (defun erc-nicks--list-faces-help-button-action (face) - (when-let (((or (get face 'erc-nicks--custom-face) - (y-or-n-p (format "Create new persistent face for %s?" - (get face 'erc-nicks--key))))) - (nid (get face 'erc-nicks--netid)) - (foundp (lambda () - (erc-networks--id-equal-p nid erc-networks--id))) - (server-buffer (car (erc-buffer-filter foundp)))) + (when-let* (((or (get face 'erc-nicks--custom-face) + (y-or-n-p (format "Create new persistent face for %s?" + (get face 'erc-nicks--key))))) + (nid (get face 'erc-nicks--netid)) + (foundp (lambda () + (erc-networks--id-equal-p nid erc-networks--id))) + (server-buffer (car (erc-buffer-filter foundp)))) (with-current-buffer server-buffer (erc-nicks-customize-face (get face 'erc-nicks--nick))))) @@ -653,13 +653,13 @@ Abandon search after examining LIMIT faces." (facep (car (button-get (point) 'help-args)))) (button-put (point) 'help-function #'erc-nicks--list-faces-help-button-action) - (if-let ((face (car (button-get (point) 'help-args))) - ((not (get face 'erc-nicks--custom-face))) - ((not (get face 'erc-nicks--key)))) + (if-let* ((face (car (button-get (point) 'help-args))) + ((not (get face 'erc-nicks--custom-face))) + ((not (get face 'erc-nicks--key)))) (progn (delete-region (pos-bol) (1+ (pos-eol))) (forward-line -1)) - (when-let ((nid (get face 'erc-nicks--netid)) - (net (symbol-name (erc-networks--id-symbol nid)))) + (when-let* ((nid (get face 'erc-nicks--netid)) + (net (symbol-name (erc-networks--id-symbol nid)))) (goto-char (button-end (point))) (skip-syntax-forward "-") (put-text-property (point) (1+ (point)) 'rear-nonsticky nil) @@ -690,8 +690,8 @@ ones." (user-error "Pool empty: all colors rejected")) (dolist (nick (hash-table-keys erc-nicks--face-table)) ;; User-tuned faces do not have an `erc-nicks--key' property. - (when-let ((face (gethash nick erc-nicks--face-table)) - (key (get face 'erc-nicks--key))) + (when-let* ((face (gethash nick erc-nicks--face-table)) + (key (get face 'erc-nicks--key))) (setq key (erc-nicks--gen-key-from-format-spec nick)) (put face 'erc-nicks--key key) (set-face-foreground face (erc-nicks--determine-color key)))) @@ -719,8 +719,8 @@ ones." Expect PREFIX to be something like \"ansi-color-\" or \"font-lock-\"." (let (out) (dolist (face (face-list) (nreverse out)) - (when-let (((string-prefix-p prefix (symbol-name face))) - (color (face-foreground face))) + (when-let* (((string-prefix-p prefix (symbol-name face))) + (color (face-foreground face))) (push color out))))) (defun erc-nicks--reject-uninterned-faces (candidate) @@ -762,13 +762,13 @@ NORMALS. Expect a non-nil CONTENDER to always be ranked." (defun erc-nicks--track-prioritize (current contender contenders ranks normals) "Return a viable non-CURRENT `nicks' face among CONTENDERS. See `erc-track--select-mode-line-face' for parameter types." - (when-let + (when-let* ((spkr (erc-nicks--assess-track-faces current contender ranks normals))) (catch 'contender (dolist (candidate (cdr contenders)) - (when-let (((not (equal candidate current))) - (s (erc-nicks--ours-p candidate)) - ((not (eq s spkr)))) + (when-let* (((not (equal candidate current))) + (s (erc-nicks--ours-p candidate)) + ((not (eq s spkr)))) (throw 'contender candidate)))))) (defun erc-nicks--track-always (current contender contenders ranks normals) @@ -798,9 +798,9 @@ See `erc-track--select-mode-line-face' for parameter types." (defun erc-nicks--remember-face-for-track (face) "Add FACE to local hash table maintained by `track' module." (or (gethash face erc-track--normal-faces) - (if-let ((sym (or (car-safe face) face)) - ((symbolp sym)) - ((get sym 'erc-nicks--key))) + (if-let* ((sym (or (car-safe face) face)) + ((symbolp sym)) + ((get sym 'erc-nicks--key))) (puthash face face erc-track--normal-faces) face))) diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el index a32c8b46118..7e78120f799 100644 --- a/lisp/erc/erc-notify.el +++ b/lisp/erc/erc-notify.el @@ -324,10 +324,10 @@ target buffer." ((when erc--querypoll-timer (cancel-timer erc--querypoll-timer)) (if erc--target - (when-let (((erc-query-buffer-p)) - (ring (erc-with-server-buffer erc--querypoll-ring)) - (index (ring-member ring (current-buffer))) - ((not (erc--querypoll-target-in-chan-p (current-buffer))))) + (when-let* (((erc-query-buffer-p)) + (ring (erc-with-server-buffer erc--querypoll-ring)) + (index (ring-member ring (current-buffer))) + ((not (erc--querypoll-target-in-chan-p (current-buffer))))) (ring-remove ring index) (unless (erc-current-nick-p (erc-target)) (erc-remove-current-channel-member (erc-target)))) @@ -376,8 +376,8 @@ between updates regardless of queue length.") (let ((n (ring-length ring))) (catch 'found (while (natnump (cl-decf n)) - (when-let ((buffer (ring-remove ring)) - ((buffer-live-p buffer))) + (when-let* ((buffer (ring-remove ring)) + ((buffer-live-p buffer))) ;; Push back buffers for users joined to some chan. (if (erc--querypoll-target-in-chan-p buffer) (ring-insert ring buffer) @@ -408,7 +408,7 @@ Then add user to participant rolls in any existing query buffers." (pcase-let ((`(,_ ,channel ,login ,host ,_server ,nick ,_flags, hop-real) args)) (when (and (string= channel "*") (erc-nick-equal-p nick target-nick)) - (if-let ((user (erc-get-server-user nick))) + (if-let* ((user (erc-get-server-user nick))) (erc-update-user user nick host login (erc--extract-352-full-name hop-real)) ;; Don't add unless target is already known. @@ -428,7 +428,7 @@ Then add user to participant rolls in any existing query buffers." (buffer-local-value 'erc-server-connected server-buffer)) (with-current-buffer server-buffer (setq erc--querypoll-timer nil) - (if-let ((buffer (erc--querypoll-get-next erc--querypoll-ring))) + (if-let* ((buffer (erc--querypoll-get-next erc--querypoll-ring))) (letrec ((target (erc--target-string (buffer-local-value 'erc--target buffer))) diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el index 1998e4f129b..65dba95d5c3 100644 --- a/lisp/erc/erc-sasl.el +++ b/lisp/erc/erc-sasl.el @@ -148,17 +148,17 @@ PLIST to contain keyword params known to `auth-source-search'." (defun erc-sasl--read-password (prompt) "Return configured option or server password. If necessary, pass PROMPT to `read-passwd'." - (if-let ((found (pcase (alist-get 'password erc-sasl--options) - ((guard (alist-get 'authfn erc-sasl--options)) - (let-alist erc-sasl--options - (let ((erc-sasl-user .user) - (erc-sasl-password .password) - (erc-sasl-mechanism .mechanism) - (erc-sasl-authzid .authzid) - (erc-sasl-auth-source-function .authfn)) - (funcall .authfn :user (erc-sasl--get-user))))) - (:password erc-session-password) - ((and (pred stringp) v) (unless (string-empty-p v) v))))) + (if-let* ((found (pcase (alist-get 'password erc-sasl--options) + ((guard (alist-get 'authfn erc-sasl--options)) + (let-alist erc-sasl--options + (let ((erc-sasl-user .user) + (erc-sasl-password .password) + (erc-sasl-mechanism .mechanism) + (erc-sasl-authzid .authzid) + (erc-sasl-auth-source-function .authfn)) + (funcall .authfn :user (erc-sasl--get-user))))) + (:password erc-session-password) + ((and (pred stringp) v) (unless (string-empty-p v) v))))) (copy-sequence (erc--unfun found)) (read-passwd prompt))) diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el index 0881006ed77..6ea5e03881c 100644 --- a/lisp/erc/erc-services.el +++ b/lisp/erc/erc-services.el @@ -578,13 +578,13 @@ as needed." (letrec ((attempts 3) (on-notice (lambda (_proc parsed) - (when-let ((nick (erc-extract-nick - (erc-response.sender parsed))) - ((erc-nick-equal-p nick "nickserv")) - (contents (erc-response.contents parsed)) - (case-fold-search t) - ((string-match (rx (or "ghost" "is not online")) - contents))) + (when-let* ((nick (erc-extract-nick + (erc-response.sender parsed))) + ((erc-nick-equal-p nick "nickserv")) + (contents (erc-response.contents parsed)) + (case-fold-search t) + ((string-match (rx (or "ghost" "is not online")) + contents))) (setq attempts 1) (erc-server-send (concat "NICK " want) 'force)) (when (zerop (cl-decf attempts)) diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index e8c41a1f239..ed27881abdc 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -512,13 +512,13 @@ associated with an ERC session." ". Setting to t for the current Emacs session." " Customize it permanently to avoid this message.") (setq speedbar-update-flag t)) - (when-let (((null speedbar-buffer)) - (speedbar-frame-parameters (backquote-list* - '(visibility . nil) - '(no-other-frame . t) - speedbar-frame-parameters)) - (speedbar-after-create-hook #'erc-speedbar--emulate-sidebar) - (original-frame (selected-frame))) + (when-let* (((null speedbar-buffer)) + (speedbar-frame-parameters (backquote-list* + '(visibility . nil) + '(no-other-frame . t) + speedbar-frame-parameters)) + (speedbar-after-create-hook #'erc-speedbar--emulate-sidebar) + (original-frame (selected-frame))) (erc-install-speedbar-variables) ;; Run before toggling mode to prevent timer from being ;; created twice. @@ -591,8 +591,8 @@ For controlling whether the speedbar window is selectable with (and speedbar-buffer (eq speedbar-frame (window-frame (get-buffer-window speedbar-buffer t))))) - (when-let ((buf (or (and (derived-mode-p 'erc-mode) (current-buffer)) - (car (erc-buffer-filter #'erc--server-buffer-p))))) + (when-let* ((buf (or (and (derived-mode-p 'erc-mode) (current-buffer)) + (car (erc-buffer-filter #'erc--server-buffer-p))))) (with-current-buffer buf (erc-speedbar--ensure 'forcep))))) ((remove-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure) @@ -649,7 +649,7 @@ unlock the window." (interactive "P") (unless erc-nickbar-mode (user-error "`erc-nickbar-mode' inactive")) - (when-let ((window (get-buffer-window speedbar-buffer))) + (when-let* ((window (get-buffer-window speedbar-buffer))) (let ((val (cond ((natnump arg) t) ((integerp arg) nil) (t (not (erc-compat--window-no-other-p window)))))) @@ -669,10 +669,10 @@ unlock the window." (defun erc-speedbar--compose-nicks-face (orig buffer user cuser) (require 'erc-nicks) (let ((rv (funcall orig buffer user cuser))) - (if-let ((nick (erc-server-user-nickname user)) - (face (with-current-buffer buffer - (erc-nicks--highlight nick rv))) - ((not (eq face erc-button-nickname-face)))) + (if-let* ((nick (erc-server-user-nickname user)) + (face (with-current-buffer buffer + (erc-nicks--highlight nick rv))) + ((not (eq face erc-button-nickname-face)))) (cons face (ensure-list rv)) rv))) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index b0ecd67eef7..24bb510fd70 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -197,13 +197,13 @@ from entering them and instead jump over them." (defun erc-stamp--recover-on-reconnect () "Attempt to restore \"last-inserted\" snapshots from prior session." - (when-let ((priors (or erc--server-reconnecting erc--target-priors))) + (when-let* ((priors (or erc--server-reconnecting erc--target-priors))) (dolist (var '(erc-timestamp-last-inserted erc-timestamp-last-inserted-left erc-timestamp-last-inserted-right erc-stamp--deferred-date-stamp erc-stamp--date-stamps)) - (when-let (existing (alist-get var priors)) + (when-let* ((existing (alist-get var priors))) (set var existing))))) (defvar erc-stamp--current-time nil @@ -396,14 +396,14 @@ non-nil." (goto-char (point-min)) (while (progn - (when-let (((< (point) (pos-eol))) - (end (1- (pos-eol))) - ((eq 'erc-timestamp (field-at-pos end))) - (beg (field-beginning end)) - ;; Skip a line that's just a timestamp. - ((> beg (point)))) + (when-let* (((< (point) (pos-eol))) + (end (1- (pos-eol))) + ((eq 'erc-timestamp (field-at-pos end))) + (beg (field-beginning end)) + ;; Skip a line that's just a timestamp. + ((> beg (point)))) (delete-region beg (1+ end))) - (when-let (time (erc--get-inserted-msg-prop 'erc--ts)) + (when-let* ((time (erc--get-inserted-msg-prop 'erc--ts))) (insert (format-time-string "[%H:%M:%S] " time))) (zerop (forward-line)))) "") @@ -505,10 +505,10 @@ and `erc-stamp--margin-left-p', before activating the mode." (&context (erc-stamp--display-margin-mode (eql t)) (erc-stamp--margin-left-p (eql t)) (erc-stamp--skip-left-margin-prompt-p null)) - (when-let (((null erc--hidden-prompt-overlay)) - (prompt (string-pad erc-prompt-hidden left-margin-width nil 'start)) - (ov (make-overlay erc-insert-marker (1- erc-input-marker) - nil 'front-advance))) + (when-let* (((null erc--hidden-prompt-overlay)) + (prompt (string-pad erc-prompt-hidden left-margin-width nil 'start)) + (ov (make-overlay erc-insert-marker (1- erc-input-marker) + nil 'front-advance))) (overlay-put ov 'display `((margin left-margin) ,prompt)) (setq erc--hidden-prompt-overlay ov))) @@ -534,7 +534,7 @@ and `erc-stamp--margin-left-p', before activating the mode." (goto-char (point-min)) (insert-and-inherit (setq erc-timestamp-last-inserted string)) (dolist (p erc-stamp--inherited-props) - (when-let ((v (get-text-property (point) p))) + (when-let* ((v (get-text-property (point) p))) (put-text-property (point-min) (point) p v))) (erc-put-text-property (point-min) (point) 'invisible erc-stamp--invisible-property) @@ -641,7 +641,7 @@ printed just after each line's text (no alignment)." (_ (indent-to pos))) (insert string) (dolist (p erc-stamp--inherited-props) - (when-let ((v (get-text-property (1- from) p))) + (when-let* ((v (get-text-property (1- from) p))) (put-text-property from (point) p v))) (erc-put-text-property from (point) 'field 'erc-timestamp) (erc-put-text-property from (point) 'rear-nonsticky t) @@ -724,13 +724,13 @@ inserted is a date stamp." "Schedule a date stamp to be inserted via HOOK-VAR. Do so when `erc-stamp--deferred-date-stamp' and its `fn' slot are non-nil." - (when-let ((data erc-stamp--deferred-date-stamp) - ((eq (erc-stamp--date-fn data) #'ignore)) - (ct (erc-stamp--date-ts data)) - (rendered (erc-stamp--date-str data)) - (buffer (current-buffer)) - (symbol (make-symbol "erc-stamp--insert-date")) - (marker (setf (erc-stamp--date-marker data) (point-min-marker)))) + (when-let* ((data erc-stamp--deferred-date-stamp) + ((eq (erc-stamp--date-fn data) #'ignore)) + (ct (erc-stamp--date-ts data)) + (rendered (erc-stamp--date-str data)) + (buffer (current-buffer)) + (symbol (make-symbol "erc-stamp--insert-date")) + (marker (setf (erc-stamp--date-marker data) (point-min-marker)))) (setf (erc-stamp--date-fn data) symbol) (fset symbol (lambda (&rest _) @@ -856,15 +856,15 @@ and date stamps inserted by this function." ;; "prepended" date stamps as well. However, since this is a ;; compatibility oriented code path, and pre-5.6 did no such ;; thing, better to punt. - (if-let ((erc-stamp-prepend-date-stamps-p) - (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) - ((not (string= ts-left erc-timestamp-last-inserted-left)))) + (if-let* ((erc-stamp-prepend-date-stamps-p) + (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) + ((not (string= ts-left erc-timestamp-last-inserted-left)))) (progn (goto-char (point-min)) (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left) (insert (setq erc-timestamp-last-inserted-left ts-left))) - (when-let + (when-let* (((null erc-stamp--deferred-date-stamp)) (rendered (erc-stamp--format-date-stamp ct)) ((not (string-equal rendered erc-timestamp-last-inserted-left))) @@ -1064,17 +1064,17 @@ with the option `erc-echo-timestamps', see the companion option ;; regardless of `erc-timestamp-only-if-changed-flag'. As of ERC 5.6, ;; recreating inserted messages from scratch isn't doable. (Although, ;; attempting surgery like this is likely unwise.) - (when-let ((erc-stamp--date-mode) - ((< end (1- erc-insert-marker))) ; not a /CLEAR - (bounds (erc--get-inserted-msg-bounds (1+ end))) - (ts (get-text-property (car bounds) 'erc--ts)) - (format (with-suppressed-warnings - ((obsolete erc-timestamp-format-right)) - (or erc-timestamp-format-right erc-timestamp-format))) - (rendered (erc-format-timestamp ts format)) - ((not (equal rendered erc-timestamp-last-inserted-right))) - ((not (eq 'erc-timestamp (field-at-pos (1- (cdr bounds)))))) - (erc--msg-props (map-into `((erc--ts . ,ts)) 'hash-table))) + (when-let* ((erc-stamp--date-mode) + ((< end (1- erc-insert-marker))) ; not a /CLEAR + (bounds (erc--get-inserted-msg-bounds (1+ end))) + (ts (get-text-property (car bounds) 'erc--ts)) + (format (with-suppressed-warnings + ((obsolete erc-timestamp-format-right)) + (or erc-timestamp-format-right erc-timestamp-format))) + (rendered (erc-format-timestamp ts format)) + ((not (equal rendered erc-timestamp-last-inserted-right))) + ((not (eq 'erc-timestamp (field-at-pos (1- (cdr bounds)))))) + (erc--msg-props (map-into `((erc--ts . ,ts)) 'hash-table))) (save-excursion (save-restriction (let ((erc-timestamp-last-inserted erc-timestamp-last-inserted) @@ -1106,12 +1106,12 @@ Call ORIG, an `erc--clear-function', with BEG and END markers." (when (and fullp culled (not skipp) (< 1 beg 3 end)) (set-marker beg 3)) (funcall orig beg end) - (when-let ((culled) - ((not skipp)) - (ct (erc-stamp--date-ts (car culled))) - (hook (make-symbol "temporary-hook")) - (rendered (erc-stamp--format-date-stamp ct)) - (data (make-erc-stamp--date :ts ct :str rendered))) + (when-let* ((culled) + ((not skipp)) + (ct (erc-stamp--date-ts (car culled))) + (hook (make-symbol "temporary-hook")) + (rendered (erc-stamp--format-date-stamp ct)) + (data (make-erc-stamp--date :ts ct :str rendered))) (cl-assert erc-stamp--date-mode) ;; Object successfully removed from model but snapshot remains. (cl-assert (null (cl-find rendered erc-stamp--date-stamps @@ -1144,9 +1144,9 @@ copy non-duplicate `erc-stamp--date' objects from OLD-STAMPS to the current buffer's, maintaining order." (let (need) (dolist (old old-stamps) - (if-let ((new (cl-find (erc-stamp--date-str old) erc-stamp--date-stamps - :test #'string= :key #'erc-stamp--date-str)) - (new-marker (erc-stamp--date-marker new))) + (if-let* ((new (cl-find (erc-stamp--date-str old) erc-stamp--date-stamps + :test #'string= :key #'erc-stamp--date-str)) + (new-marker (erc-stamp--date-marker new))) ;; The new buffer now has a duplicate stamp, so remove the ;; "newer" one from the buffer. (progn diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el index dcdef7cfafc..bf049242443 100644 --- a/lisp/erc/erc-status-sidebar.el +++ b/lisp/erc/erc-status-sidebar.el @@ -258,17 +258,17 @@ current frame only." (erc-track-mode +1)) (add-hook 'erc--setup-buffer-hook #'erc-status-sidebar--open) ;; Preserve side-window dimensions after `custom-buffer-done'. - (when-let (((not erc--updating-modules-p)) - (buf (or (and (derived-mode-p 'erc-mode) (current-buffer)) - (car (erc-buffer-filter - (lambda () erc-server-connected)))))) + (when-let* (((not erc--updating-modules-p)) + (buf (or (and (derived-mode-p 'erc-mode) (current-buffer)) + (car (erc-buffer-filter + (lambda () erc-server-connected)))))) (with-current-buffer buf (erc-status-sidebar--open)))) ((remove-hook 'erc--setup-buffer-hook #'erc-status-sidebar--open) (erc-status-sidebar-close 'all-frames) - (when-let ((arg erc--module-toggle-prefix-arg) - ((numberp arg)) - ((< arg 0))) + (when-let* ((arg erc--module-toggle-prefix-arg) + ((numberp arg)) + ((< arg 0))) (erc-status-sidebar-kill)))) ;;;###autoload @@ -308,7 +308,7 @@ even if one already exists in another frame." (defun erc-status-sidebar-prefer-target-as-name (buffer) "Return some name to represent buffer in the sidebar." - (if-let ((target (buffer-local-value 'erc--target buffer))) + (if-let* ((target (buffer-local-value 'erc--target buffer))) (cond ((and erc-status-sidebar--trimpat (erc--target-channel-p target)) (string-trim-left (erc--target-string target) erc-status-sidebar--trimpat)) @@ -340,8 +340,8 @@ even if one already exists in another frame." (let ((erc-status-sidebar--trimpat (and (eq erc-status-sidebar-style 'all-mixed) (with-current-buffer (process-buffer proc) - (when-let ((ch-pfxs (erc--get-isupport-entry - 'CHANTYPES 'single))) + (when-let* ((ch-pfxs (erc--get-isupport-entry + 'CHANTYPES 'single))) (regexp-quote ch-pfxs))))) (erc-status-sidebar--prechan (and (eq erc-status-sidebar-style @@ -484,7 +484,7 @@ name stand out." (cl-assert (eq major-mode 'erc-status-sidebar-mode)) (cl-assert (eq (selected-window) window)) (cl-assert (eq (window-buffer window) (current-buffer))) - (when-let ((buf (get-text-property pos 'erc-buf))) + (when-let* ((buf (get-text-property pos 'erc-buf))) ;; Option operates relative to last selected window (select-window (get-mru-window nil nil 'not-selected)) (pop-to-buffer buf erc-status-sidebar-click-display-action))))) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 82e5f402910..97fb7e726bd 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -409,12 +409,12 @@ For now, omit relevant options like `erc-track-shorten-start' and friends, even though they do affect the outcome, because they likely change too infrequently to matter over sub-second intervals and are unlikely to be let-bound or set locally." - (when-let ((hash (setq erc-track--shortened-names-current-hash - (sxhash-equal (list channel-names - (buffer-list) - erc-track-shorten-function)))) - (erc-track--shortened-names) - ((= hash (car erc-track--shortened-names)))) + (when-let* ((hash (setq erc-track--shortened-names-current-hash + (sxhash-equal (list channel-names + (buffer-list) + erc-track-shorten-function)))) + (erc-track--shortened-names) + ((= hash (car erc-track--shortened-names)))) (cdr erc-track--shortened-names))) (gv-define-simple-setter erc-track--shortened-names-get @@ -674,8 +674,8 @@ binding, set the cache variable's local value to that of server's." (when (local-variable-p opt) (erc-track--massage-nick-button-faces opt (symbol-value opt) #'set)) - (when-let ((migrations (get opt 'erc-track--obsolete-faces)) - ((consp migrations))) + (when-let* ((migrations (get opt 'erc-track--obsolete-faces)) + ((consp migrations))) (push (cons opt (mapcar (pcase-lambda (`(,old . ,new)) (format (if new "changed %s to %s" @@ -980,11 +980,11 @@ Failing that, choose the first face in both NEW-FACES and NORMALS." ;; Choose the highest ranked face in `erc-track-faces-priority-list' ;; that's either `cur-face' itself or one appearing in the region ;; being processed. - (when-let ((choice (catch 'face - (dolist (candidate (cdr ranks)) - (when (or (equal candidate cur-face) - (gethash candidate (car new-faces))) - (throw 'face candidate)))))) + (when-let* ((choice (catch 'face + (dolist (candidate (cdr ranks)) + (when (or (equal candidate cur-face) + (gethash candidate (car new-faces))) + (throw 'face candidate)))))) (or (and erc-track--alt-normals-function (funcall erc-track--alt-normals-function cur-face choice new-faces ranks normals)) @@ -1040,7 +1040,7 @@ the current buffer is in `erc-mode'." ;; (in the car), change its face attribute (in the cddr) if ;; necessary. See `erc-modified-channels-alist' for the ;; exact data structure used. - (when-let + (when-let* ((faces (if erc-track-ignore-normal-contenders-p (erc-faces-in (buffer-string)) (erc-track--collect-faces-in))) @@ -1128,7 +1128,7 @@ seen to least." (faces (make-hash-table :test #'equal)) (rfaces ())) (while p - (when-let ((cur (get-text-property p prop))) + (when-let* ((cur (get-text-property p prop))) (unless (gethash cur seen) (puthash cur t seen) (when erc-track--face-reject-function @@ -1214,8 +1214,8 @@ unless any passes.") (current-buffer)) (setq erc-track-last-non-erc-buffer (current-buffer))) ;; and jump to the next active channel - (if-let ((buf (erc-track-get-active-buffer arg)) - ((buffer-live-p buf))) + (if-let* ((buf (erc-track-get-active-buffer arg)) + ((buffer-live-p buf))) (funcall fun buf) (erc-modified-channels-update) (erc-track--switch-buffer fun arg))) @@ -1244,7 +1244,7 @@ reverse it." (erc-track--switch-buffer 'switch-to-buffer-other-window arg)) (defun erc-track--replace-killed-buffer (existing) - (when-let ((found (assq existing erc-modified-channels-alist))) + (when-let* ((found (assq existing erc-modified-channels-alist))) (setcar found (current-buffer)))) (provide 'erc-track) diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index fd152707708..b6666c76f33 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -82,8 +82,8 @@ for other purposes should customize either `erc-enable-logging' or "Enable or disable buffer-local `erc-truncate-mode' modifications." (if erc-truncate-mode (progn - (when-let ((priors (or erc--server-reconnecting erc--target-priors)) - (val (alist-get 'erc-truncate--buffer-size priors))) + (when-let* ((priors (or erc--server-reconnecting erc--target-priors)) + (val (alist-get 'erc-truncate--buffer-size priors))) (setq erc-truncate--buffer-size val)) (add-function :before (local 'erc--clear-function) #'erc-truncate--inhibit-when-local-and-interactive @@ -150,7 +150,7 @@ present in `erc-modules'." ;; `erc-truncate-buffer-to-size' normally runs in a different buffer. (save-excursion (if (and erc--parsed-response erc--msg-props) - (when-let + (when-let* (((not erc--inhibit-clear-p)) ((not (erc--memq-msg-prop 'erc--skip 'truncate))) ;; Determine here because this may be a target buffer and diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 426b29f8e80..18cc4071b48 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -567,9 +567,9 @@ restore the described historical behavior.") (defun erc--ensure-query-member (nick) "Populate membership table in query buffer for online NICK." (erc-with-buffer (nick) - (when-let (((not erc--decouple-query-and-channel-membership-p)) - ((zerop (hash-table-count erc-channel-users))) - (user (erc-get-server-user nick))) + (when-let* (((not erc--decouple-query-and-channel-membership-p)) + ((zerop (hash-table-count erc-channel-users))) + (user (erc-get-server-user nick))) (erc-update-current-channel-member nick nil t) (erc--unhide-prompt) t))) @@ -579,10 +579,10 @@ restore the described historical behavior.") Ensure targets with an entry in `erc-server-users' are present in `erc-channel-members'." (erc-with-all-buffers-of-server erc-server-process #'erc-query-buffer-p - (when-let (((not erc--decouple-query-and-channel-membership-p)) - ((zerop (hash-table-count erc-channel-users))) - (target (erc-target)) - ((erc-get-server-user target))) + (when-let* (((not erc--decouple-query-and-channel-membership-p)) + ((zerop (hash-table-count erc-channel-users))) + (target (erc-target)) + ((erc-get-server-user target))) (erc-update-current-channel-member target nil t) (erc--unhide-prompt)) erc-server-process)) @@ -666,15 +666,15 @@ Also remove members from the server table if this was their only buffer." (defun erc--remove-channel-users-but (nick) "Drain channel users and remove from server, sparing NICK." - (when-let ((users (erc-with-server-buffer erc-server-users)) - (my-user (gethash (erc-downcase nick) users)) - (original-function erc--forget-server-user-function) - (erc--forget-server-user-function - (if erc--decouple-query-and-channel-membership-p - erc--forget-server-user-function - (lambda (nick user) - (unless (eq user my-user) - (funcall original-function nick user)))))) + (when-let* ((users (erc-with-server-buffer erc-server-users)) + (my-user (gethash (erc-downcase nick) users)) + (original-function erc--forget-server-user-function) + (erc--forget-server-user-function + (if erc--decouple-query-and-channel-membership-p + erc--forget-server-user-function + (lambda (nick user) + (unless (eq user my-user) + (funcall original-function nick user)))))) (erc-remove-channel-users))) (defmacro erc--define-channel-user-status-compat-getter (name c d) @@ -716,9 +716,9 @@ inlining calls to these adapters." "Add or remove membership status associated with LETTER for NICK-OR-CUSR. With RESETP, clear the user's status info completely. If ENABLEP is non-nil, add the status value associated with LETTER." - (when-let ((cusr (or (and (erc-channel-user-p nick-or-cusr) nick-or-cusr) - (cdr (erc-get-channel-member nick-or-cusr)))) - (n (erc--get-prefix-flag letter))) + (when-let* ((cusr (or (and (erc-channel-user-p nick-or-cusr) nick-or-cusr) + (cdr (erc-get-channel-member nick-or-cusr)))) + (n (erc--get-prefix-flag letter))) (cl-callf (lambda (v) (if resetp (if enablep n 0) @@ -2395,12 +2395,12 @@ invocations by third-party packages.") (defun erc--find-mode (sym) (setq sym (erc--normalize-module-symbol sym)) - (if-let ((mode (intern-soft (concat "erc-" (symbol-name sym) "-mode"))) - ((and (fboundp mode) - (autoload-do-load (symbol-function mode) mode))) - ((or (get sym 'erc--module) - (symbol-file mode) - (ignore (cl-pushnew sym erc--aberrant-modules))))) + (if-let* ((mode (intern-soft (concat "erc-" (symbol-name sym) "-mode"))) + ((and (fboundp mode) + (autoload-do-load (symbol-function mode) mode))) + ((or (get sym 'erc--module) + (symbol-file mode) + (ignore (cl-pushnew sym erc--aberrant-modules))))) mode (and (or (and erc--requiring-module-mode-p ;; Also likely non-nil: (eq sym (car features)) @@ -2418,7 +2418,7 @@ invocations by third-party packages.") (defun erc--update-modules (modules) (let (local-modes) (dolist (module modules local-modes) - (if-let ((mode (erc--find-mode module))) + (if-let* ((mode (erc--find-mode module))) (if (custom-variable-p mode) (funcall mode 1) (push mode local-modes)) @@ -3063,8 +3063,8 @@ such inconsistent labeling may pose a problem until the MOTD is received. Setting a fixed `erc-networks--id' can serve as a workaround." (when erc-debug-irc-protocol - (let ((esid (if-let ((erc-networks--id) - (esid (erc-networks--id-symbol erc-networks--id))) + (let ((esid (if-let* ((erc-networks--id) + (esid (erc-networks--id-symbol erc-networks--id))) (symbol-name esid) (or erc-server-announced-name (format "%s:%s" erc-session-server erc-session-port)))) @@ -3297,10 +3297,10 @@ a full refresh." (insert s) (delete-region erc-insert-marker p)))) (run-hooks 'erc--refresh-prompt-hook) - (when-let (((> erc--refresh-prompt-continue-request 0)) - (n erc--refresh-prompt-continue-request) - (erc--refresh-prompt-continue-request -1) - (b (current-buffer))) + (when-let* (((> erc--refresh-prompt-continue-request 0)) + (n erc--refresh-prompt-continue-request) + (erc--refresh-prompt-continue-request -1) + (b (current-buffer))) (erc-with-all-buffers-of-server erc-server-process (lambda () (not (eq b (current-buffer)))) (if (= n 1) @@ -3677,10 +3677,10 @@ Callers should be aware that this function fails if the property `erc--important-props' has an empty value almost anywhere along the affected region. Use the function `erc--remove-from-prop-value-list' to ensure that props with empty values are excised completely." - (when-let ((registered (erc--check-msg-prop 'erc--important-prop-names)) - (present (seq-intersection props registered)) - (b (or beg (point-min))) - (e (or end (point-max)))) + (when-let* ((registered (erc--check-msg-prop 'erc--important-prop-names)) + (present (seq-intersection props registered)) + (b (or beg (point-min))) + (e (or end (point-max)))) (while-let (((setq b (text-property-not-all b e 'erc--important-props nil))) (val (get-text-property b 'erc--important-props)) @@ -3790,7 +3790,7 @@ reverse order so they end up sorted in buffer interval plists for retrieval by `text-properties-at' and friends." (let (out) (dolist (k erc--ranked-properties) - (when-let ((v (gethash k table))) + (when-let* ((v (gethash k table))) (remhash k table) (setq out (nconc (list k v) out)))) (maphash (lambda (k v) (setq out (nconc (list k v) out))) table) @@ -4132,8 +4132,8 @@ for other purposes.") (defun erc-send-input-line (target line &optional force) "Send LINE to TARGET." - (when-let ((target) - (cmem (erc-get-channel-member (erc-current-nick)))) + (when-let* ((target) + (cmem (erc-get-channel-member (erc-current-nick)))) (setf (erc-channel-user-last-message-time (cdr cmem)) (erc-compat--current-lisp-time))) (when (and (not erc--allow-empty-outgoing-lines-p) (string= line "\n")) @@ -4430,7 +4430,7 @@ of `erc-ignore-list'." (format "Now ignoring %s" user))) (erc-with-server-buffer (when timeout - (if-let ((existing (erc--find-ignore-timer user (current-buffer)))) + (if-let* ((existing (erc--find-ignore-timer user (current-buffer)))) (timer-set-time existing (timer-relative-time nil timeout)) (run-at-time timeout nil #'erc--unignore-user user (current-buffer)))) @@ -4442,11 +4442,11 @@ of `erc-ignore-list'." (erc-with-server-buffer (let ((seen (copy-sequence erc-ignore-list))) (dolist (timer timer-list) - (when-let ((args (erc--get-ignore-timer-args timer)) - ((eq (current-buffer) (nth 1 args))) - (user (car args)) - (delta (- (timer-until timer (current-time)))) - (duration (erc--format-time-period delta))) + (when-let* ((args (erc--get-ignore-timer-args timer)) + ((eq (current-buffer) (nth 1 args))) + (user (car args)) + (delta (- (timer-until timer (current-time)))) + (duration (erc--format-time-period delta))) (setq seen (delete user seen)) (erc-display-message nil 'notice 'active 'ignore-list ?p user ?s duration))) @@ -4477,7 +4477,7 @@ of `erc-ignore-list'." (erc-display-message nil 'notice 'active (format "No longer ignoring %s" user)) (setq erc-ignore-list (delete user erc-ignore-list)) - (when-let ((existing (erc--find-ignore-timer user buffer))) + (when-let* ((existing (erc--find-ignore-timer user buffer))) (cancel-timer existing))))) (defvar erc--clear-function #'delete-region @@ -5249,7 +5249,7 @@ Display the query buffer in accordance with `erc-interactive-display'." (erc--display-context `((erc-interactive-display . /QUERY) ,@erc--display-context))) (erc-with-server-buffer - (if-let ((buffer (erc-get-buffer user erc-server-process))) + (if-let* ((buffer (erc-get-buffer user erc-server-process))) (prog1 buffer (erc-setup-buffer buffer)) (prog1 (erc--open-target user) ; becomes current buffer @@ -5654,9 +5654,9 @@ When uninitialized or with option -f, resync `erc-channel-banlist'." (when (< maxw (+ rw lw)) ; scale down when capped (cl-psetq rw (/ (* rw maxw) (* 1.0 (+ rw lw))) lw (/ (* lw maxw) (* 1.0 (+ rw lw))))) - (when-let ((larger (max rw lw)) ; cap ratio at 3:1 - (wavg (* maxw 0.75)) - ((> larger wavg))) + (when-let* ((larger (max rw lw)) ; cap ratio at 3:1 + (wavg (* maxw 0.75)) + ((> larger wavg))) (setq rw (if (eql larger rw) wavg (- maxw wavg)) lw (- maxw rw))) (cl-psetq rw (+ rw (* erc-banlist-fill-padding @@ -6386,8 +6386,8 @@ with `erc--spkr' in the \"msg prop\" environment for any imminent `erc-display-message' invocations, and include any overrides defined in `erc--message-speaker-catalog'. Expect NICK (but not necessarily DISP) to be absent of any existing text properties." - (when-let ((erc-server-process) - (cusr (erc-get-server-user nick))) + (when-let* ((erc-server-process) + (cusr (erc-get-server-user nick))) (setq nick (erc-server-user-nickname cusr))) (erc--ensure-spkr-prop nick (get erc--message-speaker-catalog 'erc--msg-prop-overrides)) @@ -6554,14 +6554,14 @@ similar to that performed by `erc-format-my-nick', but use either `erc--message-speaker-input-query-privmsg' as a formatting template, with MESSAGE being the actual message body. Return a copy with possibly shared text-property values." - (if-let ((erc-show-my-nick) - (nick (erc-current-nick)) - (pfx (erc-get-channel-membership-prefix nick)) - (erc-current-message-catalog erc--message-speaker-catalog) - (key (if (or erc-format-query-as-channel-p - (erc--target-channel-p erc--target)) - 'input-chan-privmsg - 'input-query-privmsg))) + (if-let* ((erc-show-my-nick) + (nick (erc-current-nick)) + (pfx (erc-get-channel-membership-prefix nick)) + (erc-current-message-catalog erc--message-speaker-catalog) + (key (if (or erc-format-query-as-channel-p + (erc--target-channel-p erc--target)) + 'input-chan-privmsg + 'input-query-privmsg))) (progn (cond (erc--msg-props (puthash 'erc--msg key erc--msg-props)) (erc--msg-prop-overrides (push (cons 'erc--msg key) @@ -7194,7 +7194,7 @@ extensions." (let ((names (delete "" (split-string names-string))) (erc-channel-members-changed-hook nil)) (dolist (name names) - (when-let ((args (erc--partition-prefixed-names name))) + (when-let* ((args (erc--partition-prefixed-names name))) (pcase-let* ((`(,status ,nick ,login ,host) args) (cmem (erc-get-channel-user nick))) (progn @@ -8190,10 +8190,10 @@ ERC prints them as a single message joined by newlines.") (let* ((str (erc-user-input)) (state (erc--make-input-split str))) (run-hook-with-args 'erc--input-review-functions state) - (when-let (((not (erc--input-split-abortp state))) - (inhibit-read-only t) - (erc--current-line-input-split state) - (old-buf (current-buffer))) + (when-let* (((not (erc--input-split-abortp state))) + (inhibit-read-only t) + (erc--current-line-input-split state) + (old-buf (current-buffer))) (progn ; unprogn this during next major surgery (erc-set-active-buffer (current-buffer)) ;; Kill the input and the prompt @@ -9187,12 +9187,12 @@ This should be a string with substitution variables recognized by "Return the network or the current target and network combined. If the name of the network is not available, then use the shortened server name instead." - (if-let ((erc--target) - (name (if-let ((erc-networks--id) - (esid (erc-networks--id-symbol erc-networks--id))) - (symbol-name esid) - (erc-shorten-server-name (or erc-server-announced-name - erc-session-server))))) + (if-let* ((erc--target) + (name (if-let* ((erc-networks--id) + (esid (erc-networks--id-symbol erc-networks--id))) + (symbol-name esid) + (erc-shorten-server-name (or erc-server-announced-name + erc-session-server))))) (concat (erc--target-string erc--target) "@" name) (buffer-name))) @@ -9773,8 +9773,8 @@ one of the following hooks: `erc-kill-channel-hook' if a channel buffer was killed, or `erc-kill-buffer-hook' if any other buffer." (when (eq major-mode 'erc-mode) - (when-let ((erc--target) - (nick (erc-current-nick))) + (when-let* ((erc--target) + (nick (erc-current-nick))) (erc--remove-channel-users-but nick)) (cond ((eq (erc-server-buffer) (current-buffer)) @@ -9829,10 +9829,10 @@ This function should be on `erc-kill-server-hook'." (defun erc-restore-text-properties () "Ensure the `erc-parsed' and `tags' props cover the entire message." - (when-let ((parsed-posn (erc-find-parsed-property)) + (when-let* ((parsed-posn (erc-find-parsed-property)) (found (erc-get-parsed-vector parsed-posn))) (put-text-property (point-min) (point-max) 'erc-parsed found) - (when-let ((tags (get-text-property parsed-posn 'tags))) + (when-let* ((tags (get-text-property parsed-posn 'tags))) (put-text-property (point-min) (point-max) 'tags tags)))) (defun erc-get-parsed-vector (point) @@ -9858,7 +9858,7 @@ This function should be on `erc-kill-server-hook'." See also `erc-message-type'." ;; IRC numerics are three-digit numbers, possibly with leading 0s. ;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o)) - (if-let ((n (string-to-number command)) ((zerop n))) (intern command) n)) + (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n)) ;; Teach url.el how to open irc:// URLs with ERC. ;; To activate, customize `url-irc-function' to `url-irc-erc'. diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el index e5bf8d5fe82..4f8f0c1c7e4 100644 --- a/lisp/eshell/em-alias.el +++ b/lisp/eshell/em-alias.el @@ -221,14 +221,14 @@ This is useful after manually editing the contents of the file." (defun eshell-maybe-replace-by-alias--which (command) (unless (and eshell-prevent-alias-expansion (member command eshell-prevent-alias-expansion)) - (when-let ((alias (eshell-lookup-alias command))) + (when-let* ((alias (eshell-lookup-alias command))) (concat command " is an alias, defined as \"" (cadr alias) "\"")))) (defun eshell-maybe-replace-by-alias (command _args) "Call COMMAND's alias definition, if it exists." (unless (and eshell-prevent-alias-expansion (member command eshell-prevent-alias-expansion)) - (when-let ((alias (eshell-lookup-alias command))) + (when-let* ((alias (eshell-lookup-alias command))) (throw 'eshell-replace-command `(let ((eshell-command-name ',eshell-last-command-name) (eshell-command-arguments ',eshell-last-arguments) diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index 42373b8b8c0..f4337872a8e 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -306,8 +306,8 @@ The result is a list of three elements: (setq start-dir (pop globs)) (setq start-dir (file-name-as-directory "."))) (while globs - (if-let ((recurse (cdr (assoc (car globs) - eshell-glob-recursive-alist)))) + (if-let* ((recurse (cdr (assoc (car globs) + eshell-glob-recursive-alist)))) (if last-saw-recursion (setcar result recurse) (push recurse result) diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index a9274e7c60d..053ebf91dab 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -442,7 +442,7 @@ before the closing delimiter. This allows modifiers like (error "Unknown %s name specified for modifier `%c'" mod-type mod-char)) (lambda (file) - (when-let ((attrs (file-attributes file))) + (when-let* ((attrs (file-attributes file))) (= (nth attr-index attrs) ugid))))) (defun eshell-pred-file-time (mod-char mod-type attr-index) @@ -467,7 +467,7 @@ before the closing delimiter. This allows modifiers like (list #'time-less-p (lambda (a b) (time-less-p b a)) #'time-equal-p))) - (if-let ((number (eshell-get-numeric-modifier-argument))) + (if-let* ((number (eshell-get-numeric-modifier-argument))) (setq when (time-since (* number quantum))) (let* ((file (or (eshell-get-delimited-modifier-argument) (error "Malformed %s time modifier `%c'" @@ -476,7 +476,7 @@ before the closing delimiter. This allows modifiers like (error "Cannot stat file `%s'" file)))) (setq when (nth attr-index attrs)))) (lambda (file) - (when-let ((attrs (file-attributes file))) + (when-let* ((attrs (file-attributes file))) (funcall qual when (nth attr-index attrs)))))) (defun eshell-pred-file-type (type) @@ -492,13 +492,13 @@ that `ls -l' will show in the first column of its display." '(?b ?c) (list type)))) (lambda (file) - (when-let ((attrs (eshell-file-attributes (directory-file-name file)))) + (when-let* ((attrs (eshell-file-attributes (directory-file-name file)))) (memq (aref (file-attribute-modes attrs) 0) set))))) (defsubst eshell-pred-file-mode (mode) "Return a test which tests that MODE pertains to the file." (lambda (file) - (when-let ((modes (file-modes file 'nofollow))) + (when-let* ((modes (file-modes file 'nofollow))) (not (zerop (logand mode modes)))))) (defun eshell-pred-file-links () @@ -507,7 +507,7 @@ that `ls -l' will show in the first column of its display." (amount (or (eshell-get-numeric-modifier-argument) (error "Invalid file link count modifier `l'")))) (lambda (file) - (when-let ((attrs (eshell-file-attributes file))) + (when-let* ((attrs (eshell-file-attributes file))) (funcall qual (file-attribute-link-number attrs) amount))))) (defun eshell-pred-file-size () @@ -528,7 +528,7 @@ that `ls -l' will show in the first column of its display." (error "Invalid file size modifier `L'")) quantum)) (lambda (file) - (when-let ((attrs (eshell-file-attributes file))) + (when-let* ((attrs (eshell-file-attributes file))) (funcall qual (file-attribute-size attrs) amount))))) (defun eshell-pred-substitute (&optional repeat) diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el index 7de2bd4dc21..de62b5c7d97 100644 --- a/lisp/eshell/em-prompt.el +++ b/lisp/eshell/em-prompt.el @@ -178,8 +178,8 @@ Like `forward-paragraph', but also stops at the beginning of each prompt." (while (and (> n 0) (< (point) (point-max))) (let ((next-paragraph (save-excursion (forward-paragraph) (point))) (next-prompt (save-excursion - (if-let ((match (text-property-search-forward - 'field 'prompt t t))) + (if-let* ((match (text-property-search-forward + 'field 'prompt t t))) (prop-match-beginning match) (point-max))))) (goto-char (min next-paragraph next-prompt))) @@ -212,7 +212,7 @@ Like `backward-paragraph', but navigates using fields." (pcase (get-text-property (point) 'field) ('command-output) ('prompt (goto-char (field-end))) - (_ (when-let ((match (text-property-search-backward 'field 'prompt t))) + (_ (when-let* ((match (text-property-search-backward 'field 'prompt t))) (goto-char (prop-match-end match))))) ;; Now, move forward/backward to our destination prompt. (if (natnump n) diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 4ea25f7f202..ebecb279753 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -292,8 +292,8 @@ then the result will be: "If there are pending modifications to be made, make them now." (when eshell-current-argument (when eshell-arg-listified - (if-let ((grouped-terms (eshell-prepare-splice - eshell-current-argument))) + (if-let* ((grouped-terms (eshell-prepare-splice + eshell-current-argument))) (setq eshell-current-argument `(eshell-splice-args (eshell-concat-groups ,eshell-current-quoted diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 137abe6eb75..a8a19d2bcc9 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -1317,8 +1317,8 @@ have been replaced by constants." (setcar form (car new-form)) (setcdr form (cdr new-form))) (eshell-do-eval form synchronous-p)) - (if-let (((memq (car form) eshell-deferrable-commands)) - (procs (eshell-make-process-list result))) + (if-let* (((memq (car form) eshell-deferrable-commands)) + (procs (eshell-make-process-list result))) (if synchronous-p (funcall #'eshell-wait-for-processes procs) (eshell-manipulate form "inserting ignore form" @@ -1341,9 +1341,9 @@ have been replaced by constants." (run-hook-wrapped 'eshell-named-command-hook (lambda (hook) - (when-let (((symbolp hook)) - (which-func (get hook 'eshell-which-function)) - (result (funcall which-func command))) + (when-let* (((symbolp hook)) + (which-func (get hook 'eshell-which-function)) + (result (funcall which-func command))) (throw 'found result)))) (eshell-plain-command--which name))) (error (eshell-error (format "which: %s\n" (cadr error))))))) @@ -1407,7 +1407,7 @@ COMMAND may result in an alias being executed, or a plain command." sym))) (defun eshell-plain-command--which (command) - (if-let ((sym (eshell--find-plain-lisp-command command))) + (if-let* ((sym (eshell--find-plain-lisp-command command))) (or (with-output-to-string (require 'help-fns) (princ (format "%s is " sym)) @@ -1419,7 +1419,7 @@ COMMAND may result in an alias being executed, or a plain command." "Insert output from a plain COMMAND, using ARGS. COMMAND may result in either a Lisp function being executed by name, or an external command." - (if-let ((sym (eshell--find-plain-lisp-command command))) + (if-let* ((sym (eshell--find-plain-lisp-command command))) (eshell-lisp-command sym args) (eshell-external-command command args))) diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 443c39ff0d1..5c2b6b8d2ee 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -364,7 +364,7 @@ is not shared with the original handles." (declare (advertised-calling-convention (handles) "31.1")) (let ((dup-handles (make-vector eshell-number-of-handles nil))) (dotimes (idx eshell-number-of-handles) - (when-let ((handle (aref handles idx))) + (when-let* ((handle (aref handles idx))) (unless steal-p (cl-incf (cdar handle))) (aset dup-handles idx (list (car handle) t)))) @@ -373,7 +373,7 @@ is not shared with the original handles." (defun eshell-protect-handles (handles) "Protect the handles in HANDLES from a being closed." (dotimes (idx eshell-number-of-handles) - (when-let ((handle (aref handles idx))) + (when-let* ((handle (aref handles idx))) (cl-incf (cdar handle)))) handles) @@ -608,7 +608,7 @@ If TARGET is a virtual target (see `eshell-virtual-targets'), return an `eshell-generic-target' instance; otherwise, return a marker for a file named TARGET." (setq mode (or mode 'insert)) - (if-let ((redir (assoc raw-target eshell-virtual-targets))) + (if-let* ((redir (assoc raw-target eshell-virtual-targets))) (let (target) (catch 'eshell-null-device (setq target (if (nth 2 redir) @@ -699,7 +699,7 @@ If status is nil, prompt before killing." (cl-defmethod eshell-close-target ((target eshell-function-target) status) "Close an Eshell function TARGET." - (when-let ((close-function (eshell-function-target-close-function target))) + (when-let* ((close-function (eshell-function-target-close-function target))) (funcall close-function status))) (cl-defgeneric eshell-output-object-to-target (object target) diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 87c95d39603..4755996c40c 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -595,7 +595,7 @@ PROC is the process that's exiting. STRING is the exit message." "buffer for external process `%s' already killed" proc))))) (funcall finish-io))) - (when-let ((entry (assq proc eshell-process-list))) + (when-let* ((entry (assq proc eshell-process-list))) (eshell-remove-process-entry entry)))))) (defun eshell-process-interact (func &optional all query) diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index e3ff76abc26..dc0bc4532de 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -567,7 +567,7 @@ Possible variable references are: (list (function (lambda () (delete-file ,temp) - (when-let ((buffer (get-file-buffer ,temp))) + (when-let* ((buffer (get-file-buffer ,temp))) (kill-buffer buffer))))))) (eshell-apply-indices ,temp indices ,eshell-current-quoted)) (goto-char (1+ end)))))) @@ -587,11 +587,11 @@ Possible variable references are: (or (eshell-unescape-inner-double-quote (point-max)) (cons (point) (point-max))) (let (name) - (when-let ((delim - (catch 'eshell-incomplete - (ignore (setq name (if (eq (char-after) ?\') - (eshell-parse-literal-quote) - (eshell-parse-double-quote))))))) + (when-let* ((delim + (catch 'eshell-incomplete + (ignore (setq name (if (eq (char-after) ?\') + (eshell-parse-literal-quote) + (eshell-parse-double-quote))))))) (throw 'eshell-incomplete (concat "$" delim))) (when name `(eshell-get-variable ,(eval name) indices ,eshell-current-quoted))))) @@ -676,7 +676,7 @@ INDICES is a list of index-lists generated by `eshell-parse-indices'." "Get the value for the variable NAME. INDICES is a list of index-lists (see `eshell-parse-indices'). If QUOTED is non-nil, this was invoked inside double-quotes." - (if-let ((alias (assoc name eshell-variable-aliases-list))) + (if-let* ((alias (assoc name eshell-variable-aliases-list))) (let ((target (nth 1 alias))) (when (and (not (functionp target)) (consp target)) @@ -715,7 +715,7 @@ If QUOTED is non-nil, this was invoked inside double-quotes." NAME can be a string (in which case it refers to an environment variable or variable alias) or a symbol (in which case it refers to a Lisp variable)." - (if-let ((alias (assoc name eshell-variable-aliases-list))) + (if-let* ((alias (assoc name eshell-variable-aliases-list))) (let ((target (nth 1 alias))) (cond ((functionp target) diff --git a/lisp/faces.el b/lisp/faces.el index 21c3e663c6e..de4f3a9f92b 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2097,7 +2097,7 @@ do that, use `get-text-property' and `get-char-property'." (let (faces) (when text ;; Try to get a face name from the buffer. - (when-let ((face (thing-at-point 'face))) + (when-let* ((face (thing-at-point 'face))) (push face faces))) ;; Add the named faces that the `read-face-name' or `face' property uses. (let ((faceprop (or (get-char-property (point) 'read-face-name) diff --git a/lisp/ffap.el b/lisp/ffap.el index e431aeed8b1..6a4915fb5a3 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -805,7 +805,7 @@ to extract substrings.") (declare-function project-root "project" (project)) (defun ffap-in-project (name) - (when-let (project (project-current)) + (when-let* ((project (project-current))) (file-name-concat (project-root project) name))) (defun ffap-home (name) (ffap-locate-file name t '("~"))) diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 4e289d564c9..89711e6ca8a 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -76,7 +76,7 @@ struct.") "Remove DESCRIPTOR from `file-notify-descriptors'. DESCRIPTOR should be an object returned by `file-notify-add-watch'. If it is registered in `file-notify-descriptors', a `stopped' event is sent." - (when-let ((watch (gethash descriptor file-notify-descriptors))) + (when-let* ((watch (gethash descriptor file-notify-descriptors))) (unwind-protect ;; Send `stopped' event. (file-notify-handle-event diff --git a/lisp/files-x.el b/lisp/files-x.el index f70be5f7ff3..c55164235df 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -552,7 +552,7 @@ Returns the filename, expanded." (read-file-name "File: " (cond (dir) - ((when-let ((proj (and (featurep 'project) (project-current)))) + ((when-let* ((proj (and (featurep 'project) (project-current)))) (project-root proj)))) nil (lambda (fname) @@ -784,8 +784,8 @@ whose elements are of the form (VAR . VALUE). Unlike `connection-local-set-profile-variables' (which see), this function preserves the values of any existing variable definitions that aren't listed in VARIABLES." - (when-let ((existing-variables - (nreverse (connection-local-get-profile-variables profile)))) + (when-let* ((existing-variables + (nreverse (connection-local-get-profile-variables profile)))) (dolist (var variables) (setf (alist-get (car var) existing-variables) (cdr var))) (setq variables (nreverse existing-variables))) @@ -959,7 +959,7 @@ value is the default binding of the variable." (if (not criteria) ,variable (hack-connection-local-variables criteria) - (if-let ((result (assq ',variable connection-local-variables-alist))) + (if-let* ((result (assq ',variable connection-local-variables-alist))) (cdr result) ,variable)))) diff --git a/lisp/files.el b/lisp/files.el index 6fc9ae2f1a2..114ddc9c259 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1340,7 +1340,7 @@ Tip: You can use this expansion of remote identifier components returns a remote file name for file \"/bin/sh\" that has the same remote identifier as FILE but expanded; a name such as \"/sudo:root@myhost:/bin/sh\"." - (when-let ((handler (find-file-name-handler file 'file-remote-p))) + (when-let* ((handler (find-file-name-handler file 'file-remote-p))) (funcall handler 'file-remote-p file identification connected))) ;; Probably this entire variable should be obsolete now, in favor of @@ -2196,7 +2196,7 @@ if you want to permanently change your home directory after having started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)." ;; Get rid of the prefixes added by the automounter. (save-match-data ;FIXME: Why? - (if-let ((handler (find-file-name-handler filename 'abbreviate-file-name))) + (if-let* ((handler (find-file-name-handler filename 'abbreviate-file-name))) (funcall handler 'abbreviate-file-name filename) ;; Avoid treating /home/foo as /home/Foo during `~' substitution. (let ((case-fold-search (file-name-case-insensitive-p filename))) @@ -3531,7 +3531,7 @@ we don't actually set it to the same mode the buffer already has." ;; If we didn't, look for an interpreter specified in the first line. ;; As a special case, allow for things like "#!/bin/env perl", which ;; finds the interpreter anywhere in $PATH. - (when-let + (when-let* ((interp (save-excursion (goto-char (point-min)) (if (looking-at auto-mode-interpreter-regexp) @@ -4160,7 +4160,7 @@ all the specified local variables, but ignores any settings of \"mode:\"." ;; Handle `lexical-binding' and other special local ;; variables. (dolist (variable permanently-enabled-local-variables) - (when-let ((elem (assq variable result))) + (when-let* ((elem (assq variable result))) (push elem file-local-variables-alist))) (hack-local-variables-apply)))))) @@ -6938,8 +6938,8 @@ buffer read-only, or keeping minor modes, etc.") (defun revert-buffer-restore-read-only () "Preserve read-only state for `revert-buffer'." - (when-let ((state (and (boundp 'read-only-mode--state) - (list read-only-mode--state)))) + (when-let* ((state (and (boundp 'read-only-mode--state) + (list read-only-mode--state)))) (lambda () (setq buffer-read-only (car state)) (setq-local read-only-mode--state (car state))))) diff --git a/lisp/find-dired.el b/lisp/find-dired.el index 5b4ee0d70aa..13c8bf722c3 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -431,9 +431,9 @@ specifies what to use in place of \"-ls\" as the final argument." "Sort entries in *Find* buffer by file name lexicographically." (sort-subr nil 'forward-line 'end-of-line (lambda () - (when-let ((start - (next-single-property-change - (point) 'dired-filename))) + (when-let* ((start + (next-single-property-change + (point) 'dired-filename))) (buffer-substring-no-properties start (line-end-position)))))) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 7b077a826bf..d2232f72c55 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1846,11 +1846,11 @@ See `font-lock-ignore' for the possible rules." (defun font-lock--filter-keywords (keywords) "Filter a list of KEYWORDS using `font-lock-ignore'." - (if-let ((rules (mapcan (pcase-lambda (`(,mode . ,rules)) - (when (or (and (boundp mode) mode) - (derived-mode-p mode)) - (copy-sequence rules))) - font-lock-ignore))) + (if-let* ((rules (mapcan (pcase-lambda (`(,mode . ,rules)) + (when (or (and (boundp mode) mode) + (derived-mode-p mode)) + (copy-sequence rules))) + font-lock-ignore))) (seq-filter (lambda (keyword) (not (font-lock--match-keyword `(or ,@rules) keyword))) keywords) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 5151ad1c1b8..8243e4e632b 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2419,8 +2419,8 @@ fill width." (defun article-emojize-symbols () "Display symbols (that have an emoji version) as emojis." (interactive nil gnus-article-mode) - (when-let ((font (and (display-multi-font-p) - (car (internal-char-font nil ?😀))))) + (when-let* ((font (and (display-multi-font-p) + (car (internal-char-font nil ?😀))))) (save-excursion (let ((inhibit-read-only t)) (goto-char (point-min)) diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 558ad8648ca..b73fa268da2 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -357,7 +357,7 @@ If it is down, start it up (again)." (funcall (gnus-get-function gnus-command-method 'close-server) (nth 1 gnus-command-method) (nthcdr 2 gnus-command-method)) - (when-let ((elem (assoc gnus-command-method gnus-opened-servers))) + (when-let* ((elem (assoc gnus-command-method gnus-opened-servers))) (setf (nth 1 elem) 'closed))))) (defun gnus-request-list (command-method) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index c25163ac770..ca82546ef82 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1012,7 +1012,7 @@ Responsible for handling and, or, and parenthetical expressions.") (let (clauses) (mapc (lambda (item) - (when-let ((expr (gnus-search-transform-expression engine item))) + (when-let* ((expr (gnus-search-transform-expression engine item))) (push expr clauses))) query) (mapconcat #'identity (reverse clauses) " "))) @@ -1486,7 +1486,7 @@ Returns a list of [group article score] vectors." (push (list f-name article group score) artlist))))) ;; Are we running an additional grep query? - (when-let ((grep-reg (alist-get 'grep query))) + (when-let* ((grep-reg (alist-get 'grep query))) (setq artlist (gnus-search-grep-search engine artlist grep-reg))) (when (>= gnus-verbose 7) @@ -1717,9 +1717,9 @@ cross our fingers for the rest of it." (let (clauses) (mapc (lambda (item) - (when-let ((expr (if (consp (car-safe item)) - (gnus-search-transform engine item) - (gnus-search-transform-expression engine item)))) + (when-let* ((expr (if (consp (car-safe item)) + (gnus-search-transform engine item) + (gnus-search-transform-expression engine item)))) (push expr clauses))) query) (mapconcat #'identity (reverse clauses) " "))) @@ -2141,8 +2141,8 @@ remaining string, then adds all that to the top-level spec." (assoc-string srv gnus-search-engine-instance-alist t)) (nth 1 engine-config) (cdr-safe (assoc (car method) gnus-search-default-engines)) - (when-let ((old (assoc 'nnir-search-engine - (cddr method)))) + (when-let* ((old (assoc 'nnir-search-engine + (cddr method)))) (nnheader-message 8 "\"nnir-search-engine\" is no longer a valid parameter") (nth 1 old)))) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 33582ce5dbf..cebeb6d4c37 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9374,9 +9374,9 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'." (let ((pt (point)) urls primary) (while (forward-button 1 nil nil t) (setq pt (point)) - (when-let ((w (button-at pt)) - (u (or (button-get w 'shr-url) - (get-text-property pt 'gnus-string)))) + (when-let* ((w (button-at pt)) + (u (or (button-get w 'shr-url) + (get-text-property pt 'gnus-string)))) (when (string-match-p "\\`[[:alpha:]]+://" u) (if (and gnus-collect-urls-primary-text (null primary) (string= gnus-collect-urls-primary-text (button-label w))) @@ -9404,7 +9404,7 @@ See `gnus-collect-urls'." (let* ((parsed (url-generic-parse-url url)) (host (url-host parsed)) (rest (concat (url-filename parsed) - (when-let ((target (url-target parsed))) + (when-let* ((target (url-target parsed))) (concat "#" target))))) (concat host (string-truncate-left rest (- max (length host))))))) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index f1fc129a505..62a090bd9df 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -3119,9 +3119,9 @@ g -- Group name." "Check whether GROUP supports function FUNC. GROUP can either be a string (a group name) or a select method." (ignore-errors - (when-let ((method (if (stringp group) - (car (gnus-find-method-for-group group)) - group))) + (when-let* ((method (if (stringp group) + (car (gnus-find-method-for-group group)) + group))) (unless (featurep method) (require method)) (fboundp (intern (format "%s-%s" method func)))))) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index d52ed9662a7..b49e3f9d9ca 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -4934,8 +4934,8 @@ If you always want Gnus to send messages in one piece, set (let ((addr (message-fetch-field hdr))) (when (stringp addr) (dolist (address (mail-header-parse-addresses addr t)) - (when-let ((warning (textsec-suspicious-p - address 'email-address-header))) + (when-let* ((warning (textsec-suspicious-p + address 'email-address-header))) (unless (y-or-n-p (format "Suspicious address: %s; send anyway?" warning)) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 8ecf7a33305..70cefe5bb49 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -507,7 +507,7 @@ type detected." (when (and (consp (car cont)) (= (length cont) 1) content-type) - (when-let ((spec (assq 'type (cdr (car cont))))) + (when-let* ((spec (assq 'type (cdr (car cont))))) (setcdr spec content-type))) (when (fboundp 'libxml-parse-html-region) (setq cont (mapcar #'mml-expand-all-html-into-multipart-related cont))) @@ -943,7 +943,7 @@ type detected." (when parameters (let ((cont (copy-sequence cont))) ;; Set the file name to what's specified by the user. - (when-let ((recipient-filename (cdr (assq 'recipient-filename cont)))) + (when-let* ((recipient-filename (cdr (assq 'recipient-filename cont)))) (setcdr cont (cons (cons 'filename recipient-filename) (cdr cont)))) diff --git a/lisp/gnus/nnatom.el b/lisp/gnus/nnatom.el index f6885abb634..a9f6b9179de 100644 --- a/lisp/gnus/nnatom.el +++ b/lisp/gnus/nnatom.el @@ -56,12 +56,12 @@ (insert-file-contents feed) (mm-url-insert-file-contents (concat "https://" feed))) (file-error (nnheader-report nnatom-backend (cdr e))) - (:success (when-let ((data (if (libxml-available-p) - (libxml-parse-xml-region - (point-min) (point-max)) - (car (xml-parse-region - (point-min) (point-max))))) - (authors (list 'authors))) + (:success (when-let* ((data (if (libxml-available-p) + (libxml-parse-xml-region + (point-min) (point-max)) + (car (xml-parse-region + (point-min) (point-max))))) + (authors (list 'authors))) (when (eq (car data) 'top) (setq data (assq 'feed data))) (dom-add-child-before data authors) @@ -93,8 +93,8 @@ (when (eq (car data) 'feed) (setq data (dom-children data))) ;; Discard any children between/after entries. (while (and data (not (eq (car-safe (car data)) 'entry))) (pop data)) - (when-let ((article (car data)) - (auths (list 'authors)) (links (list 'links))) + (when-let* ((article (car data)) + (auths (list 'authors)) (links (list 'links))) (dom-add-child-before article links) (dom-add-child-before article auths) (dolist (child (cddddr article) `(,article . ,(cdr data))) @@ -126,7 +126,7 @@ (defun nnatom--read-article-or-group-authors (article-or-group) "Return the authors of ARTICLE-OR-GROUP, or nil." - (when-let + (when-let* ((a (mapconcat (lambda (author) (let* ((name (nnatom--dom-line (dom-child-by-tag author 'name))) @@ -161,14 +161,14 @@ return the subject. Otherwise, return nil." (defun nnatom--read-publish (article) "Return the date and time ARTICLE was published, or nil." - (when-let (d (dom-child-by-tag article 'published)) + (when-let* ((d (dom-child-by-tag article 'published))) (date-to-time (nnatom--dom-line d)))) (defvoo nnatom-read-publish-date-function #'nnatom--read-publish nil nnfeed-read-publish-date-function) (defun nnatom--read-update (article) "Return the date and time of the last update to ARTICLE, or nil." - (when-let (d (dom-child-by-tag article 'updated)) + (when-let* ((d (dom-child-by-tag article 'updated))) (date-to-time (nnatom--dom-line d)))) (defvoo nnatom-read-update-date-function #'nnatom--read-update nil nnfeed-read-update-date-function) @@ -178,56 +178,56 @@ return the subject. Otherwise, return nil." (let ((alt 0) (rel 0) (sel 0) (enc 0) (via 0) (aut 0)) (mapcan (lambda (link) - (when-let ((l (car-safe link))) + (when-let* ((l (car-safe link))) (or - (when-let (((eq l 'content)) - (src (dom-attr link 'src)) - (label (concat "Link" - (and (< 1 (cl-incf alt)) - (format " %s" alt))))) + (when-let* (((eq l 'content)) + (src (dom-attr link 'src)) + (label (concat "Link" + (and (< 1 (cl-incf alt)) + (format " %s" alt))))) `(((("text/plain") . ,(format "%s: %s\n" label src)) (("text/html") . ,(format "[%s] " src label))))) - (when-let (((or (eq l 'author) (eq l 'contributor))) - (name (nnatom--dom-line (dom-child-by-tag link 'name))) - (name (if (string-blank-p name) - (concat "Author" - (and (< 1 (cl-incf aut)) - (format " %s" aut))) - name)) - (uri (nnatom--dom-line (dom-child-by-tag link 'uri))) - ((not (string-blank-p uri)))) + (when-let* (((or (eq l 'author) (eq l 'contributor))) + (name (nnatom--dom-line (dom-child-by-tag link 'name))) + (name (if (string-blank-p name) + (concat "Author" + (and (< 1 (cl-incf aut)) + (format " %s" aut))) + name)) + (uri (nnatom--dom-line (dom-child-by-tag link 'uri))) + ((not (string-blank-p uri)))) `(((("text/plain") . ,(format "%s: %s\n" name uri)) (("text/html") . ,(format "[%s] " uri name))))) - (when-let (((eq l 'link)) - (attrs (dom-attributes link)) - (label (or (cdr (assq 'title attrs)) - (pcase (cdr (assq 'rel attrs)) - ("related" - (concat "Related" - (and (< 1 (cl-incf rel)) - (format " %s" rel)))) - ("self" - (concat "More" - (and (< 1 (cl-incf sel)) - (format " %s" sel)))) - ("enclosure" - (concat "Enclosure" - (and (< 1 (cl-incf enc)) - (format " %s" enc)))) - ("via" - (concat "Source" - (and (< 1 (cl-incf via)) - (format " %s" via)))) - (_ (if-let - ((lang (cdr (assq 'hreflang link)))) - (format "Link (%s)" lang) - (concat - "Link" - (and (< 1 (cl-incf alt)) - (format " %s" alt)))))))) - (link (cdr (assq 'href attrs)))) + (when-let* (((eq l 'link)) + (attrs (dom-attributes link)) + (label (or (cdr (assq 'title attrs)) + (pcase (cdr (assq 'rel attrs)) + ("related" + (concat "Related" + (and (< 1 (cl-incf rel)) + (format " %s" rel)))) + ("self" + (concat "More" + (and (< 1 (cl-incf sel)) + (format " %s" sel)))) + ("enclosure" + (concat "Enclosure" + (and (< 1 (cl-incf enc)) + (format " %s" enc)))) + ("via" + (concat "Source" + (and (< 1 (cl-incf via)) + (format " %s" via)))) + (_ (if-let* + ((lang (cdr (assq 'hreflang link)))) + (format "Link (%s)" lang) + (concat + "Link" + (and (< 1 (cl-incf alt)) + (format " %s" alt)))))))) + (link (cdr (assq 'href attrs)))) `(((("text/plain") . ,(format "%s: %s\n" label link)) (("text/html") . ,(format "[%s] " link label)))))))) diff --git a/lisp/gnus/nnfeed.el b/lisp/gnus/nnfeed.el index 2d33d4c813b..e8c1fdb8e2b 100644 --- a/lisp/gnus/nnfeed.el +++ b/lisp/gnus/nnfeed.el @@ -277,8 +277,8 @@ group names to their data, which should be a vector of the form (defun nnfeed--read-server (server) "Read SERVER's information from storage." - (if-let ((f (nnfeed--server-file server)) - ((file-readable-p f))) + (if-let* ((f (nnfeed--server-file server)) + ((file-readable-p f))) (with-temp-buffer (insert-file-contents f) (goto-char (point-min)) @@ -287,10 +287,10 @@ group names to their data, which should be a vector of the form (defun nnfeed--write-server (server) "Write SERVER's information to storage." - (if-let ((f (nnfeed--server-file server)) - ((file-writable-p f))) - (if-let ((s (gethash server nnfeed-servers)) - ((hash-table-p s))) + (if-let* ((f (nnfeed--server-file server)) + ((file-writable-p f))) + (if-let* ((s (gethash server nnfeed-servers)) + ((hash-table-p s))) (with-temp-file f (insert ";;;; -*- mode: lisp-data -*- DO NOT EDIT\n") (prin1 s (current-buffer)) @@ -346,8 +346,8 @@ If GROUP is omitted or nil, parse the entire FEED." (and desc (aset g 5 desc)) (while-let ((article (funcall nnfeed-read-article-function cg stale)) (article (prog1 (car article) (setq cg (cdr article))))) - (when-let ((id (funcall nnfeed-read-id-function article)) - (id (format "<%s@%s.%s>" id name nnfeed-backend))) + (when-let* ((id (funcall nnfeed-read-id-function article)) + (id (format "<%s@%s.%s>" id name nnfeed-backend))) (let* ((num (gethash id ids)) (update (funcall nnfeed-read-update-date-function article)) (prev-update (aref (gethash num articles @@ -423,14 +423,14 @@ Each value in this table should be a vector of the form (defun nnfeed--group-data (group server) "Get parsed data for GROUP from SERVER." - (when-let ((server (nnfeed--server-address server)) - (s (gethash server nnfeed-servers)) - ((hash-table-p s))) + (when-let* ((server (nnfeed--server-address server)) + (s (gethash server nnfeed-servers)) + ((hash-table-p s))) (gethash group s))) (defun nnfeed-retrieve-article (article group) "Retrieve headers for ARTICLE from GROUP." - (if-let ((a (gethash article (aref group 2)))) + (if-let* ((a (gethash article (aref group 2)))) (insert (format "221 %s Article retrieved. From: %s\nSubject: %s\nDate: %s\nMessage-ID: %s\n.\n" article @@ -441,10 +441,10 @@ From: %s\nSubject: %s\nDate: %s\nMessage-ID: %s\n.\n" (insert "404 Article not found.\n.\n"))) (deffoo nnfeed-retrieve-headers (articles &optional group server _fetch-old) - (if-let ((server (or server (nnfeed--current-server-no-prefix))) - (g (or (nnfeed--group-data group server) - `[ nil ,nnfeed-group-article-ids ,nnfeed-group-articles - nil nil nil]))) + (if-let* ((server (or server (nnfeed--current-server-no-prefix))) + (g (or (nnfeed--group-data group server) + `[ nil ,nnfeed-group-article-ids ,nnfeed-group-articles + nil nil nil]))) (with-current-buffer nntp-server-buffer (erase-buffer) (or (and (stringp (car articles)) @@ -513,27 +513,27 @@ by `nnfeed-read-parts-function'), and links (as returned by Only HEADERS of a type included in MIME are considered." (concat (mapconcat (lambda (header) - (when-let ((m (car-safe header)) - ((member m mime))) + (when-let* ((m (car-safe header)) + ((member m mime))) (format "%s: %s\n" m (cdr header)))) headers) "\n" (funcall nnfeed-print-content-function content headers links))) (deffoo nnfeed-request-article (article &optional group server to-buffer) - (if-let ((server (or server (nnfeed--current-server-no-prefix))) - (g (or (nnfeed--group-data group server) - (and (setq group nnfeed-group) - `[ nil ,nnfeed-group-article-ids - ,nnfeed-group-articles - ,nnfeed-group-article-max-num - ,nnfeed-group-article-min-num nil]))) - (num (or (and (stringp article) - (gethash article (aref g 1))) - (and (numberp article) article))) - ((and (<= num (aref g 3)) - (>= num (aref g 4)))) - (a (gethash num (aref g 2)))) + (if-let* ((server (or server (nnfeed--current-server-no-prefix))) + (g (or (nnfeed--group-data group server) + (and (setq group nnfeed-group) + `[ nil ,nnfeed-group-article-ids + ,nnfeed-group-articles + ,nnfeed-group-article-max-num + ,nnfeed-group-article-min-num nil]))) + (num (or (and (stringp article) + (gethash article (aref g 1))) + (and (numberp article) article))) + ((and (<= num (aref g 3)) + (>= num (aref g 4)))) + (a (gethash num (aref g 2)))) (with-current-buffer (or to-buffer nntp-server-buffer) (erase-buffer) (let* ((links (aref a 5)) @@ -575,12 +575,12 @@ Only HEADERS of a type included in MIME are considered." (deffoo nnfeed-request-group (group &optional server fast _info) (with-current-buffer nntp-server-buffer (erase-buffer) - (if-let ((server (or server (nnfeed--current-server-no-prefix))) - (g (or (if fast (nnfeed--group-data group server) - (setq server (nnfeed--parse-feed server group)) - (and (hash-table-p server) (gethash group server))) - `[ ,group ,(make-hash-table :test 'equal) - ,(make-hash-table :test 'eql) 0 1 ""]))) + (if-let* ((server (or server (nnfeed--current-server-no-prefix))) + (g (or (if fast (nnfeed--group-data group server) + (setq server (nnfeed--parse-feed server group)) + (and (hash-table-p server) (gethash group server))) + `[ ,group ,(make-hash-table :test 'equal) + ,(make-hash-table :test 'eql) 0 1 ""]))) (progn (setq nnfeed-group group nnfeed-group-article-ids (aref g 1) @@ -608,10 +608,10 @@ Only HEADERS of a type included in MIME are considered." (deffoo nnfeed-request-list (&optional server) (with-current-buffer nntp-server-buffer (erase-buffer) - (when-let ((p (point)) - (s (nnfeed--parse-feed - (or server (nnfeed--current-server-no-prefix)))) - ((hash-table-p s))) + (when-let* ((p (point)) + (s (nnfeed--parse-feed + (or server (nnfeed--current-server-no-prefix)))) + ((hash-table-p s))) (maphash (lambda (group g) (insert (format "\"%s\" %s %s y\n" group (aref g 3) (aref g 4)))) @@ -634,12 +634,12 @@ Only HEADERS of a type included in MIME are considered." ;; separates the group name from the description with either a tab or a space. (defun nnfeed--group-description (name group) "Return a description line for a GROUP called NAME." - (when-let ((desc (aref group 5)) - ((not (string-blank-p desc)))) + (when-let* ((desc (aref group 5)) + ((not (string-blank-p desc)))) (insert name "\t" desc "\n"))) (deffoo nnfeed-request-group-description (group &optional server) - (when-let ((server (or server (nnfeed--current-server-no-prefix))) + (when-let* ((server (or server (nnfeed--current-server-no-prefix))) (g (nnfeed--group-data group server))) (with-current-buffer nntp-server-buffer (erase-buffer) @@ -647,38 +647,38 @@ Only HEADERS of a type included in MIME are considered." t))) (deffoo nnfeed-request-list-newsgroups (&optional server) - (when-let ((server (or server (nnfeed--current-server-no-prefix))) - (s (gethash (nnfeed--server-address server) nnfeed-servers)) - ((hash-table-p s))) + (when-let* ((server (or server (nnfeed--current-server-no-prefix))) + (s (gethash (nnfeed--server-address server) nnfeed-servers)) + ((hash-table-p s))) (with-current-buffer nntp-server-buffer (erase-buffer) (maphash #'nnfeed--group-description s) t))) (deffoo nnfeed-request-rename-group (group new-name &optional server) - (when-let ((server (or server (nnfeed--current-server-no-prefix))) - (a (nnfeed--server-address server)) - (s (or (gethash a nnfeed-servers) - (and ; Open the server to add it to `nnfeed-servers' - (save-match-data - (nnfeed-open-server - server - (cdr ; Get defs and backend. - (assoc a (cdr (assq nnfeed-backend nnoo-state-alist)) - (lambda (car key) - (and (stringp car) - (string-match - (concat - "\\`\\(\\(nn[[:alpha:]]+\\)\\+\\)?" - (regexp-quote key) "\\'") - car) - (setq server car))))) - (if (match-string 1 server) - (intern (match-string 2 server)) 'nnfeed))) - (gethash a nnfeed-servers)))) - (g (or (nnfeed--group-data group a) - `[ ,group ,(make-hash-table :test 'equal) - ,(make-hash-table :test 'eql) nil 1 ""]))) + (when-let* ((server (or server (nnfeed--current-server-no-prefix))) + (a (nnfeed--server-address server)) + (s (or (gethash a nnfeed-servers) + (and ; Open the server to add it to `nnfeed-servers' + (save-match-data + (nnfeed-open-server + server + (cdr ; Get defs and backend. + (assoc a (cdr (assq nnfeed-backend nnoo-state-alist)) + (lambda (car key) + (and (stringp car) + (string-match + (concat + "\\`\\(\\(nn[[:alpha:]]+\\)\\+\\)?" + (regexp-quote key) "\\'") + car) + (setq server car))))) + (if (match-string 1 server) + (intern (match-string 2 server)) 'nnfeed))) + (gethash a nnfeed-servers)))) + (g (or (nnfeed--group-data group a) + `[ ,group ,(make-hash-table :test 'equal) + ,(make-hash-table :test 'eql) nil 1 ""]))) (puthash new-name g s) (puthash group new-name nnfeed-group-names) (remhash group s) diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index e11d063f6ee..dbe0aba176f 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -554,10 +554,10 @@ as unread by Gnus.") (mapcar (lambda (art) (cons art - (when-let ((modtime - (file-attribute-modification-time - (file-attributes - (concat dir (int-to-string art)))))) + (when-let* ((modtime + (file-attribute-modification-time + (file-attributes + (concat dir (int-to-string art)))))) (time-convert modtime 'list)))) new))) ;; Make Gnus mark all new articles as unread. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index eb2c822aa30..c87c86bae84 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -325,7 +325,7 @@ handling of autoloaded functions." (defun help-find-source () "Switch to a buffer visiting the source of what is being described in *Help*." (interactive) - (if-let ((help-buffer (get-buffer "*Help*"))) + (if-let* ((help-buffer (get-buffer "*Help*"))) (with-current-buffer help-buffer (help-view-source)) (error "No *Help* buffer found"))) @@ -649,7 +649,7 @@ the C sources, too." (lambda (entry level) (when (symbolp map) (setq map (symbol-function map))) - (when-let ((elem (assq entry (cdr map)))) + (when-let* ((elem (assq entry (cdr map)))) (when (> level 0) (push sep string)) (if (eq (nth 1 elem) 'menu-item) @@ -1003,8 +1003,8 @@ TYPE indicates the namespace and is `fun' or `var'." (defun help-fns--mention-first-release (object type) (when (symbolp object) - (when-let ((first (or (help-fns--first-release-override object type) - (help-fns--first-release object)))) + (when-let* ((first (or (help-fns--first-release-override object type) + (help-fns--first-release object)))) (with-current-buffer standard-output (insert (format " Probably introduced at or before Emacs version %s.\n" first)))))) @@ -1016,8 +1016,8 @@ TYPE indicates the namespace and is `fun' or `var'." #'help-fns--mention-shortdoc-groups) (defun help-fns--mention-shortdoc-groups (object) (require 'shortdoc) - (when-let ((groups (and (symbolp object) - (shortdoc-function-groups object)))) + (when-let* ((groups (and (symbolp object) + (shortdoc-function-groups object)))) (let ((start (point)) (times 0)) (with-current-buffer standard-output @@ -1618,7 +1618,7 @@ it is displayed along with the global value." (defun help-fns--customize-variable-version (variable) (when (custom-variable-p variable) ;; Note variable's version or package version. - (when-let ((output (describe-variable-custom-version-info variable))) + (when-let* ((output (describe-variable-custom-version-info variable))) (princ output)))) (add-hook 'help-fns-describe-variable-functions #'help-fns--var-safe-local) @@ -1864,7 +1864,7 @@ If FRAME is omitted or nil, use the selected frame." (add-hook 'help-fns-describe-face-functions #'help-fns--face-custom-version-info) (defun help-fns--face-custom-version-info (face _frame) - (when-let ((version-info (describe-variable-custom-version-info face 'face))) + (when-let* ((version-info (describe-variable-custom-version-info face 'face))) (insert version-info) (terpri))) @@ -2223,7 +2223,7 @@ is enabled in the Help buffer." (lambda (_) (describe-function major)))) (insert " mode") - (when-let ((file-name (find-lisp-object-file-name major nil))) + (when-let* ((file-name (find-lisp-object-file-name major nil))) (insert (format " defined in %s:\n\n" (buttonize (help-fns-short-filename file-name) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 6a808088cec..33b8eccab2c 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -646,7 +646,7 @@ that." ;; Quoted symbols (save-excursion (while (re-search-forward help-xref-symbol-regexp nil t) - (when-let ((sym (intern-soft (match-string 9)))) + (when-let* ((sym (intern-soft (match-string 9)))) (if (match-string 8) (delete-region (match-beginning 8) (match-end 8)) diff --git a/lisp/help.el b/lisp/help.el index 5efe207c624..1617afdcd6e 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -883,8 +883,8 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (let ((otherstring (help--key-description-fontified untranslated))) (if (equal string otherstring) string - (if-let ((char-name (and (length= string 1) - (char-to-name (aref string 0))))) + (if-let* ((char-name (and (length= string 1) + (char-to-name (aref string 0))))) (format "%s '%s' (translated from %s)" string char-name otherstring) (format "%s (translated from %s)" string otherstring))))))) @@ -1668,7 +1668,7 @@ Return nil if the key sequence is too long." (cond ((or (stringp definition) (vectorp definition)) (if translation (insert (concat (key-description definition nil) - (when-let ((char-name (char-to-name (aref definition 0)))) + (when-let* ((char-name (char-to-name (aref definition 0)))) (format "\t%s" char-name)) "\n")) ;; These should be rare nowadays, replaced by `kmacro's. diff --git a/lisp/hfy-cmap.el b/lisp/hfy-cmap.el index e9956222e9c..b500c664ff1 100644 --- a/lisp/hfy-cmap.el +++ b/lisp/hfy-cmap.el @@ -835,7 +835,7 @@ Loads the variable `hfy-rgb-txt-color-map', which is used by (when (and rgb-txt (file-readable-p rgb-txt)) (setq rgb-buffer (find-file-noselect rgb-txt 'nowarn)) - (when-let ((result (hfy-cmap--parse-buffer rgb-buffer))) + (when-let* ((result (hfy-cmap--parse-buffer rgb-buffer))) (setq hfy-rgb-txt-color-map result)) (kill-buffer rgb-buffer)))) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 33b68b96ff2..4cbe3c4ba15 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -857,7 +857,7 @@ specification, with the same structure as an element of the list "Move point to the filter group whose name is NAME." (interactive (list (ibuffer-read-filter-group-name "Jump to filter group: "))) - (if-let ((it (assoc name (ibuffer-current-filter-groups-with-position)))) + (if-let* ((it (assoc name (ibuffer-current-filter-groups-with-position)))) (goto-char (cdr it)) (error "No filter group with name %s" name))) @@ -868,7 +868,7 @@ The group will be added to `ibuffer-filter-group-kill-ring'." (interactive (list (ibuffer-read-filter-group-name "Kill filter group: " t))) (when (equal name "Default") (error "Can't kill default filter group")) - (if-let ((it (assoc name ibuffer-filter-groups))) + (if-let* ((it (assoc name ibuffer-filter-groups))) (progn (push (copy-tree it) ibuffer-filter-group-kill-ring) (setq ibuffer-filter-groups (ibuffer-remove-alist @@ -883,9 +883,9 @@ The group will be added to `ibuffer-filter-group-kill-ring'." "Kill the filter group at point. See also `ibuffer-kill-filter-group'." (interactive "P\np") - (if-let ((it (save-excursion - (ibuffer-forward-line 0) - (get-text-property (point) 'ibuffer-filter-group-name)))) + (if-let* ((it (save-excursion + (ibuffer-forward-line 0) + (get-text-property (point) 'ibuffer-filter-group-name)))) (ibuffer-kill-filter-group it) (funcall (if interactive-p #'call-interactively #'funcall) #'kill-line arg))) @@ -944,7 +944,7 @@ prompt for NAME, and use the current filters." (list (read-from-minibuffer "Save current filter groups as: ") ibuffer-filter-groups))) - (if-let ((it (assoc name ibuffer-saved-filter-groups))) + (if-let* ((it (assoc name ibuffer-saved-filter-groups))) (setcdr it groups) (push (cons name groups) ibuffer-saved-filter-groups)) (ibuffer-maybe-save-stuff)) @@ -1116,7 +1116,7 @@ Interactively, prompt for NAME, and use the current filters." (list (read-from-minibuffer "Save current filters as: ") ibuffer-filtering-qualifiers))) - (if-let ((it (assoc name ibuffer-saved-filters))) + (if-let* ((it (assoc name ibuffer-saved-filters))) (setcdr it filters) (push (cons name filters) ibuffer-saved-filters)) (ibuffer-maybe-save-stuff)) @@ -1296,7 +1296,7 @@ For example, for a buffer associated with file '/a/b/c.d', this matches against '/a/b/c.d'." (:description "full file name" :reader (read-from-minibuffer "Filter by full file name (regexp): ")) - (when-let ((it (with-current-buffer buf (ibuffer-buffer-file-name)))) + (when-let* ((it (with-current-buffer buf (ibuffer-buffer-file-name)))) (string-match qualifier it))) ;;;###autoload (autoload 'ibuffer-filter-by-basename "ibuf-ext") @@ -1308,7 +1308,7 @@ matches against `c.d'." (:description "file basename" :reader (read-from-minibuffer "Filter by file name, without directory part (regex): ")) - (when-let ((it (with-current-buffer buf (ibuffer-buffer-file-name)))) + (when-let* ((it (with-current-buffer buf (ibuffer-buffer-file-name)))) (string-match qualifier (file-name-nondirectory it)))) ;;;###autoload (autoload 'ibuffer-filter-by-file-extension "ibuf-ext") @@ -1321,7 +1321,7 @@ pattern. For example, for a buffer associated with file (:description "filename extension" :reader (read-from-minibuffer "Filter by filename extension without separator (regex): ")) - (when-let ((it (with-current-buffer buf (ibuffer-buffer-file-name)))) + (when-let* ((it (with-current-buffer buf (ibuffer-buffer-file-name)))) (string-match qualifier (or (file-name-extension it) "")))) ;;;###autoload (autoload 'ibuffer-filter-by-directory "ibuf-ext") @@ -1656,7 +1656,7 @@ a prefix argument reverses the meaning of that variable." "Compare BUFFER with its associated file, if any. Unlike `diff-no-select', insert output into current buffer without erasing it." - (when-let ((old (buffer-file-name buffer))) + (when-let* ((old (buffer-file-name buffer))) (defvar diff-use-labels) (let* ((new buffer) (oldtmp (diff-file-local-copy old)) @@ -1822,7 +1822,7 @@ When BUF nil, default to the buffer at current line." (interactive (list (read-regexp "Mark by file name (regexp)"))) (ibuffer-mark-on-buffer (lambda (buf) - (when-let ((name (with-current-buffer buf (ibuffer-buffer-file-name)))) + (when-let* ((name (with-current-buffer buf (ibuffer-buffer-file-name)))) ;; Match on the displayed file name (which is abbreviated). (string-match-p regexp (ibuffer--abbreviate-file-name name)))))) @@ -1843,7 +1843,7 @@ Otherwise buffers whose name matches an element of (or (memq mode ibuffer-never-search-content-mode) (cl-dolist (x ibuffer-never-search-content-name nil) - (when-let ((found (string-match x (buffer-name buf)))) + (when-let* ((found (string-match x (buffer-name buf)))) (cl-return found))))) (setq res nil)) (t diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el index 1fd94967836..f04c436f6e2 100644 --- a/lisp/ibuf-macs.el +++ b/lisp/ibuf-macs.el @@ -35,7 +35,7 @@ If TEST returns non-nil, bind `it' to the value, and evaluate TRUE-BODY. Otherwise, evaluate forms in FALSE-BODY as if in `progn'. Compare with `if'." - (declare (obsolete if-let "29.1") (indent 2)) + (declare (obsolete if-let* "29.1") (indent 2)) (let ((sym (make-symbol "ibuffer-aif-sym"))) `(let ((,sym ,test)) (if ,sym @@ -47,8 +47,8 @@ Compare with `if'." (defmacro ibuffer-awhen (test &rest body) "Evaluate BODY if TEST returns non-nil. During evaluation of body, bind `it' to the value returned by TEST." - (declare (indent 1) (obsolete when-let "29.1")) - `(when-let ((it ,test)) + (declare (indent 1) (obsolete when-let* "29.1")) + `(when-let* ((it ,test)) ,@body)) (defmacro ibuffer-save-marks (&rest body) diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index c1e7788d2e8..405fb98d4d4 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -832,7 +832,7 @@ width and the longest string in LIST." (let ((pt (save-excursion (mouse-set-point event) (point)))) - (if-let ((it (get-text-property (point) 'ibuffer-filter-group-name))) + (if-let* ((it (get-text-property (point) 'ibuffer-filter-group-name))) (ibuffer-toggle-marks it) (goto-char pt) (let ((mark (ibuffer-current-mark))) @@ -1263,7 +1263,7 @@ become unmarked. If point is on a group name, then this function operates on that group." (interactive) - (when-let ((it (get-text-property (point) 'ibuffer-filter-group-name))) + (when-let* ((it (get-text-property (point) 'ibuffer-filter-group-name))) (setq group it)) (let ((count (ibuffer-map-lines @@ -1336,7 +1336,7 @@ If point is on a group name, this function operates on that group." (when (and movement (< movement 0)) (setq arg (- arg))) (ibuffer-forward-line 0) - (if-let ((it (get-text-property (point) 'ibuffer-filter-group-name))) + (if-let* ((it (get-text-property (point) 'ibuffer-filter-group-name))) (progn (require 'ibuf-ext) (ibuffer-mark-on-buffer #'identity mark it)) @@ -1540,7 +1540,7 @@ If point is on a group name, this function operates on that group." ;; `ibuffer-inline-columns' alist and insert it ;; into our generated code. Otherwise, we just ;; generate a call to the column function. - (if-let ((it (assq sym ibuffer-inline-columns))) + (if-let* ((it (assq sym ibuffer-inline-columns))) (nth 1 it) `(or (,sym buffer mark) ""))) ;; You're not expected to understand this. Hell, I @@ -1737,7 +1737,7 @@ If point is on a group name, this function operates on that group." (cond ((zerop total) "No processes") ((= 1 total) "1 process") (t (format "%d processes" total)))))) - (if-let ((it (get-buffer-process buffer))) + (if-let* ((it (get-buffer-process buffer))) (format "(%s %s)" it (process-status it)) "")) @@ -1872,8 +1872,8 @@ the buffer object itself and the current mark symbol." (let ((result (if (buffer-live-p (ibuffer-current-buffer)) (when (or (null group) - (when-let ((it (get-text-property - (point) 'ibuffer-filter-group))) + (when-let* ((it (get-text-property + (point) 'ibuffer-filter-group))) (equal group it))) (save-excursion (funcall function diff --git a/lisp/image.el b/lisp/image.el index 3d60b485c6b..ce97eeb3ca1 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -1434,7 +1434,7 @@ Also return nil if rotation is not a multiples of 90 degrees (0, 90, Return a copy of :original-map transformed based on IMAGE's :scale, :rotation, and :flip. When IMAGE's :original-map is nil, return nil. When :rotation is not a multiple of 90, return copy of :original-map." - (when-let ((map (image-property image :original-map))) + (when-let* ((map (image-property image :original-map))) (setq map (copy-tree map t)) (let* ((size (image-size image t)) ;; The image can be scaled for many reasons (:scale, @@ -1469,7 +1469,7 @@ When :rotation is not a multiple of 90, return copy of :original-map." "Return original map for IMAGE. If IMAGE lacks :map property, return nil. When there is no transformation, return copy of :map." - (when-let ((original-map (image-property image :map))) + (when-let* ((original-map (image-property image :map))) (setq original-map (copy-tree original-map t)) (let* ((size (image-size image t)) ;; The image can be scaled for many reasons (:scale, diff --git a/lisp/image/exif.el b/lisp/image/exif.el index 2c1c4850bef..86e47da8bcc 100644 --- a/lisp/image/exif.el +++ b/lisp/image/exif.el @@ -127,10 +127,10 @@ from the return value of this function." (encode-coding-region (point-min) (point-max) buffer-file-coding-system dest)) - (when-let ((app1 (cdr (assq #xffe1 (exif--parse-jpeg))))) + (when-let* ((app1 (cdr (assq #xffe1 (exif--parse-jpeg))))) (exif--parse-exif-chunk app1)))) (save-excursion - (when-let ((app1 (cdr (assq #xffe1 (exif--parse-jpeg))))) + (when-let* ((app1 (cdr (assq #xffe1 (exif--parse-jpeg))))) (exif--parse-exif-chunk app1)))))) (defun exif-field (field data) diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el index 2e2010e06f0..10f1598912a 100644 --- a/lisp/image/image-converter.el +++ b/lisp/image/image-converter.el @@ -85,7 +85,7 @@ like \"image/gif\"." (image-converter-initialize) ;; When image-converter was customized (when (and image-converter (not image-converter-regexp)) - (when-let ((formats (image-converter--probe image-converter))) + (when-let* ((formats (image-converter--probe image-converter))) (setq image-converter-regexp (concat "\\." (regexp-opt formats) "\\'")) (setq image-converter-file-name-extensions formats))) @@ -136,8 +136,8 @@ converted image data as a string." (extra-converter (gethash type image-converter--extra-converters))) (if extra-converter (funcall extra-converter source format) - (when-let ((err (image-converter--convert - image-converter source format))) + (when-let* ((err (image-converter--convert + image-converter source format))) (error "%s" err)))) (if (listp image) ;; Return an image object that's the same as we were passed, @@ -217,8 +217,8 @@ converted image data as a string." "Find an installed image converter Emacs can use." (catch 'done (dolist (elem image-converter--converters) - (when-let ((formats (image-converter--filter-formats - (image-converter--probe (car elem))))) + (when-let* ((formats (image-converter--filter-formats + (image-converter--probe (car elem))))) (setq image-converter (car elem) image-converter-regexp (concat "\\." (regexp-opt formats) "\\'") image-converter-file-name-extensions formats) diff --git a/lisp/image/image-dired-util.el b/lisp/image/image-dired-util.el index e9048e157cd..e620c688b1b 100644 --- a/lisp/image/image-dired-util.el +++ b/lisp/image/image-dired-util.el @@ -125,7 +125,7 @@ See also `image-dired-thumbnail-storage' and (defun image-dired-file-name-at-point () "Get abbreviated file name for thumbnail or display image at point." - (when-let ((f (image-dired-original-file-name))) + (when-let* ((f (image-dired-original-file-name))) (abbreviate-file-name f))) (defun image-dired-associated-dired-buffer () diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 1928b0a2955..83745e88f09 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -663,7 +663,7 @@ only useful if `image-dired-track-movement' is nil." (image-dired--with-dired-buffer (if (not (dired-goto-file file-name)) (message "Could not find image in Dired buffer for tracking") - (when-let (window (image-dired-get-buffer-window (current-buffer))) + (when-let* ((window (image-dired-get-buffer-window (current-buffer)))) (set-window-point window (point))))))) (defun image-dired-toggle-movement-tracking () @@ -863,7 +863,7 @@ for. The default is to look for `dired-marker-char'." "Run BODY in associated Dired buffer with point on current file's line. Should be called from commands in `image-dired-thumbnail-mode'." (declare (indent defun) (debug t)) - `(if-let ((file-name (image-dired-original-file-name))) + `(if-let* ((file-name (image-dired-original-file-name))) (image-dired--with-dired-buffer (when (dired-goto-file file-name) ,@body)) @@ -871,9 +871,9 @@ Should be called from commands in `image-dired-thumbnail-mode'." (defmacro image-dired--with-thumbnail-buffer (&rest body) (declare (indent defun) (debug t)) - `(if-let ((buf (get-buffer image-dired-thumbnail-buffer))) + `(if-let* ((buf (get-buffer image-dired-thumbnail-buffer))) (with-current-buffer buf - (if-let ((win (get-buffer-window buf))) + (if-let* ((win (get-buffer-window buf))) (with-selected-window win ,@body) ,@body)) @@ -932,7 +932,7 @@ You probably want to use this together with `image-dired-track-original-file'." (interactive nil image-dired-thumbnail-mode) (image-dired--with-dired-buffer - (if-let ((window (image-dired-get-buffer-window (current-buffer)))) + (if-let* ((window (image-dired-get-buffer-window (current-buffer)))) (progn (if (not (equal (selected-frame) (window-frame window))) (select-frame-set-input-focus (window-frame window))) @@ -1090,7 +1090,7 @@ This is used by `image-dired-slideshow-start'." (defun image-dired--slideshow-step () "Step to the next image in a slideshow." - (if-let ((buf (get-buffer image-dired-thumbnail-buffer))) + (if-let* ((buf (get-buffer image-dired-thumbnail-buffer))) (with-current-buffer buf (image-dired-display-next)) (image-dired--slideshow-stop))) @@ -1272,7 +1272,7 @@ which is based on `image-mode'." (cur-win (selected-window))) (when buf (kill-buffer buf)) - (when-let ((buf (find-file-noselect file nil t))) + (when-let* ((buf (find-file-noselect file nil t))) (pop-to-buffer buf) (rename-buffer image-dired-display-image-buffer) (if (string-match (image-file-name-regexp) file) diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index 79682e921b0..399971b5ac0 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -131,14 +131,14 @@ continue running even after exiting Emacs." The returned function kills any process named PROCESS-NAME owned by the current effective user id." (lambda () - (when-let ((procs - (seq-filter (lambda (p) (let-alist p - (and (= .euid (user-uid)) - (equal .comm process-name)))) - (mapcar (lambda (pid) - (cons (cons 'pid pid) - (process-attributes pid))) - (list-system-processes))))) + (when-let* ((procs + (seq-filter (lambda (p) (let-alist p + (and (= .euid (user-uid)) + (equal .comm process-name)))) + (mapcar (lambda (pid) + (cons (cons 'pid pid) + (process-attributes pid))) + (list-system-processes))))) (dolist (proc procs) (let-alist proc (when (y-or-n-p (format "Kill \"%s\" process with PID %d?" .comm .pid)) @@ -297,7 +297,7 @@ order in which they appear.") (dolist (setter wallpaper--default-setters) (wallpaper-debug "Testing setter %s" (wallpaper-setter-name setter)) (when (and (executable-find (wallpaper-setter-command setter)) - (if-let ((pred (wallpaper-setter-predicate setter))) + (if-let* ((pred (wallpaper-setter-predicate setter))) (funcall pred) t)) (wallpaper-debug "Found setter %s" (wallpaper-setter-name setter)) @@ -305,12 +305,12 @@ order in which they appear.") (defun wallpaper--find-command () "Return the appropriate command to set the wallpaper." - (when-let ((setter (wallpaper--find-setter))) + (when-let* ((setter (wallpaper--find-setter))) (wallpaper-setter-command setter))) (defun wallpaper--find-command-args () "Return command line arguments matching `wallpaper-command'." - (when-let ((setter (wallpaper--find-setter))) + (when-let* ((setter (wallpaper--find-setter))) (wallpaper-setter-args setter))) @@ -449,23 +449,23 @@ This function is meaningful only on X and is used only there." (if (and .name (member .source '("XRandr" "XRandR 1.5" "Gdk"))) .name "0")) - (if-let ((name - (and (getenv "DISPLAY") - (or - (cdr (assq 'name - (progn - (x-open-connection (getenv "DISPLAY")) - (car (display-monitor-attributes-list - (car (last (terminal-list)))))))) - (and (executable-find "xrandr") - (with-temp-buffer - (call-process "xrandr" nil t nil) - (goto-char (point-min)) - (re-search-forward (rx bol - (group (+ (not (in " \n")))) - " connected") - nil t) - (match-string 1))))))) + (if-let* ((name + (and (getenv "DISPLAY") + (or + (cdr (assq 'name + (progn + (x-open-connection (getenv "DISPLAY")) + (car (display-monitor-attributes-list + (car (last (terminal-list)))))))) + (and (executable-find "xrandr") + (with-temp-buffer + (call-process "xrandr" nil t nil) + (goto-char (point-min)) + (re-search-forward (rx bol + (group (+ (not (in " \n")))) + " connected") + nil t) + (match-string 1))))))) ;; Prefer "0" to "default" as that works in XFCE. (if (equal name "default") "0" name) (read-string (format-prompt "Monitor name" nil))))) diff --git a/lisp/info-look.el b/lisp/info-look.el index a84026ac8b9..b3db9bfdecc 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -327,7 +327,7 @@ string of `info-lookup-alist'. If optional argument QUERY is non-nil, query for the help mode." (let* ((mode (cond (query (info-lookup-change-mode topic)) - ((when-let + ((when-let* ((info (info-lookup->mode-value topic (info-lookup-select-mode)))) (info-lookup--expand-info info)) @@ -791,7 +791,7 @@ Return nil if there is nothing appropriate in the buffer near point." (defun info-complete (topic mode) "Try to complete a help item." (barf-if-buffer-read-only) - (when-let ((info (info-lookup->mode-value topic mode))) + (when-let* ((info (info-lookup->mode-value topic mode))) (info-lookup--expand-info info)) (let ((data (info-lookup-completions-at-point topic mode))) (if (null data) @@ -1226,7 +1226,7 @@ Return nil if there is nothing appropriate in the buffer near point." :ignore-case t :regexp "[^][()`'‘’,:\" \t\n]+" :parse-rule (lambda () - (when-let ((symbol (get-text-property (point) 'custom-data))) + (when-let* ((symbol (get-text-property (point) 'custom-data))) (symbol-name symbol))) :other-modes '(emacs-lisp-mode)) diff --git a/lisp/info.el b/lisp/info.el index 6e386207afe..1ad1677c6ce 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -823,10 +823,10 @@ Select the window used, if it has been made." ;; If we just created the Info buffer, go to the directory. (Info-directory)))) - (when-let ((window (display-buffer buffer - (if other-window - '(nil (inhibit-same-window . t)) - '(display-buffer-same-window))))) + (when-let* ((window (display-buffer buffer + (if other-window + '(nil (inhibit-same-window . t)) + '(display-buffer-same-window))))) (select-window window)))) @@ -2020,7 +2020,7 @@ See `completing-read' for a description of arguments and usage." (lambda (string pred action) (complete-with-action action - (when-let ((file2 (Info-find-file file1 'noerror t))) + (when-let* ((file2 (Info-find-file file1 'noerror t))) (Info-build-node-completions file2)) string pred)) nodename predicate code)))) diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index e8cd869a571..7ede6ac8058 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -328,14 +328,14 @@ the name is not known." (let ((glyph (cadr alist))) ;; Store all the emojis for later retrieval by ;; the search feature. - (when-let ((name (emoji--name glyph))) + (when-let* ((name (emoji--name glyph))) (setf (gethash (downcase name) emoji--all-bases) glyph)) (if (display-graphic-p) ;; Remove glyphs we don't have in graphical displays. (if (let ((char (elt glyph 0))) (if emoji--font (font-has-char-p emoji--font char) - (when-let ((font (car (internal-char-font nil char)))) + (when-let* ((font (car (internal-char-font nil char)))) (setq emoji--font font)))) (setq alist (cdr alist)) ;; Remove the element. @@ -575,7 +575,7 @@ the name is not known." (setq recent (delete glyph recent)) (push glyph recent) ;; Shorten the list. - (when-let ((tail (nthcdr 30 recent))) + (when-let* ((tail (nthcdr 30 recent))) (setcdr tail nil)) (setf (multisession-value emoji--recent) recent))) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 77efcf0b590..19d1c92196f 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -658,7 +658,7 @@ and delete the network process." (defun jsonrpc--call-deferred (connection) "Call CONNECTION's deferred actions, who may again defer themselves." - (when-let ((actions (hash-table-values (jsonrpc--deferred-actions connection)))) + (when-let* ((actions (hash-table-values (jsonrpc--deferred-actions connection)))) (jsonrpc--event connection 'internal :log-text (format "re-attempting deferred requests %s" @@ -689,7 +689,7 @@ and delete the network process." (jsonrpc--continuations connection)) (jsonrpc--message "Server exited with status %s" (process-exit-status proc)) (delete-process proc) - (when-let (p (slot-value connection '-autoport-inferior)) (delete-process p)) + (when-let* ((p (slot-value connection '-autoport-inferior))) (delete-process p)) (funcall (jsonrpc--on-shutdown connection) connection))))) (defvar jsonrpc--in-process-filter nil @@ -807,7 +807,7 @@ Also cancel \"deferred actions\" if DEFERRED-SPEC. Return the full continuation (ID SUCCESS-FN ERROR-FN TIMER)" (with-slots ((conts -continuations) (defs -deferred-actions)) conn (if deferred-spec (remhash deferred-spec defs)) - (when-let ((ass (assq id conts))) + (when-let* ((ass (assq id conts))) (cl-destructuring-bind (_ _ _ _ timer) ass (when timer (cancel-timer timer))) (setf conts (delete ass conts)) diff --git a/lisp/keymap.el b/lisp/keymap.el index 7a19621441c..9b133e1ca82 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -528,7 +528,7 @@ If optional argument ACCEPT-DEFAULT is non-nil, recognize default bindings; see the description of `keymap-lookup' for more details about this." (declare (compiler-macro (lambda (form) (keymap--compile-check keys) form))) - (when-let ((map (current-local-map))) + (when-let* ((map (current-local-map))) (keymap-lookup map keys accept-default))) (defun keymap-global-lookup (keys &optional accept-default message) diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index a58be4dccf0..285095f9264 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -493,7 +493,7 @@ and send the mail again%s." (re-search-forward "^From: " nil t) (error "Please edit the From address and try again")))) ;; Bury the help buffer (if it's shown). - (when-let ((help (get-buffer "*Bug Help*"))) + (when-let* ((help (get-buffer "*Bug Help*"))) (when (get-buffer-window help) (quit-window nil (get-buffer-window help))))) @@ -549,7 +549,7 @@ Message buffer where you can explain more about the patch." (message-add-action (lambda () ;; Bury the help buffer (if it's shown). - (when-let ((help (get-buffer "*Patch Help*"))) + (when-let* ((help (get-buffer "*Patch Help*"))) (when (get-buffer-window help) (quit-window nil (get-buffer-window help))))) 'send)) diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el index eaccbff0b13..e314b3d13ae 100644 --- a/lisp/mail/ietf-drums.el +++ b/lisp/mail/ietf-drums.el @@ -275,11 +275,11 @@ a list of address strings." ((eq c ?:) (setq beg (1+ (point))) (skip-chars-forward "^;") - (when-let ((address - (condition-case nil - (ietf-drums-parse-addresses - (buffer-substring beg (point)) rawp) - (error nil)))) + (when-let* ((address + (condition-case nil + (ietf-drums-parse-addresses + (buffer-substring beg (point)) rawp) + (error nil)))) (if (listp address) (setq pairs (append address pairs)) (push address pairs))) diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el index 1233d9ace95..fe4e49d0e1b 100644 --- a/lisp/mail/mailclient.el +++ b/lisp/mail/mailclient.el @@ -143,7 +143,7 @@ The mail client is taken to be the handler of mailto URLs." (narrow-to-region (point-min) delimline) ;; We can't send multipart/* messages (i. e. with ;; attachments or the like) via this method. - (when-let ((type (mail-fetch-field "content-type"))) + (when-let* ((type (mail-fetch-field "content-type"))) (when (and (string-match "multipart" (car (mail-header-parse-content-type type))) diff --git a/lisp/mail/rfc6068.el b/lisp/mail/rfc6068.el index 06fe92f0ca7..562e2312f3f 100644 --- a/lisp/mail/rfc6068.el +++ b/lisp/mail/rfc6068.el @@ -72,7 +72,7 @@ calling this function." (when address (setq address (rfc6068-unhexify-string address)) ;; Deal with multiple 'To' recipients. - (if-let ((elem (assoc "To" headers-alist))) + (if-let* ((elem (assoc "To" headers-alist))) (setcdr elem (concat address ", " (cdr elem))) (push (cons "To" address) headers-alist))) diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el index 98ac17a99ed..c70880b0632 100644 --- a/lisp/mail/undigest.el +++ b/lisp/mail/undigest.el @@ -65,7 +65,7 @@ each undigestified message as markers.") (defun rmail-digest-parse-mixed-mime () "Like `rmail-digest-parse-mime', but for multipart/mixed messages." - (when-let ((boundary (rmail-content-type-boundary "multipart/mixed"))) + (when-let* ((boundary (rmail-content-type-boundary "multipart/mixed"))) (let ((global-sep (concat "\n--" boundary)) (digest (concat "^Content-type: multipart/digest;" "\\s-* boundary=\"?\\([^\";\n]+\\)[\";\n]")) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 804afe9cb43..44d07557f48 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -168,9 +168,9 @@ specify the property, the `completion-extra-properties' plist is consulted. Note that the keys of the `completion-extra-properties' plist are keyword symbols, not plain symbols." - (if-let (((not (eq prop 'category))) - (cat (completion--metadata-get-1 metadata 'category)) - (over (completion--category-override cat prop))) + (if-let* (((not (eq prop 'category))) + (cat (completion--metadata-get-1 metadata 'category)) + (over (completion--category-override cat prop))) (cdr over) (completion--metadata-get-1 metadata prop))) @@ -2564,7 +2564,7 @@ The candidate will still be chosen by `choose-completion' unless (defun completions--after-change (_start _end _old-len) "Update displayed *Completions* buffer after change in buffer contents." (when completion-auto-deselect - (when-let (window (get-buffer-window "*Completions*" 0)) + (when-let* ((window (get-buffer-window "*Completions*" 0))) (with-selected-window window (completions--deselect))))) @@ -3192,7 +3192,7 @@ and `RET' accepts the input typed into the minibuffer." "Return CMD if `minibuffer-visible-completions' bindings should be active." (if minibuffer-visible-completions--always-bind cmd - (when-let ((window (get-buffer-window "*Completions*" 0))) + (when-let* ((window (get-buffer-window "*Completions*" 0))) (when (and (eq (buffer-local-value 'completion-reference-buffer (window-buffer window)) (window-buffer (active-minibuffer-window))) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index e7912a2a4a7..c10bc671a88 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -689,7 +689,7 @@ websites are increasingly rare, but they do still exist." (defun browse-url-url-at-point () (or (thing-at-point 'url t) ;; assume that the user is pointing at something like gnu.org/gnu - (when-let ((f (thing-at-point 'filename t))) + (when-let* ((f (thing-at-point 'filename t))) (if (string-match-p browse-url-button-regexp f) f (concat browse-url-default-scheme "://" f))))) @@ -764,7 +764,7 @@ interactively. Turn the filename into a URL with function (defun browse-url-file-url (file) "Return the URL corresponding to FILE. Use variable `browse-url-filename-alist' to map filenames to URLs." - (when-let ((coding (browse-url--file-name-coding-system))) + (when-let* ((coding (browse-url--file-name-coding-system))) (setq file (encode-coding-string file coding))) (if (and (file-remote-p file) ;; We're applying special rules for FTP URLs for historical @@ -1361,7 +1361,7 @@ currently selected window instead." (if (equal (url-type parsed) "file") ;; It's a file; just open it. (let ((file (url-unhex-string (url-filename parsed)))) - (when-let ((coding (browse-url--file-name-coding-system))) + (when-let* ((coding (browse-url--file-name-coding-system))) (setq file (decode-coding-string file 'utf-8))) ;; The local-part of file: URLs on Windows is supposed to ;; start with an extra slash. diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 8426d04fefd..ed1fc00f541 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -1035,8 +1035,8 @@ BYTE-ARRAY must be a list of structure (c1 c2 ...), or a byte array as produced by `dbus-string-to-byte-array', and the individual bytes must be a valid UTF-8 byte sequence." (declare (advertised-calling-convention (byte-array) "30.1")) - (if-let ((bytes (seq-filter #'characterp byte-array)) - (string (apply #'unibyte-string bytes))) + (if-let* ((bytes (seq-filter #'characterp byte-array)) + (string (apply #'unibyte-string bytes))) (let (last-coding-system-used) (decode-coding-string string 'utf-8 'nocopy)) "")) @@ -2100,7 +2100,7 @@ either a method name, a signal name, or an error name." "Goto D-Bus message with the same serial number." (interactive) (when (mouse-event-p last-input-event) (mouse-set-point last-input-event)) - (when-let ((point (get-text-property (point) 'dbus-serial))) + (when-let* ((point (get-text-property (point) 'dbus-serial))) (goto-char point))) (defun dbus-monitor-handler (&rest _args) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 50e23727c61..58c2e9771ba 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1278,7 +1278,7 @@ prompt for DICTIONARY." (unless dictionary (setq dictionary dictionary-default-dictionary)) (if dictionary-display-definition-function - (if-let ((definition (dictionary-define-word word dictionary))) + (if-let* ((definition (dictionary-define-word word dictionary))) (funcall dictionary-display-definition-function word dictionary definition) (user-error "No definition found for \"%s\"" word)) ;; if called by pressing the button diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 6559c7e5eb9..7bbbeadaedd 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -79,7 +79,7 @@ if that directory doesn't exist and the DOWNLOAD XDG user directory is defined, use the latter instead." (or (and (file-exists-p eww-default-download-directory) eww-default-download-directory) - (when-let ((dir (xdg-user-dir "DOWNLOAD"))) + (when-let* ((dir (xdg-user-dir "DOWNLOAD"))) (file-name-as-directory dir)) eww-default-download-directory)) @@ -244,8 +244,8 @@ determine the renaming scheme, as follows: (defun my-eww-rename-buffer () (when (eq major-mode \\='eww-mode) - (when-let ((string (or (plist-get eww-data :title) - (plist-get eww-data :url)))) + (when-let* ((string (or (plist-get eww-data :title) + (plist-get eww-data :url)))) (format \"*%s*\" string)))) The string of `title' and `url' is always truncated to the value @@ -625,7 +625,7 @@ for the search engine used." NO-SELECT non-nil means do not make the new buffer the current buffer." (interactive "P") - (if-let ((url (or url (eww-suggested-uris)))) + (if-let* ((url (or url (eww-suggested-uris)))) (if (or (eq eww-browse-url-new-window-is-tab t) (and (eq eww-browse-url-new-window-is-tab 'tab-bar) tab-bar-mode)) @@ -2070,7 +2070,7 @@ Interactively, EVENT is the value of `last-nonmenu-event'." (push (cons name (or (plist-get input :value) "on")) values))) ((equal (plist-get input :type) "file") - (when-let ((file (plist-get input :filename))) + (when-let* ((file (plist-get input :filename))) (push (list "file" (cons "filedata" (with-temp-buffer @@ -2186,7 +2186,7 @@ If EXTERNAL is double prefix, browse in new buffer." (eww--before-browse) (plist-put eww-data :url url) (goto-char (point-min)) - (if-let ((match (text-property-search-forward 'shr-target-id target #'member))) + (if-let* ((match (text-property-search-forward 'shr-target-id target #'member))) (goto-char (prop-match-beginning match)) (goto-char (if (equal target "top") (point-min) @@ -2906,9 +2906,9 @@ these attributes is absent, the corresponding element is nil." If there is just one alternate link, return its URL. If there are multiple alternate links, prompt for one in the minibuffer with completion. If there are none, return nil." - (when-let ((alternates (eww--alternate-urls - (plist-get eww-data :dom) - (plist-get eww-data :url)))) + (when-let* ((alternates (eww--alternate-urls + (plist-get eww-data :dom) + (plist-get eww-data :url)))) (let ((url-max-width (seq-max (mapcar #'string-pixel-width (mapcar #'car alternates)))) @@ -2952,7 +2952,7 @@ Alternate links are references that an HTML page may include to point to its alternative representations, such as a translated version or an RSS feed." (interactive nil eww-mode) - (if-let ((url (eww-read-alternate-url))) + (if-let* ((url (eww-read-alternate-url))) (progn (kill-new url) (message "Copied %s to kill ring" url)) diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el index 7c72c67f187..ac36bfe05ce 100644 --- a/lisp/net/goto-addr.el +++ b/lisp/net/goto-addr.el @@ -241,7 +241,7 @@ using `browse-url-secondary-browser-function' instead." (line-beginning-position))) (not (looking-at goto-address-url-regexp)))) (compose-mail address) - (if-let ((url (browse-url-url-at-point))) + (if-let* ((url (browse-url-url-at-point))) (browse-url-button-open-url url) (error "No e-mail address or URL found")))))) diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 5ff75deb4e6..3e847c758c2 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -856,10 +856,10 @@ If NO-DECODE is non-nil, don't decode STRING." ;; ~/.mailcap file, then we filter out the system entries ;; and see whether we have anything left. (when mailcap-prefer-mailcap-viewers - (when-let ((user-entries - (seq-filter (lambda (elem) - (eq (cdr (assq 'source elem)) 'user)) - passed))) + (when-let* ((user-entries + (seq-filter (lambda (elem) + (eq (cdr (assq 'source elem)) 'user)) + passed))) (setq passed user-entries))) (setq viewer (car passed)))) (when (and (stringp (cdr (assq 'viewer viewer))) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 2a713de83c2..c41e2ec153f 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -576,11 +576,11 @@ If ARG is non-nil, instead prompt for connection parameters." 'certfp) (rcirc-get-server-cert (car c)))) contact) - (when-let (((not password)) - (auth (auth-source-search :host server - :user user-name - :port port)) - (pwd (auth-info-password (car auth)))) + (when-let* (((not password)) + (auth (auth-source-search :host server + :user user-name + :port port)) + (pwd (auth-info-password (car auth)))) (setq password pwd)) (when server (let (connected) @@ -709,7 +709,7 @@ that are joined after authentication." process) ;; Ensure any previous process is killed - (when-let ((old-process (get-process (or server-alias server)))) + (when-let* ((old-process (get-process (or server-alias server)))) (set-process-sentinel old-process #'ignore) (delete-process process)) @@ -1158,7 +1158,7 @@ element in PARTS is a list, append it to PARTS." (let ((last (car (last parts)))) (when (listp last) (setf parts (append (butlast parts) last)))) - (when-let (message (memq : parts)) + (when-let* ((message (memq : parts))) (cl-check-type (cadr message) string) (setf (cadr message) (concat ":" (cadr message)) parts (remq : parts))) @@ -1630,7 +1630,7 @@ with it." rcirc-log-directory) (rcirc-log-write)) (rcirc-clean-up-buffer "Killed buffer") - (when-let ((process (get-buffer-process (current-buffer)))) + (when-let* ((process (get-buffer-process (current-buffer)))) (delete-process process)) (when (and rcirc-buffer-alist ;; it's a server buffer rcirc-kill-channel-buffers) @@ -2041,7 +2041,7 @@ connection." ;; do not ignore if we sent the message (not (string= sender (rcirc-nick process)))) (let* ((buffer (rcirc-target-buffer process sender response target text)) - (time (if-let ((time (rcirc-get-tag "time"))) + (time (if-let* ((time (rcirc-get-tag "time"))) (parse-iso8601-time-string time t) (current-time))) (inhibit-read-only t)) @@ -2178,7 +2178,7 @@ connection." (defun rcirc-when () "Show the time of reception of the message at point." (interactive) - (if-let (time (get-text-property (point) 'rcirc-time)) + (if-let* ((time (get-text-property (point) 'rcirc-time))) (message (format-time-string "%c" time)) (message "No time information at point."))) @@ -3133,13 +3133,13 @@ indicated by RESPONSE)." (or #x03 #x0f eol)) nil t) (let (foreground background) - (when-let ((fg-raw (match-string 1)) - (fg (string-to-number fg-raw)) - ((<= 0 fg (1- (length rcirc-color-codes))))) + (when-let* ((fg-raw (match-string 1)) + (fg (string-to-number fg-raw)) + ((<= 0 fg (1- (length rcirc-color-codes))))) (setq foreground (aref rcirc-color-codes fg))) - (when-let ((bg-raw (match-string 2)) - (bg (string-to-number bg-raw)) - ((<= 0 bg (1- (length rcirc-color-codes))))) + (when-let* ((bg-raw (match-string 2)) + (bg (string-to-number bg-raw)) + ((<= 0 bg (1- (length rcirc-color-codes))))) (setq background (aref rcirc-color-codes bg))) (rcirc-add-face (match-beginning 0) (match-end 0) `(face (,@(and foreground (list :foreground foreground)) @@ -3475,7 +3475,7 @@ PROCESS is the process object for the current connection." (dolist (target channels) (rcirc-print process sender "NICK" target new-nick)) ;; update chat buffer, if it exists - (when-let ((chat-buffer (rcirc-get-buffer process old-nick))) + (when-let* ((chat-buffer (rcirc-get-buffer process old-nick))) (with-current-buffer chat-buffer (rcirc-print process sender "NICK" old-nick new-nick) (setq rcirc-target new-nick) @@ -3799,8 +3799,8 @@ is the process object for the current connection." "Handle a empty tag message from SENDER. PROCESS is the process object for the current connection." (dolist (tag rcirc-message-tags) - (when-let ((handler (intern-soft (concat "rcirc-tag-handler-" (car tag)))) - ((fboundp handler))) + (when-let* ((handler (intern-soft (concat "rcirc-tag-handler-" (car tag)))) + ((fboundp handler))) (funcall handler process sender (cdr tag))))) (defun rcirc-handler-BATCH (process _sender args _text) @@ -3837,7 +3837,7 @@ object for the current connection." (args (nth 3 message)) (text (nth 4 message)) (rcirc-message-tags (nth 5 message))) - (if-let (handler (intern-soft (concat "rcirc-handler-" cmd))) + (if-let* ((handler (intern-soft (concat "rcirc-handler-" cmd)))) (funcall handler process sender args text) (rcirc-handler-generic process cmd sender args text)))))))) (setq rcirc-batch-attributes diff --git a/lisp/net/shr.el b/lisp/net/shr.el index f1062acf7e4..4869969f463 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -751,7 +751,7 @@ full-buffer size." (funcall function dom)) (t (shr-generic dom))) - (when-let ((id (dom-attr dom 'id))) + (when-let* ((id (dom-attr dom 'id))) (push (cons id (set-marker (make-marker) start)) shr--link-targets)) ;; If style is set, then this node has set the color. (when style @@ -940,7 +940,7 @@ When `shr-fill-text' is nil, only indent." (defun shr-adaptive-fill-function () "Return a fill prefix for the paragraph at point." - (when-let ((prefix (get-text-property (point) 'shr-prefix-length))) + (when-let* ((prefix (get-text-property (point) 'shr-prefix-length))) (buffer-substring (point) (+ (point) prefix)))) (defun shr-parse-base (url) @@ -1615,7 +1615,7 @@ Based on https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-infore (defun shr-correct-dom-case (dom) "Correct the case for SVG segments." (dolist (attr (dom-attributes dom)) - (when-let ((rep (assoc-default (car attr) shr-correct-attribute-case))) + (when-let* ((rep (assoc-default (car attr) shr-correct-attribute-case))) (setcar attr rep))) (dolist (child (dom-children dom)) (when (consp child) @@ -1756,13 +1756,13 @@ Based on https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-infore (funcall shr-url-transformer (shr-expand-url url)) title) ;; Check whether the URL is suspicious. - (when-let ((warning (or (textsec-suspicious-p - (shr-expand-url url) 'url) - (textsec-suspicious-p - (cons (shr-expand-url url) - (buffer-substring (or shr-start start) - (point))) - 'link)))) + (when-let* ((warning (or (textsec-suspicious-p + (shr-expand-url url) 'url) + (textsec-suspicious-p + (cons (shr-expand-url url) + (buffer-substring (or shr-start start) + (point))) + 'link)))) (add-text-properties (or shr-start start) (point) (list 'face '(shr-link textsec-suspicious))) (insert (propertize "⚠️" 'help-echo warning)))))) diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el index a6ba556e7ae..68426ff91ec 100644 --- a/lisp/net/sieve.el +++ b/lisp/net/sieve.el @@ -152,7 +152,7 @@ require \"fileinto\"; (interactive) (sieve-manage-close sieve-manage-buffer) (kill-buffer sieve-manage-buffer) - (when-let ((buffer (get-buffer sieve-buffer))) + (when-let* ((buffer (get-buffer sieve-buffer))) (kill-buffer buffer))) (defun sieve-bury-buffer () diff --git a/lisp/outline.el b/lisp/outline.el index 4d72b17e623..3a021a9d1e6 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -1856,8 +1856,8 @@ With a prefix argument, show headings up to that LEVEL." (save-excursion (goto-char (point-min)) (while (not (or (eq top-level 1) (eobp))) - (when-let ((level (and (outline-on-heading-p t) - (funcall outline-level)))) + (when-let* ((level (and (outline-on-heading-p t) + (funcall outline-level)))) (when (< level (or top-level most-positive-fixnum)) (setq top-level (max level 1)))) (outline-next-heading))) diff --git a/lisp/pcmpl-git.el b/lisp/pcmpl-git.el index 95b6859dd23..c282e3eb4a8 100644 --- a/lisp/pcmpl-git.el +++ b/lisp/pcmpl-git.el @@ -39,10 +39,10 @@ (defun pcmpl-git--tracked-file-predicate (&rest args) "Return a predicate function determining the Git status of a file. Files listed by `git ls-files ARGS' satisfy the predicate." - (when-let ((files (mapcar #'expand-file-name - (ignore-errors - (apply #'process-lines - vc-git-program "ls-files" args))))) + (when-let* ((files (mapcar #'expand-file-name + (ignore-errors + (apply #'process-lines + vc-git-program "ls-files" args))))) (lambda (file) (setq file (expand-file-name file)) (if (string-suffix-p "/" file) diff --git a/lisp/proced.el b/lisp/proced.el index f99a6f74909..da9212f6802 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -955,11 +955,11 @@ Proced buffers." "Auto-update Proced buffers using `run-at-time'. If there are no proced buffers, cancel the timer." - (if-let (buffers (match-buffers '(derived-mode . proced-mode))) + (if-let* ((buffers (match-buffers '(derived-mode . proced-mode)))) (dolist (buf buffers) - (when-let ((flag (buffer-local-value 'proced-auto-update-flag buf)) - ((or (not (eq flag 'visible)) - (get-buffer-window buf 'visible)))) + (when-let* ((flag (buffer-local-value 'proced-auto-update-flag buf)) + ((or (not (eq flag 'visible)) + (get-buffer-window buf 'visible)))) (with-current-buffer buf (proced-update t t)))) (cancel-timer proced-auto-update-timer) diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 3bcfc213fc6..a2cb65f2c71 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -380,15 +380,15 @@ URL-REGEXP against the VCS URL and returns the value to be set as Test each configuration in `bug-reference-setup-from-vc-alist' and `bug-reference--setup-from-vc-alist' and apply it if applicable." - (when-let ((file-or-dir (or buffer-file-name - ;; Catches modes such as vc-dir and Magit. - default-directory)) - (backend (vc-responsible-backend file-or-dir t)) - (url (seq-some (lambda (remote) - (ignore-errors - (vc-call-backend backend 'repository-url - file-or-dir remote))) - '("upstream" nil)))) + (when-let* ((file-or-dir (or buffer-file-name + ;; Catches modes such as vc-dir and Magit. + default-directory)) + (backend (vc-responsible-backend file-or-dir t)) + (url (seq-some (lambda (remote) + (ignore-errors + (vc-call-backend backend 'repository-url + file-or-dir remote))) + '("upstream" nil)))) (seq-some (lambda (config) (apply #'bug-reference-maybe-setup-from-vc url config)) (append bug-reference-setup-from-vc-alist diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index f68a6dc108d..4fb61c4ba13 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -128,8 +128,8 @@ ARG is passed to `fill-paragraph'." (looking-at "//")) ;; In rust, NODE will be the body of a comment, and the ;; parent will be the whole comment. - (if-let ((start (treesit-node-start - (treesit-node-parent node)))) + (if-let* ((start (treesit-node-start + (treesit-node-parent node)))) (save-excursion (goto-char start) (looking-at "//")))) diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 0c2da768833..1b041a0192b 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -287,7 +287,7 @@ one step according to the great-grand-parent indent level. The reason there is a difference between grand-parent and great-grand-parent here is that the node containing the newline is actually the parent of point at the moment of indentation." - (when-let ((node (treesit-node-on (point) (point)))) + (when-let* ((node (treesit-node-on (point) (point)))) (if (string-equal "translation_unit" (treesit-node-type (treesit-node-parent @@ -315,12 +315,12 @@ doesn't have a child. PARENT is NODE's parent, BOL is the beginning of non-whitespace characters of the current line." - (when-let ((prev-sibling - (or (treesit-node-prev-sibling node t) - (treesit-node-prev-sibling - (treesit-node-first-child-for-pos parent bol) t) - (treesit-node-child parent -1 t))) - (continue t)) + (when-let* ((prev-sibling + (or (treesit-node-prev-sibling node t) + (treesit-node-prev-sibling + (treesit-node-first-child-for-pos parent bol) t) + (treesit-node-child parent -1 t))) + (continue t)) (save-excursion (while (and prev-sibling continue) (pcase (treesit-node-type prev-sibling) @@ -1103,8 +1103,8 @@ is required, not just the declaration part for DEFUN." `treesit-defun-type-regexp' defines what constructs to indent." (interactive "*") - (when-let ((orig-point (point-marker)) - (range (c-ts-mode--emacs-defun-at-point t))) + (when-let* ((orig-point (point-marker)) + (range (c-ts-mode--emacs-defun-at-point t))) (indent-region (car range) (cdr range)) (goto-char orig-point))) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 03e6ee4021b..2b9d355795e 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1405,12 +1405,12 @@ POS and RES.") 2))) ;; Remove matches like /bin/sh and do other file name transforms. (save-match-data - (when-let ((file-name - (and (consp file) - (not (bufferp (car file))) - (if (cdr file) - (expand-file-name (car file) (cdr file)) - (car file))))) + (when-let* ((file-name + (and (consp file) + (not (bufferp (car file))) + (if (cdr file) + (expand-file-name (car file) (cdr file)) + (car file))))) (cl-loop for (regexp replacement) in compilation-transform-file-match-alist when (string-match regexp file-name) @@ -3231,7 +3231,7 @@ we try to avoid if possible." (with-current-buffer (marker-buffer marker) (save-excursion (goto-char (marker-position marker)) - (when-let ((prev (compilation--previous-directory (point)))) + (when-let* ((prev (compilation--previous-directory (point)))) (goto-char prev)) (setq dirs (cdr (or (get-text-property (1- (point)) 'compilation-directory) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 0a1f9ee4481..e5c27de81fc 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -710,14 +710,14 @@ compile time if an undeclared LSP interface is used.")) (cl-destructuring-bind (&key types required-keys optional-keys &allow-other-keys) (eglot--interface interface-name) - (when-let ((missing (and enforce-required - (cl-set-difference required-keys - (eglot--plist-keys object))))) + (when-let* ((missing (and enforce-required + (cl-set-difference required-keys + (eglot--plist-keys object))))) (eglot--error "A `%s' must have %s" interface-name missing)) - (when-let ((excess (and disallow-non-standard - (cl-set-difference - (eglot--plist-keys object) - (append required-keys optional-keys))))) + (when-let* ((excess (and disallow-non-standard + (cl-set-difference + (eglot--plist-keys object) + (append required-keys optional-keys))))) (eglot--error "A `%s' mustn't have %s" interface-name excess)) (when check-types (cl-loop @@ -1914,7 +1914,7 @@ and just return it. PROMPT shouldn't end with a question mark." (cond ((null servers) (eglot--error "No servers!")) ((or (cdr servers) (not dont-if-just-the-one)) - (let* ((default (when-let ((current (eglot-current-server))) + (let* ((default (when-let* ((current (eglot-current-server))) (funcall name current))) (read (completing-read (if default @@ -2164,7 +2164,7 @@ If it is activated, also signal textDocument/didOpen." (with-no-warnings (require 'package) (unless package-archive-contents (package-refresh-contents)) - (when-let ((existing (cadr (assoc 'eglot package-alist)))) + (when-let* ((existing (cadr (assoc 'eglot package-alist)))) (package-delete existing t)) (package-install (cadr (assoc 'eglot package-archive-contents))))) @@ -2457,10 +2457,10 @@ expensive cached value of `file-truename'.") (current-buffer) beg end (eglot--diag-type severity) message `((eglot-lsp-diag . ,diag-spec)) - (when-let ((faces - (cl-loop for tag across tags - when (alist-get tag eglot--tag-faces) - collect it))) + (when-let* ((faces + (cl-loop for tag across tags + when (alist-get tag eglot--tag-faces) + collect it))) `((face . ,faces)))))) into diags finally (cond ((and @@ -2619,12 +2619,12 @@ buffer." (append (eglot--TextDocumentPositionParams) `(:context - ,(if-let (trigger (and (characterp eglot--last-inserted-char) - (cl-find eglot--last-inserted-char - (eglot-server-capable :completionProvider - :triggerCharacters) - :key (lambda (str) (aref str 0)) - :test #'char-equal))) + ,(if-let* ((trigger (and (characterp eglot--last-inserted-char) + (cl-find eglot--last-inserted-char + (eglot-server-capable :completionProvider + :triggerCharacters) + :key (lambda (str) (aref str 0)) + :test #'char-equal)))) `(:triggerKind 2 :triggerCharacter ,trigger) `(:triggerKind 1))))) (defvar-local eglot--recent-changes nil @@ -3167,7 +3167,7 @@ for which LSP on-type-formatting should be requested." (defun eglot-completion-at-point () "Eglot's `completion-at-point' function." ;; Commit logs for this function help understand what's going on. - (when-let (completion-capability (eglot-server-capable :completionProvider)) + (when-let* ((completion-capability (eglot-server-capable :completionProvider))) (let* ((server (eglot--current-server-or-lose)) (bounds (or (bounds-of-thing-at-point 'symbol) (cons (point) (point)))) @@ -3296,7 +3296,7 @@ for which LSP on-type-formatting should be requested." (_ (intern (downcase kind)))))) :company-deprecated (lambda (proxy) - (when-let ((lsp-item (get-text-property 0 'eglot--lsp-item proxy))) + (when-let* ((lsp-item (get-text-property 0 'eglot--lsp-item proxy))) (or (seq-contains-p (plist-get lsp-item :tags) 1) (eq t (plist-get lsp-item :deprecated))))) @@ -3390,7 +3390,7 @@ for which LSP on-type-formatting should be requested." (with-temp-buffer (insert siglabel) ;; Add documentation, indented so we can distinguish multiple signatures - (when-let (doc (and (not briefp) sigdoc (eglot--format-markup sigdoc))) + (when-let* ((doc (and (not briefp) sigdoc (eglot--format-markup sigdoc)))) (goto-char (point-max)) (insert "\n" (replace-regexp-in-string "^" " " doc))) ;; Try to highlight function name only @@ -3850,12 +3850,12 @@ at point. With prefix argument, prompt for ACTION-KIND." (handle-event `(,desc 'deleted ,file)) (handle-event `(,desc 'created ,file1)))))) (watch-dir (dir) - (when-let ((probe - (and (file-readable-p dir) - (or (gethash dir (eglot--file-watches server)) - (puthash dir (list (file-notify-add-watch - dir '(change) #'handle-event)) - (eglot--file-watches server)))))) + (when-let* ((probe + (and (file-readable-p dir) + (or (gethash dir (eglot--file-watches server)) + (puthash dir (list (file-notify-add-watch + dir '(change) #'handle-event)) + (eglot--file-watches server)))))) (push id (cdr probe))))) (unwind-protect (progn diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 2f931daedc7..62f1045a512 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -246,7 +246,7 @@ Use `emacs-lisp-byte-compile-and-load' in combination with `native-comp-jit-compilation' set to t to achieve asynchronous native compilation of the current buffer's file." (interactive nil emacs-lisp-mode) - (when-let ((byte-file (emacs-lisp-native-compile))) + (when-let* ((byte-file (emacs-lisp-native-compile))) (load (file-name-sans-extension byte-file)))) (defun emacs-lisp-macroexpand () @@ -1851,7 +1851,7 @@ Also see `elisp-eldoc-var-docstring-with-value'." Intended for `eldoc-documentation-functions' (which see). Compared to `elisp-eldoc-var-docstring', this also includes the current variable value and a bigger chunk of the docstring." - (when-let ((cs (elisp--current-symbol))) + (when-let* ((cs (elisp--current-symbol))) (when (and (boundp cs) ;; nil and t are boundp! (not (null cs)) diff --git a/lisp/progmodes/erts-mode.el b/lisp/progmodes/erts-mode.el index 0cb77b30a75..41904e8bd0d 100644 --- a/lisp/progmodes/erts-mode.el +++ b/lisp/progmodes/erts-mode.el @@ -209,8 +209,8 @@ expected results and the actual results in a separate buffer." (re-search-backward "^=-=\n" nil t) (let ((potential-start (match-end 0))) ;; See if we're in a two-clause ("before" and "after") test or not. - (if-let ((start (and (save-excursion (re-search-backward "^=-=\n" nil t)) - (match-end 0)))) + (if-let* ((start (and (save-excursion (re-search-backward "^=-=\n" nil t)) + (match-end 0)))) (let ((end (save-excursion (re-search-backward "^=-=-=\n" nil t)))) (if (or (not end) (> start end)) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 9a6b62ca254..3dee1a58e44 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -845,7 +845,7 @@ Return to original margin width if ORIG-WIDTH is non-nil." (widen) (dolist (o (overlays-in (point-min) (point-max))) (when (overlay-get o 'flymake--eol-overlay) - (if-let ((src-ovs (overlay-get o 'flymake-eol-source-overlays))) + (if-let* ((src-ovs (overlay-get o 'flymake-eol-source-overlays))) (overlay-put o 'before-string (flymake--eol-overlay-summary src-ovs)) (delete-overlay o)))))) @@ -1533,7 +1533,7 @@ START and STOP and LEN are as in `after-change-functions'." (defun flymake-eldoc-function (report-doc &rest _) "Document diagnostics at point. Intended for `eldoc-documentation-functions' (which see)." - (when-let ((diags (flymake-diagnostics (point)))) + (when-let* ((diags (flymake-diagnostics (point)))) (funcall report-doc (mapconcat #'flymake-diagnostic-text diags "\n") :echo (mapconcat #'flymake-diagnostic-oneliner diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 6a9735fbc25..b60e21ff0ae 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -3242,7 +3242,7 @@ See `def-gdb-auto-update-handler'." ;; Add the breakpoint/header row to the table. (gdb-breakpoints--add-breakpoint-row table breakpoint) ;; If this breakpoint has multiple locations, add them as well. - (when-let ((locations (gdb-mi--field breakpoint 'locations))) + (when-let* ((locations (gdb-mi--field breakpoint 'locations))) (dolist (loc locations) (add-to-list 'gdb-breakpoints-list (cons (gdb-mi--field loc 'number) loc)) @@ -4830,7 +4830,7 @@ overlay arrow in source buffer." (when frame (setq gdb-selected-frame (gdb-mi--field frame 'func)) (setq gdb-selected-file - (when-let ((full (gdb-mi--field frame 'fullname))) + (when-let* ((full (gdb-mi--field frame 'fullname))) (file-local-name full))) (setq gdb-frame-number (gdb-mi--field frame 'level)) (setq gdb-frame-address (gdb-mi--field frame 'addr)) diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 6fa8049e5e7..86e74ad58a8 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -363,7 +363,7 @@ Methods are prefixed with the receiver name, unless SKIP-PREFIX is t." The added docstring is prefilled with the defun's name. If the comment already exists, jump to it." (interactive) - (when-let ((defun-node (treesit-defun-at-point))) + (when-let* ((defun-node (treesit-defun-at-point))) (goto-char (treesit-node-start defun-node)) (if (go-ts-mode--comment-on-previous-line-p) ;; go to top comment line @@ -375,9 +375,9 @@ comment already exists, jump to it." (defun go-ts-mode--comment-on-previous-line-p () "Return t if the previous line is a comment." - (when-let ((point (- (pos-bol) 1)) - ((> point 0)) - (node (treesit-node-at point))) + (when-let* ((point (- (pos-bol) 1)) + ((> point 0)) + (node (treesit-node-at point))) (and ;; check point is actually inside the found node ;; treesit-node-at can return nodes after point @@ -432,10 +432,10 @@ specifying build tags." "Return a regular expression for the tests at point. If region is active, the regexp will include all the functions under the region." - (if-let ((range (if (region-active-p) - (list (region-beginning) (region-end)) - (list (point) (point)))) - (funcs (apply #'go-ts-mode--get-functions-in-range range))) + (if-let* ((range (if (region-active-p) + (list (region-beginning) (region-end)) + (list (point) (point)))) + (funcs (apply #'go-ts-mode--get-functions-in-range range))) (string-join funcs "|") (error "No test function found"))) @@ -450,7 +450,7 @@ be run." (defun go-ts-mode-test-this-file () "Run all the unit tests in the current file." (interactive) - (if-let ((defuns (go-ts-mode--get-functions-in-range (point-min) (point-max)))) + (if-let* ((defuns (go-ts-mode--get-functions-in-range (point-min) (point-max)))) (go-ts-mode--compile-test (string-join defuns "|")) (error "No test functions found in the current file"))) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index b453ac60ed2..ed8d6e9e0d9 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -1357,7 +1357,7 @@ command before it's run." regexp files nil - (when-let ((ignores (grep-find-ignored-files dir))) + (when-let* ((ignores (grep-find-ignored-files dir))) (concat " --exclude=" (mapconcat (lambda (ignore) @@ -1474,7 +1474,7 @@ to indicate whether the grep should be case sensitive or not." "Compute the command for \\[rgrep] to use by default." (require 'find-dired) ; for `find-name-arg' (let ((ignored-files-arg - (when-let ((ignored-files (grep-find-ignored-files dir))) + (when-let* ((ignored-files (grep-find-ignored-files dir))) (concat (shell-quote-argument "(" grep-quoting-style) ;; we should use shell-quote-argument here " -name " @@ -1498,7 +1498,7 @@ to indicate whether the grep should be case sensitive or not." (concat " " (shell-quote-argument "!" grep-quoting-style) " " ignored-files-arg))) dir (concat - (when-let ((ignored-dirs (rgrep-find-ignored-directories dir))) + (when-let* ((ignored-dirs (rgrep-find-ignored-directories dir))) (concat "-type d " (shell-quote-argument "(" grep-quoting-style) ;; we should use shell-quote-argument here @@ -1578,8 +1578,8 @@ command before it's run." (defun grep-file-at-point (point) "Return the name of the file at POINT a `grep-mode' buffer. The returned file name is relative." - (when-let ((msg (get-text-property point 'compilation-message)) - (loc (compilation--message->loc msg))) + (when-let* ((msg (get-text-property point 'compilation-message)) + (loc (compilation--message->loc msg))) (caar (compilation--loc->file-struct loc)))) ;;;###autoload diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 13d5d7f9451..3c32fac3f42 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -963,8 +963,8 @@ changed by, or (parse-state) if line starts in a quoted string." (save-excursion (skip-chars-backward " \t\n") (beginning-of-line) - (when-let ((comm (and (looking-at "^\\.$") - (nth 8 (syntax-ppss))))) + (when-let* ((comm (and (looking-at "^\\.$") + (nth 8 (syntax-ppss))))) (goto-char comm) (beginning-of-line) (looking-at perl--format-regexp)))) diff --git a/lisp/progmodes/php-ts-mode.el b/lisp/progmodes/php-ts-mode.el index 6e6d421110c..e1976144a94 100644 --- a/lisp/progmodes/php-ts-mode.el +++ b/lisp/progmodes/php-ts-mode.el @@ -591,12 +591,12 @@ doesn't have a child. PARENT is NODE's parent, BOL is the beginning of non-whitespace characters of the current line." - (when-let ((prev-sibling - (or (treesit-node-prev-sibling node t) - (treesit-node-prev-sibling - (treesit-node-first-child-for-pos parent bol) t) - (treesit-node-child parent -1 t))) - (continue t)) + (when-let* ((prev-sibling + (or (treesit-node-prev-sibling node t) + (treesit-node-prev-sibling + (treesit-node-first-child-for-pos parent bol) t) + (treesit-node-child parent -1 t))) + (continue t)) (save-excursion (while (and prev-sibling continue) (goto-char (treesit-node-start prev-sibling)) @@ -1224,8 +1224,8 @@ Return nil if the NODE has no field “name” or if NODE is not a defun node." "Indent the current top-level declaration syntactically. `treesit-defun-type-regexp' defines what constructs to indent." (interactive "*") - (when-let ((orig-point (point-marker)) - (node (treesit-defun-at-point))) + (when-let* ((orig-point (point-marker)) + (node (treesit-defun-at-point))) (indent-region (treesit-node-start node) (treesit-node-end node)) (goto-char orig-point))) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 5062021f8a6..4a8afb80b25 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -926,7 +926,7 @@ DIRS must contain directory names." (generic-cmd (lookup-key project-prefix-map key)) (switch-to-buffer-obey-display-actions t) (display-buffer-overriding-action (unless place-cmd action))) - (if-let ((cmd (or place-cmd generic-cmd))) + (if-let* ((cmd (or place-cmd generic-cmd))) (call-interactively cmd) (user-error "%s is undefined" (key-description key))))) @@ -1075,8 +1075,8 @@ relative to PROJECT instead. This supports using a relative file name from the current buffer when switching projects with `project-switch-project' and then using a command like `project-find-file'." - (if-let (filename-proj (and project-current-directory-override - (project-current nil default-directory))) + (if-let* ((filename-proj (and project-current-directory-override + (project-current nil default-directory)))) ;; file-name-concat requires Emacs 28+ (concat (file-name-as-directory (project-root project)) (file-relative-name filename (project-root filename-proj))) @@ -1167,7 +1167,7 @@ This has the effect of sharing more history between projects." :version "30.1") (defun project--transplant-file-name (filename project) - (when-let ((old-root (get-text-property 0 'project filename))) + (when-let* ((old-root (get-text-property 0 'project filename))) (expand-file-name (file-relative-name filename old-root) (project-root project)))) @@ -1443,7 +1443,7 @@ If you exit the `query-replace', you can later continue the (defun project-prefixed-buffer-name (mode) (concat "*" - (if-let ((proj (project-current nil))) + (if-let* ((proj (project-current nil))) (project-name proj) (file-name-nondirectory (directory-file-name default-directory))) @@ -1870,7 +1870,7 @@ result in `project-list-file'. Announce the project's removal from the list using REPORT-MESSAGE, which is a format string passed to `message' as its first argument." (project--ensure-read-project-list) - (when-let ((ent (assoc (abbreviate-file-name project-root) project--list))) + (when-let* ((ent (assoc (abbreviate-file-name project-root) project--list))) (setq project--list (delq ent project--list)) (message report-message project-root) (project--write-project-list))) @@ -1931,8 +1931,8 @@ When PROMPT is non-nil, use it as the prompt string." (dolist (dir (reverse (project-known-project-roots))) ;; We filter out directories that no longer map to a project, ;; since they don't have a clean project-name. - (when-let ((proj (project--find-in-directory dir)) - (name (project-name proj))) + (when-let* ((proj (project--find-in-directory dir)) + (name (project-name proj))) (push name project--name-history) (push (cons name proj) ret))) (reverse ret))) @@ -2029,10 +2029,10 @@ projects." (dolist (project (mapcar #'car project--list)) (puthash project t known)) (dolist (subdir dirs) - (when-let (((file-directory-p subdir)) - (project (project--find-in-directory subdir)) - (project-root (project-root project)) - ((not (gethash project-root known)))) + (when-let* (((file-directory-p subdir)) + (project (project--find-in-directory subdir)) + (project-root (project-root project)) + ((not (gethash project-root known)))) (project-remember-project project t) (puthash project-root t known) (message "Found %s..." project-root) @@ -2180,8 +2180,8 @@ Otherwise, use the face `help-key-binding' in the prompt." (let ((temp-map (make-sparse-keymap))) (set-keymap-parent temp-map project-prefix-map) (dolist (row commands-menu temp-map) - (when-let ((cmd (nth 0 row)) - (keychar (nth 2 row))) + (when-let* ((cmd (nth 0 row)) + (keychar (nth 2 row))) (define-key temp-map (vector keychar) cmd))))) command choice) @@ -2238,7 +2238,7 @@ If you set `uniquify-dirname-transform' to this function, slash-separated components from `project-name' will be appended to the buffer's directory name when buffers from two different projects would otherwise have the same name." - (if-let (proj (project-current nil dirname)) + (if-let* ((proj (project-current nil dirname))) (let ((root (project-root proj))) (expand-file-name (file-name-concat @@ -2273,7 +2273,7 @@ is part of the default mode line beginning with Emacs 30." (defun project-mode-line-format () "Compose the project mode-line." - (when-let ((project (project-current))) + (when-let* ((project (project-current))) ;; Preserve the global value of 'last-coding-system-used' ;; that 'write-region' needs to set for 'basic-save-buffer', ;; but updating the mode line might occur at the same time diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 6d57517cd25..283a545bfb4 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -808,7 +808,7 @@ sign in chained assignment." (3 'font-lock-operator-face) (,(python-rx symbol-name) (progn - (when-let ((type-start (match-beginning 2))) + (when-let* ((type-start (match-beginning 2))) (goto-char type-start)) (match-end 0)) nil @@ -1153,7 +1153,7 @@ fontified." ((or "identifier" "none") (setq font-node child)) ("attribute" - (when-let ((type-node (treesit-node-child-by-field-name child "attribute"))) + (when-let* ((type-node (treesit-node-child-by-field-name child "attribute"))) (setq font-node type-node))) ((or "binary_operator" "subscript") (python--treesit-fontify-union-types child override start end type-regex))) @@ -3264,8 +3264,8 @@ name respectively the current project name." (pcase dedicated ('nil python-shell-buffer-name) ('project - (if-let ((proj (and (featurep 'project) - (project-current)))) + (if-let* ((proj (and (featurep 'project) + (project-current)))) (format "%s[%s]" python-shell-buffer-name (file-name-nondirectory (directory-file-name (project-root proj)))) @@ -3788,7 +3788,7 @@ non-nil, means also display the Python shell buffer." dedicated)))) '(buffer project nil)) (user-error "No Python shell")) - (when-let ((proc (get-buffer-process (current-buffer)))) + (when-let* ((proc (get-buffer-process (current-buffer)))) (kill-process proc) (while (accept-process-output proc))) (python-shell-make-comint (python-shell-calculate-command) @@ -4845,9 +4845,9 @@ using that one instead of current buffer's process." ((stringp (car cands)) (if no-delims ;; Reduce completion candidates due to long prefix. - (if-let ((Lp (length prefix)) - ((string-match "\\(\\sw\\|\\s_\\)+\\'" prefix)) - (L (match-beginning 0))) + (if-let* ((Lp (length prefix)) + ((string-match "\\(\\sw\\|\\s_\\)+\\'" prefix)) + (L (match-beginning 0))) ;; If extra-offset is not zero: ;; start end ;; o------------------o---------o-------o @@ -5521,14 +5521,14 @@ def __FFAP_get_module_path(objstr): (defun python-ffap-module-path (module) "Function for `ffap-alist' to return path for MODULE." - (when-let ((process (python-shell-get-process)) - (ready (python-shell-with-shell-buffer + (when-let* ((process (python-shell-get-process)) + (ready (python-shell-with-shell-buffer (python-util-comint-end-of-output-p))) - (module-file - (python-shell-send-string-no-output - (format "%s\nprint(__FFAP_get_module_path(%s))" - python-ffap-setup-code - (python-shell--encode-string module))))) + (module-file + (python-shell-send-string-no-output + (format "%s\nprint(__FFAP_get_module_path(%s))" + python-ffap-setup-code + (python-shell--encode-string module))))) (unless (string-empty-p module-file) (python-util-strip-string module-file)))) @@ -6537,7 +6537,7 @@ This is for compatibility with Emacs < 24.4." (defun python-util-comint-end-of-output-p () "Return non-nil if the last prompt matches input prompt." - (when-let ((prompt (python-util-comint-last-prompt))) + (when-let* ((prompt (python-util-comint-last-prompt))) (python-shell-comint-end-of-output-p (buffer-substring-no-properties (car prompt) (cdr prompt))))) @@ -6817,8 +6817,8 @@ for key in sorted(result): (defun python--import-sources () "List files containing Python imports that may be useful in the current buffer." - (if-let (((featurep 'project)) ;For compatibility with Emacs < 26 - (proj (project-current))) + (if-let* (((featurep 'project)) ;For compatibility with Emacs < 26 + (proj (project-current))) (seq-filter (lambda (s) (string-match-p "\\.py[iwx]?\\'" s)) (project-files proj)) (list default-directory))) @@ -6930,9 +6930,9 @@ asking. When calling from Lisp, use a non-nil NAME to restrict the suggestions to imports defining NAME." (interactive (list (when current-prefix-arg (thing-at-point 'symbol)))) - (when-let ((statement (python--query-import name - (python--import-sources) - "Add import: "))) + (when-let* ((statement (python--query-import name + (python--import-sources) + "Add import: "))) (if (python--do-isort "--add" statement) (message "Added `%s'" statement) (message "(No changes in Python imports needed)")))) @@ -6955,8 +6955,8 @@ argument, restrict the suggestions to imports defining the symbol at point. If there is only one such suggestion, act without asking." (interactive (list (when current-prefix-arg (thing-at-point 'symbol)))) - (when-let ((statement (python--query-import name (current-buffer) - "Remove import: "))) + (when-let* ((statement (python--query-import name (current-buffer) + "Remove import: "))) (if (python--do-isort "--rm" statement) (message "Removed `%s'" statement) (message "(No changes in Python imports needed)")))) @@ -6998,11 +6998,11 @@ asking." (forward-line 1)))) ;; Compute imports to be added (dolist (name (seq-uniq undefined)) - (when-let ((statement (python--query-import name - (python--import-sources) - (format "\ + (when-let* ((statement (python--query-import name + (python--import-sources) + (format "\ Add import for undefined name `%s' (empty to skip): " - name)))) + name)))) (push statement add))) ;; Compute imports to be removed (dolist (name (seq-uniq unused)) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 28bd42aebde..cc06e06ef78 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1050,7 +1050,7 @@ beginning of the line." "Return the string used to group a set of locations. This function is used as a value for `add-log-current-defun-function'." (xref--group-name-for-display - (if-let (item (xref--item-at-point)) + (if-let* ((item (xref--item-at-point))) (xref-location-group (xref-match-item-location item)) (xref--imenu-extract-index-name)) (xref--project-root (project-current)))) diff --git a/lisp/repeat.el b/lisp/repeat.el index 1de26826ea1..f13fa489cae 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -560,8 +560,8 @@ This function can be used to force exit of repetition while it's active." (mapconcat (lambda (key-cmd) (let ((key (car key-cmd)) (cmd (cdr key-cmd))) - (if-let ((hint (and (symbolp cmd) - (get cmd 'repeat-hint)))) + (if-let* ((hint (and (symbolp cmd) + (get cmd 'repeat-hint)))) ;; Reuse `read-multiple-choice' formatting. (cdr (rmc--add-key-description (list key hint))) (propertize (key-description (vector key)) diff --git a/lisp/saveplace.el b/lisp/saveplace.el index 012e305f7f4..e2b7b4c9f06 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -416,22 +416,22 @@ It runs the hook `save-place-after-find-file-hook'." "Position point in a Dired buffer according to its saved place. This is run via `dired-initial-position-hook', which see." (or save-place-loaded (save-place-load-alist-from-file)) - (when-let ((directory (and (derived-mode-p 'dired-mode) - (boundp 'dired-subdir-alist) - dired-subdir-alist - (dired-current-directory))) - (item (expand-file-name (if (consp directory) - (car directory) - directory))) - (cell (assoc (if save-place-abbreviate-file-names - (abbreviate-file-name item) item) - save-place-alist))) + (when-let* ((directory (and (derived-mode-p 'dired-mode) + (boundp 'dired-subdir-alist) + dired-subdir-alist + (dired-current-directory))) + (item (expand-file-name (if (consp directory) + (car directory) + directory))) + (cell (assoc (if save-place-abbreviate-file-names + (abbreviate-file-name item) item) + save-place-alist))) (or revert-buffer-in-progress-p (cond ((integerp (cdr cell)) (goto-char (cdr cell))) ((listp (cdr cell)) - (when-let ((elt (assq 'dired-filename (cdr cell)))) + (when-let* ((elt (assq 'dired-filename (cdr cell)))) (dired-goto-file (expand-file-name (cdr elt))))))) ;; and make sure it will be saved again for later (setq save-place-mode t))) diff --git a/lisp/server.el b/lisp/server.el index abfd3d4d753..d45fb2b25ab 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1904,7 +1904,7 @@ if there are no other active clients." (length> server-clients 1) (seq-some (lambda (frame) - (when-let ((p (frame-parameter frame 'client))) + (when-let* ((p (frame-parameter frame 'client))) (not (eq proc p)))) (frame-list))) ;; If `server-stop-automatically' is not enabled, there diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index 877b2c8b5ee..5eaa94b4633 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -294,7 +294,7 @@ Argument can be a simple name, remote file name, or already a (defsubst shadow-make-fullname (hup &optional host name) "Make a Tramp style fullname out of HUP, a `tramp-file-name' structure. Replace HOST, and NAME when non-nil. HOST can also be a remote file name." - (when-let ((hup (copy-tramp-file-name hup))) + (when-let* ((hup (copy-tramp-file-name hup))) (when host (if (file-remote-p host) (setq name (or name (and hup (tramp-file-name-localname hup))) @@ -364,7 +364,7 @@ Will return the name bare if it is a local file." Do so by replacing (when possible) home directory with ~/, and hostname with cluster name that includes it. Filename should be absolute and true." - (when-let ((hup (shadow-parse-name file))) + (when-let* ((hup (shadow-parse-name file))) (let* ((homedir (if (shadow-local-file hup) shadow-homedir (file-name-as-directory @@ -464,8 +464,8 @@ It may have different filenames on each site. When this file is edited, the new version will be copied to each of the other locations. Sites can be specific hostnames, or names of clusters (see `shadow-define-cluster')." (interactive) - (when-let ((hup (shadow-parse-name - (shadow-contract-file-name (buffer-file-name))))) + (when-let* ((hup (shadow-parse-name + (shadow-contract-file-name (buffer-file-name))))) (let* ((name (tramp-file-name-localname hup)) site group) (while (setq site (shadow-read-site)) diff --git a/lisp/shell.el b/lisp/shell.el index 965e6edcb37..6cfae470cd7 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -1802,7 +1802,7 @@ works better if `comint-fontify-input-mode' is enabled." (progn (remove-hook 'comint-indirect-setup-hook shell--highlight-undef-indirect t) (setq shell--highlight-undef-indirect nil) - (when-let ((buf (comint-indirect-buffer t))) + (when-let* ((buf (comint-indirect-buffer t))) (with-current-buffer buf (font-lock-remove-keywords nil shell-highlight-undef-keywords)))) (font-lock-remove-keywords nil shell-highlight-undef-keywords)) @@ -1842,7 +1842,7 @@ works better if `comint-fontify-input-mode' is enabled." (font-lock-add-keywords nil shell-highlight-undef-keywords t)))) (cond (comint-fontify-input-mode (setq shell--highlight-undef-indirect setup) - (if-let ((buf (comint-indirect-buffer t))) + (if-let* ((buf (comint-indirect-buffer t))) (with-current-buffer buf (funcall setup)) (add-hook 'comint-indirect-setup-hook setup nil t))) diff --git a/lisp/simple.el b/lisp/simple.el index e35cfe0479b..2ffd6e86e56 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2399,7 +2399,7 @@ mode when reading the command name." (defun command-completion-using-modes-p (symbol buffer) "Say whether SYMBOL has been marked as a mode-specific command in BUFFER." ;; Check the modes. - (when-let ((modes (command-modes symbol))) + (when-let* ((modes (command-modes symbol))) ;; Common fast case: Just a single mode. (if (null (cdr modes)) (or (provided-mode-derived-p @@ -2801,10 +2801,10 @@ don't clear it." (t ;; Pass `cmd' rather than `final', for the backtrace's sake. (prog1 (call-interactively cmd record-flag keys) - (when-let ((info - (and (symbolp cmd) - (not (get cmd 'command-execute-obsolete-warned)) - (get cmd 'byte-obsolete-info)))) + (when-let* ((info + (and (symbolp cmd) + (not (get cmd 'command-execute-obsolete-warned)) + (get cmd 'byte-obsolete-info)))) (put cmd 'command-execute-obsolete-warned t) (message "%s" (macroexp--obsolete-warning cmd info "command" @@ -4779,7 +4779,7 @@ Names'. If a file name handler is unable to retrieve the effective uid, this function will instead return -1." - (if-let ((handler (find-file-name-handler default-directory 'file-user-uid))) + (if-let* ((handler (find-file-name-handler default-directory 'file-user-uid))) (funcall handler 'file-user-uid) (user-uid))) @@ -4791,7 +4791,7 @@ Names'. If a file name handler is unable to retrieve the effective gid, this function will instead return -1." - (if-let ((handler (find-file-name-handler default-directory 'file-group-gid))) + (if-let* ((handler (find-file-name-handler default-directory 'file-group-gid))) (funcall handler 'file-group-gid) (group-gid))) @@ -10054,7 +10054,7 @@ the completions is popped up and down." (let ((inhibit-read-only t)) (add-text-properties (point) (min (1+ (point)) (point-max)) '(first-completion t)))) - (when-let ((pos (next-single-property-change (point) 'mouse-face))) + (when-let* ((pos (next-single-property-change (point) 'mouse-face))) (goto-char pos)))) (defun last-completion () @@ -10064,7 +10064,7 @@ the completions is popped up and down." (point-max) 'mouse-face nil (point-min))) ;; Move to the start of last one. (unless (get-text-property (point) 'mouse-face) - (when-let ((pos (previous-single-property-change (point) 'mouse-face))) + (when-let* ((pos (previous-single-property-change (point) 'mouse-face))) (goto-char pos)))) (defun previous-completion (n) @@ -10491,10 +10491,10 @@ to move point between completions.\n\n"))))))) (defun switch-to-completions () "Select the completion list window." (interactive) - (when-let ((window (or (get-buffer-window "*Completions*" 0) - ;; Make sure we have a completions window. - (progn (minibuffer-completion-help) - (get-buffer-window "*Completions*" 0))))) + (when-let* ((window (or (get-buffer-window "*Completions*" 0) + ;; Make sure we have a completions window. + (progn (minibuffer-completion-help) + (get-buffer-window "*Completions*" 0))))) (select-window window) (when (bobp) (cond diff --git a/lisp/startup.el b/lisp/startup.el index 738eec772ec..3436409a35e 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1106,9 +1106,9 @@ init-file, or to a default value if loading is not possible." ;; The next test is for builds without native ;; compilation support or builds with unexec. (boundp 'comp-eln-to-el-h)) - (if-let (source (gethash (file-name-nondirectory - user-init-file) - comp-eln-to-el-h)) + (if-let* ((source (gethash (file-name-nondirectory + user-init-file) + comp-eln-to-el-h))) ;; source exists or the .eln file would not load (setq user-init-file source) (message "Warning: unknown source file for init file %S" diff --git a/lisp/subr.el b/lisp/subr.el index 9113235ca5d..e630087b68f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2623,8 +2623,17 @@ Affects only hooks run in the current buffer." (defmacro if-let* (varlist then &rest else) "Bind variables according to VARLIST and evaluate THEN or ELSE. -This is like `if-let' but doesn't handle a VARLIST of the form -\(SYMBOL SOMETHING) specially." +Evaluate each binding in turn, as in `let*', stopping if a +binding value is nil. If all are non-nil return the value of +THEN, otherwise the value of the last form in ELSE, or nil if +there are none. + +Each element of VARLIST is a list (SYMBOL VALUEFORM) that binds +SYMBOL to the value of VALUEFORM. An element can additionally be +of the form (VALUEFORM), which is evaluated and checked for nil; +i.e. SYMBOL can be omitted if only the test result is of +interest. It can also be of the form SYMBOL, then the binding of +SYMBOL is checked for nil." (declare (indent 2) (debug ((&rest [&or symbolp (symbolp form) (form)]) body))) @@ -2637,8 +2646,10 @@ This is like `if-let' but doesn't handle a VARLIST of the form (defmacro when-let* (varlist &rest body) "Bind variables according to VARLIST and conditionally evaluate BODY. -This is like `when-let' but doesn't handle a VARLIST of the form -\(SYMBOL SOMETHING) specially. +Evaluate each binding in turn, stopping if a binding value is nil. +If all are non-nil, return the value of the last form in BODY. + +The variable list VARLIST is the same as in `if-let*'. See also `and-let*'." (declare (indent 1) (debug if-let*)) @@ -2665,21 +2676,10 @@ for forms evaluated for side-effect with returned values ignored." (defmacro if-let (spec then &rest else) "Bind variables according to SPEC and evaluate THEN or ELSE. -Evaluate each binding in turn, as in `let*', stopping if a -binding value is nil. If all are non-nil return the value of -THEN, otherwise the value of the last form in ELSE, or nil if -there are none. - -Each element of SPEC is a list (SYMBOL VALUEFORM) that binds -SYMBOL to the value of VALUEFORM. An element can additionally be -of the form (VALUEFORM), which is evaluated and checked for nil; -i.e. SYMBOL can be omitted if only the test result is of -interest. It can also be of the form SYMBOL, then the binding of -SYMBOL is checked for nil. - -As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING) -like \((SYMBOL SOMETHING)). This exists for backward compatibility -with an old syntax that accepted only one binding." +This is like `if-let*' except, as a special case, interpret a SPEC of +the form \(SYMBOL SOMETHING) like \((SYMBOL SOMETHING)). This exists +for backward compatibility with an old syntax that accepted only one +binding." (declare (indent 2) (debug ([&or (symbolp form) ; must be first, Bug#48489 (&rest [&or symbolp (symbolp form) (form)])] @@ -2699,6 +2699,10 @@ The variable list SPEC is the same as in `if-let'." (declare (indent 1) (debug if-let)) (list 'if-let spec (macroexp-progn body))) +(make-obsolete 'if-let 'if-let* "31.1") +(make-obsolete 'when-let "use `when-let*' or `and-let*' instead." + "31.1") + (defmacro while-let (spec &rest body) "Bind variables according to SPEC and conditionally evaluate BODY. Evaluate each binding in turn, stopping if a binding value is nil. diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 92b52b6936c..3c83a02739a 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -461,7 +461,7 @@ named the same as the mode.") (defun tab-line-tabs-buffer-group-by-project (&optional buffer) "Group tab buffers by project name." (with-current-buffer buffer - (if-let ((project (project-current))) + (if-let* ((project (project-current))) (project-name project) "No project"))) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 7278bee48d4..a0366374d34 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -1049,7 +1049,7 @@ return nil. Otherwise point is returned." (while (and (not found) (not (eobp))) (forward-line 1) - (when-let ((descriptor (ignore-errors (tar-get-descriptor)))) + (when-let* ((descriptor (ignore-errors (tar-get-descriptor)))) (when (equal (tar-header-name descriptor) file) (setq found t)))) (if (not found) @@ -1074,7 +1074,7 @@ return nil. Otherwise point is returned." (beginning-of-line) (bobp))))) (tar-next-line n) - (when-let ((descriptor (ignore-errors (tar-get-descriptor)))) + (when-let* ((descriptor (ignore-errors (tar-get-descriptor)))) (let ((candidate (tar-header-name descriptor)) (buffer (current-buffer))) (when (and candidate diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index df1cdc5143e..5ecf789e364 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -159,7 +159,7 @@ two markers or an overlay. Otherwise, it is nil." VALUE should be something suitable for passing to `gui-set-selection'." (unless (stringp value) - (when-let ((bounds (android-selection-bounds value))) + (when-let* ((bounds (android-selection-bounds value))) (setq value (ignore-errors (with-current-buffer (nth 2 bounds) (buffer-substring (nth 0 bounds) @@ -204,7 +204,7 @@ VALUE should be something suitable for passing to &context (window-system android)) ;; First, try to turn value into a string. ;; Don't set anything if that did not work. - (when-let ((string (android-encode-select-string value))) + (when-let* ((string (android-encode-select-string value))) (cond ((eq type 'CLIPBOARD) (android-set-clipboard string)) ((eq type 'PRIMARY) diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index efc0a129062..c6091669adc 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -142,7 +142,7 @@ two markers or an overlay. Otherwise, it is nil." Return a list of the appropriate MIME type, and UTF-8 data of VALUE as a unibyte string, or nil if VALUE was not a string." (unless (stringp value) - (when-let ((bounds (haiku-selection-bounds value))) + (when-let* ((bounds (haiku-selection-bounds value))) (setq value (ignore-errors (with-current-buffer (nth 2 bounds) (buffer-substring (nth 0 bounds) @@ -260,7 +260,7 @@ CLIPBOARD should be the symbol `PRIMARY', `SECONDARY' or VALUE will be encoded as Latin-1 (like on X Windows) and stored under the type `text/plain;charset=iso-8859-1'." (unless (stringp value) - (when-let ((bounds (haiku-selection-bounds value))) + (when-let* ((bounds (haiku-selection-bounds value))) (setq value (ignore-errors (with-current-buffer (nth 2 bounds) (buffer-substring (nth 0 bounds) @@ -274,7 +274,7 @@ under the type `text/plain;charset=iso-8859-1'." VALUE will be encoded as UTF-8 and stored under the type `text/plain'." (unless (stringp value) - (when-let ((bounds (haiku-selection-bounds value))) + (when-let* ((bounds (haiku-selection-bounds value))) (setq value (ignore-errors (with-current-buffer (nth 2 bounds) (buffer-substring (nth 0 bounds) diff --git a/lisp/textmodes/emacs-news-mode.el b/lisp/textmodes/emacs-news-mode.el index 6321bd8efad..bb514f462ea 100644 --- a/lisp/textmodes/emacs-news-mode.el +++ b/lisp/textmodes/emacs-news-mode.el @@ -247,7 +247,7 @@ untagged NEWS entry." (while (re-search-forward "'\\([^-][^ \t\n]+\\)'" nil t) ;; Filter out references to key sequences. (let ((string (match-string 1))) - (when-let ((symbol (intern-soft string))) + (when-let* ((symbol (intern-soft string))) (when (or (boundp symbol) (fboundp symbol)) (buttonize-region (match-beginning 1) (match-end 1) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 35550d1bbc4..404f682d379 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -3723,7 +3723,7 @@ If APPEND is non-nil, don't erase previous debugging output." (while cur (unless (string-prefix-p word (car cur)) (setcar cur (concat word (substring (car cur) len)))) - (while (when-let ((next (cadr cur))) + (while (when-let* ((next (cadr cur))) (not (string-prefix-p word next t))) (setcdr cur (cddr cur))) (setq cur (cdr cur))) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index ee585896946..cc86294df09 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -1205,7 +1205,7 @@ and move to the line in the SGML document that caused it." (or sgml-saved-validate-command (concat sgml-validate-command " " - (when-let ((name (buffer-file-name))) + (when-let* ((name (buffer-file-name))) (shell-quote-argument (file-name-nondirectory name)))))))) (setq sgml-saved-validate-command command) @@ -2436,14 +2436,14 @@ To work around that, do: (defun html-mode--complete-at-point () ;; Complete a tag like %S" @@ -270,7 +270,7 @@ how long to wait for a response before giving up." (kill-buffer proc-buffer)) ;; Accommodate hack in commit 55d1d8b. (setq proc-buffer redirect-buffer))) - (when-let ((proc (get-buffer-process proc-buffer))) + (when-let* ((proc (get-buffer-process proc-buffer))) (when (memq (process-status proc) '(closed exit signal failed)) ;; Process sentinel vagaries occasionally cause diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 13258b15845..e6bfc5e64f3 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -1244,7 +1244,7 @@ spacing of the \"Lower\" chunk." (write-region beg2 end2 file2 nil 'nomessage) (unwind-protect (save-current-buffer - (if-let (buffer (get-buffer smerge-diff-buffer-name)) + (if-let* ((buffer (get-buffer smerge-diff-buffer-name))) (set-buffer buffer) (set-buffer (get-buffer-create smerge-diff-buffer-name)) (setq buffer-read-only t)) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index d733b36f8ff..4e1b1831389 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -1456,9 +1456,9 @@ These are the commands available for use in the file status buffer: (let ((use-vc-backend backend)) (vc-dir-mode) ;; Activate the backend-specific minor mode, if any. - (when-let ((minor-mode - (intern-soft (format "vc-dir-%s-mode" - (downcase (symbol-name backend)))))) + (when-let* ((minor-mode + (intern-soft (format "vc-dir-%s-mode" + (downcase (symbol-name backend)))))) (funcall minor-mode 1))))) (defun vc-default-dir-extra-headers (_backend _dir) diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index 36456fdb2e2..634b6fe1555 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -460,7 +460,7 @@ Display the buffer in some window, but don't select it." args)))) (setq proc (apply #'vc-do-command t 'async command nil args)))) (unless vc--inhibit-async-window - (when-let ((window (display-buffer buffer))) + (when-let* ((window (display-buffer buffer))) (set-window-start window new-window-start))) proc)) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index f2dc584bba9..ff0bc68e2d4 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -737,14 +737,14 @@ or an empty string if none." (let ((branch (vc-git--current-branch)) tracking remote-url) (if branch - (when-let ((branch-merge - (vc-git--out-match - `("config" ,(concat "branch." branch ".merge")) - "^\\(refs/heads/\\)?\\(.+\\)$" 2)) - (branch-remote - (vc-git--out-match - `("config" ,(concat "branch." branch ".remote")) - "\\([^\n]+\\)" 1))) + (when-let* ((branch-merge + (vc-git--out-match + `("config" ,(concat "branch." branch ".merge")) + "^\\(refs/heads/\\)?\\(.+\\)$" 2)) + (branch-remote + (vc-git--out-match + `("config" ,(concat "branch." branch ".remote")) + "\\([^\n]+\\)" 1))) (if (string= branch-remote ".") (setq tracking branch-merge remote-url "none (tracking local branch)") @@ -877,7 +877,7 @@ or an empty string if none." (list (concat (propertize "Stash : " 'face 'vc-dir-header) - (if-let ((stash-list (vc-git-stash-list))) + (if-let* ((stash-list (vc-git-stash-list))) (let* ((len (length stash-list)) (limit (if (integerp vc-git-show-stash) @@ -1051,19 +1051,19 @@ If toggling on, also insert its message into the buffer." (defun vc-git--log-edit-summary-check (limit) (and (re-search-forward "^Summary: " limit t) - (when-let ((regex - (cond ((and (natnump vc-git-log-edit-summary-max-len) - (natnump vc-git-log-edit-summary-target-len)) - (format ".\\{,%d\\}\\(.\\{,%d\\}\\)\\(.*\\)" - vc-git-log-edit-summary-target-len - (- vc-git-log-edit-summary-max-len - vc-git-log-edit-summary-target-len))) - ((natnump vc-git-log-edit-summary-max-len) - (format ".\\{,%d\\}\\(?2:.*\\)" - vc-git-log-edit-summary-max-len)) - ((natnump vc-git-log-edit-summary-target-len) - (format ".\\{,%d\\}\\(.*\\)" - vc-git-log-edit-summary-target-len))))) + (when-let* ((regex + (cond ((and (natnump vc-git-log-edit-summary-max-len) + (natnump vc-git-log-edit-summary-target-len)) + (format ".\\{,%d\\}\\(.\\{,%d\\}\\)\\(.*\\)" + vc-git-log-edit-summary-target-len + (- vc-git-log-edit-summary-max-len + vc-git-log-edit-summary-target-len))) + ((natnump vc-git-log-edit-summary-max-len) + (format ".\\{,%d\\}\\(?2:.*\\)" + vc-git-log-edit-summary-max-len)) + ((natnump vc-git-log-edit-summary-target-len) + (format ".\\{,%d\\}\\(.*\\)" + vc-git-log-edit-summary-target-len))))) (re-search-forward regex limit t)))) (define-derived-mode vc-git-log-edit-mode log-edit-mode "Log-Edit/git" @@ -2229,7 +2229,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (vc-resynch-buffer (vc-git-root default-directory) t t)) (defun vc-git-stash-list () - (when-let ((out (vc-git--run-command-string nil "stash" "list"))) + (when-let* ((out (vc-git--run-command-string nil "stash" "list"))) (split-string (replace-regexp-in-string "^stash@" " " out) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index f64fd55f6a8..6498b8522fd 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1058,8 +1058,8 @@ responsible for the given file." (dirs (delq nil (mapcar (lambda (backend) - (when-let ((dir (vc-call-backend - backend 'responsible-p file))) + (when-let* ((dir (vc-call-backend + backend 'responsible-p file))) ;; We run DIR through `expand-file-name' ;; so that abbreviated directories, such ;; as "~/", wouldn't look "less specific" @@ -2174,7 +2174,7 @@ deduced fileset." (defun vc-buffer-sync-fileset (fileset not-urgent) (dolist (filename (cadr fileset)) - (when-let ((buffer (find-buffer-visiting filename))) + (when-let* ((buffer (find-buffer-visiting filename))) (with-current-buffer buffer (vc-buffer-sync not-urgent))))) @@ -3834,9 +3834,9 @@ cloning; the syntax of REV depends on what BACKEND accepts." (catch 'ok (dolist (backend vc-handled-backends) (ignore-error vc-not-supported - (when-let ((res (vc-call-backend - backend 'clone - remote directory rev))) + (when-let* ((res (vc-call-backend + backend 'clone + remote directory rev))) (throw 'ok res))))))) (declare-function log-view-current-tag "log-view" (&optional pos)) diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index fa128d287a4..b6117960bf7 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -117,9 +117,9 @@ extra indent = 2 "Apply visual-wrapping properties to the logical line starting at POSITION." (save-excursion (goto-char position) - (when-let ((first-line-prefix (fill-match-adaptive-prefix)) - (next-line-prefix (visual-wrap--content-prefix - first-line-prefix position))) + (when-let* ((first-line-prefix (fill-match-adaptive-prefix)) + (next-line-prefix (visual-wrap--content-prefix + first-line-prefix position))) (when (numberp next-line-prefix) ;; Set a minimum width for the prefix so it lines up correctly ;; with subsequent lines. Make sure not to do this past the end diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 1d47f80b0dd..6fbf6257232 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1042,8 +1042,8 @@ button end points." (defun widget-text (widget) "Get the text representation of the widget." - (when-let ((from (widget-get widget :from)) - (to (widget-get widget :to))) + (when-let* ((from (widget-get widget :from)) + (to (widget-get widget :to))) (when (eq (marker-buffer from) (marker-buffer to)) ; is this check necessary? (buffer-substring-no-properties from to)))) @@ -2942,7 +2942,7 @@ Otherwise, the new widget is the default child of WIDGET. The new widget gets inserted at the position of the BEFORE child." (save-excursion (let ((children (widget-get widget :children)) - (last-deleted (when-let ((lst (widget-get widget :last-deleted))) + (last-deleted (when-let* ((lst (widget-get widget :last-deleted))) (prog1 (pop lst) (widget-put widget :last-deleted lst))))) diff --git a/lisp/window-tool-bar.el b/lisp/window-tool-bar.el index 63484da3255..2f16addfb33 100644 --- a/lisp/window-tool-bar.el +++ b/lisp/window-tool-bar.el @@ -305,8 +305,8 @@ MENU-ITEM is a menu item to convert. See info node `(elisp)Tool Bar'." 'face 'window-tool-bar-button-disabled str)) - (when-let ((spec (and (window-tool-bar--use-images) - (plist-get menu-item :image)))) + (when-let* ((spec (and (window-tool-bar--use-images) + (plist-get menu-item :image)))) (put-text-property 0 len 'display (append spec diff --git a/lisp/window.el b/lisp/window.el index b50770cbd7e..c790118c5e0 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -8094,7 +8094,7 @@ specified by the ACTION argument." (while (and functions (not window)) (setq window (funcall (car functions) buffer alist) functions (cdr functions))) - (when-let ((select (assq 'post-command-select-window alist))) + (when-let* ((select (assq 'post-command-select-window alist))) (letrec ((old-selected-window (selected-window)) (postfun (lambda () @@ -8187,10 +8187,10 @@ This is an action function for buffer display, see Info node `(elisp) Buffer Display Action Functions'. It should be called only by `display-buffer' or a function directly or indirectly called by the latter." - (when-let ((window (or (display-buffer-reuse-window buffer alist) - (display-buffer-same-window buffer alist) - (display-buffer-pop-up-window buffer alist) - (display-buffer-use-some-window buffer alist)))) + (when-let* ((window (or (display-buffer-reuse-window buffer alist) + (display-buffer-same-window buffer alist) + (display-buffer-pop-up-window buffer alist) + (display-buffer-use-some-window buffer alist)))) (delete-other-windows window) window)) @@ -11071,10 +11071,10 @@ that can be later used as argument for `window-point-context-use-function'. Remember the returned context in the window parameter `context'." (walk-windows (lambda (w) - (when-let ((fn (buffer-local-value 'window-point-context-set-function - (window-buffer w))) - ((functionp fn)) - (context (funcall fn w))) + (when-let* ((fn (buffer-local-value 'window-point-context-set-function + (window-buffer w))) + ((functionp fn)) + (context (funcall fn w))) (set-window-parameter w 'context (cons (buffer-name (window-buffer w)) context)))) 'nomini)) @@ -11090,11 +11090,11 @@ The function called is supposed to set the window point to the location found by the provided context." (walk-windows (lambda (w) - (when-let ((fn (buffer-local-value 'window-point-context-use-function - (window-buffer w))) - ((functionp fn)) - (context (window-parameter w 'context)) - ((equal (buffer-name (window-buffer w)) (car context)))) + (when-let* ((fn (buffer-local-value 'window-point-context-use-function + (window-buffer w))) + ((functionp fn)) + (context (window-parameter w 'context)) + ((equal (buffer-name (window-buffer w)) (car context)))) (funcall fn w (cdr context)) (set-window-parameter w 'context nil))) 'nomini)) @@ -11119,11 +11119,11 @@ found by the provided context." (let ((point (window-point w))) (save-excursion (goto-char point) - (when-let ((f (alist-get 'front-context-string context)) - ((search-forward f (point-max) t))) + (when-let* ((f (alist-get 'front-context-string context)) + ((search-forward f (point-max) t))) (goto-char (match-beginning 0)) - (when-let ((r (alist-get 'rear-context-string context)) - ((search-backward r (point-min) t))) + (when-let* ((r (alist-get 'rear-context-string context)) + ((search-backward r (point-min) t))) (goto-char (match-end 0)) (setq point (point))))) (set-window-point w point)))) diff --git a/lisp/xdg.el b/lisp/xdg.el index 4c675489400..dc04fa88b03 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -291,7 +291,7 @@ According to the XDG Desktop Entry Specification version 0.5: colon-separated list of strings ... $XDG_CURRENT_DESKTOP should have been set by the login manager, according to the value of the DesktopNames found in the session file." - (when-let ((ret (getenv "XDG_CURRENT_DESKTOP"))) + (when-let* ((ret (getenv "XDG_CURRENT_DESKTOP"))) (string-split ret ":"))) diff --git a/lisp/xwidget.el b/lisp/xwidget.el index c5a84db6d4a..04581a75bc0 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -439,7 +439,7 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." (cond ((eq xwidget-event-type 'load-changed) (let ((title (xwidget-webkit-title xwidget)) (uri (xwidget-webkit-uri xwidget))) - (when-let ((buffer (get-buffer "*Xwidget WebKit History*"))) + (when-let* ((buffer (get-buffer "*Xwidget WebKit History*"))) (with-current-buffer buffer (revert-buffer))) (with-current-buffer (xwidget-buffer xwidget) diff --git a/lisp/yank-media.el b/lisp/yank-media.el index 563aae85419..6655bb705ef 100644 --- a/lisp/yank-media.el +++ b/lisp/yank-media.el @@ -81,7 +81,7 @@ all the different selection types." (gui-get-selection 'CLIPBOARD 'TARGETS))) (defun yank-media--get-selection (data-type) - (when-let ((data (gui-get-selection 'CLIPBOARD data-type))) + (when-let* ((data (gui-get-selection 'CLIPBOARD data-type))) (if (string-match-p "\\`text/" (symbol-name data-type)) (yank-media-types--format data-type data) data))) @@ -116,7 +116,7 @@ non-supported selection data types." (let ((elements nil)) ;; First gather all the data. (dolist (type '(PRIMARY CLIPBOARD)) - (when-let ((data-types (gui-get-selection type 'TARGETS))) + (when-let* ((data-types (gui-get-selection type 'TARGETS))) (when (vectorp data-types) (seq-do (lambda (data-type) (unless (memq data-type '( TARGETS MULTIPLE diff --git a/test/lisp/comint-tests.el b/test/lisp/comint-tests.el index 10a4ff34239..0d6fc701eec 100644 --- a/test/lisp/comint-tests.el +++ b/test/lisp/comint-tests.el @@ -73,9 +73,9 @@ happen to lurk on PATH when running the test suite." (defun comint-tests/test-password-function (password-function) "PASSWORD-FUNCTION can return nil or a string." - (when-let ((cat (if (eq system-type 'windows-nt) - (w32-native-executable-find "cat") - (executable-find "cat")))) + (when-let* ((cat (if (eq system-type 'windows-nt) + (w32-native-executable-find "cat") + (executable-find "cat")))) (let ((comint-password-function password-function)) (cl-letf (((symbol-function 'read-passwd) (lambda (&rest _args) "non-nil"))) diff --git a/test/lisp/completion-preview-tests.el b/test/lisp/completion-preview-tests.el index b190ecb7020..cfbf6d101e2 100644 --- a/test/lisp/completion-preview-tests.el +++ b/test/lisp/completion-preview-tests.el @@ -24,7 +24,7 @@ (defun completion-preview-tests--capf (completions &rest props) (lambda () - (when-let ((bounds (bounds-of-thing-at-point 'symbol))) + (when-let* ((bounds (bounds-of-thing-at-point 'symbol))) (append (list (car bounds) (cdr bounds) completions) props)))) (defun completion-preview-tests--check-preview diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el index ecef4c35b47..cfebcdc3551 100644 --- a/test/lisp/cus-edit-tests.el +++ b/test/lisp/cus-edit-tests.el @@ -31,7 +31,7 @@ `(save-window-excursion (unwind-protect (progn ,@body) - (when-let ((buf (get-buffer ,buffer))) + (when-let* ((buf (get-buffer ,buffer))) (kill-buffer buf))))) diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el index 9604c6ea17c..e84671d35ed 100644 --- a/test/lisp/erc/erc-scenarios-base-local-modules.el +++ b/test/lisp/erc/erc-scenarios-base-local-modules.el @@ -153,7 +153,7 @@ (define-erc-module -phony-sblm- nil "Test module for `erc-scenarios-base-local-modules--var-persistence'." - ((when-let ((vars (or erc--server-reconnecting erc--target-priors))) + ((when-let* ((vars (or erc--server-reconnecting erc--target-priors))) (should (assq 'erc--phony-sblm--mode vars)) (setq erc-scenarios-base-local-modules--local-var (alist-get 'erc-scenarios-base-local-modules--local-var vars))) diff --git a/test/lisp/erc/erc-scenarios-stamp.el b/test/lisp/erc/erc-scenarios-stamp.el index 2e836e163bc..8aea091333b 100644 --- a/test/lisp/erc/erc-scenarios-stamp.el +++ b/test/lisp/erc/erc-scenarios-stamp.el @@ -29,7 +29,7 @@ (defvar erc-scenarios-stamp--user-marker nil) (defun erc-scenarios-stamp--on-post-modify () - (when-let (((erc--check-msg-prop 'erc--cmd 4))) + (when-let* (((erc--check-msg-prop 'erc--cmd 4))) (set-marker erc-scenarios-stamp--user-marker (point-max)) (ert-info ("User marker correctly placed at `erc-insert-marker'") (should (= ?\n (char-before erc-scenarios-stamp--user-marker))) diff --git a/test/lisp/erc/erc-services-tests.el b/test/lisp/erc/erc-services-tests.el index 126f6d7bbdd..a4420fbcbe2 100644 --- a/test/lisp/erc/erc-services-tests.el +++ b/test/lisp/erc/erc-services-tests.el @@ -485,7 +485,7 @@ ;; This function gives ^ (faked here to avoid gpg and file IO). See ;; `auth-source-pass--with-store' in ../auth-source-pass-tests.el (defun erc-services-tests--asp-parse-entry (store entry) - (when-let ((found (cl-find entry store :key #'car :test #'string=))) + (when-let* ((found (cl-find entry store :key #'car :test #'string=))) (list (assoc 'secret (cdr found))))) (defvar erc-join-tests--auth-source-pass-entries diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index eddb3a5b2c8..4c5521721f0 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3444,8 +3444,8 @@ (ert-deftest erc-modules--internal-property () (let (ours) (mapatoms (lambda (s) - (when-let ((v (get s 'erc--module)) - ((eq v s))) + (when-let* ((v (get s 'erc--module)) + ((eq v s))) (push s ours)))) (should (equal (sort ours #'string-lessp) erc-tests--modules)))) @@ -3480,7 +3480,7 @@ (setq mods (sort mods (lambda (a b) (if (zerop (random 2)) a b)))) (dolist (mod mods) (unless (keywordp mod) - (push (if-let ((mode (erc--find-mode mod))) mod (list :missing mod)) + (push (if-let* ((mode (erc--find-mode mod))) mod (list :missing mod)) moded))) (message "%S" (sort moded (lambda (a b) @@ -3578,7 +3578,7 @@ (cl-letf (((symbol-function 'require) (lambda (s &rest _) ;; Simulate library being loaded, things defined. - (when-let ((h (alist-get s on-load))) (funcall h)) + (when-let* ((h (alist-get s on-load))) (funcall h)) (push (cons 'req s) calls))) ;; Spoof global module detection. diff --git a/test/lisp/erc/resources/erc-d/erc-d-i.el b/test/lisp/erc/resources/erc-d/erc-d-i.el index 97cd56408ce..89aacdd2ec3 100644 --- a/test/lisp/erc/resources/erc-d/erc-d-i.el +++ b/test/lisp/erc/resources/erc-d/erc-d-i.el @@ -102,15 +102,15 @@ With DECODE, decode as UTF-8 text." (setq s (decode-coding-string s 'utf-8 t))) (let ((mes (make-erc-d-i-message :unparsed s :compat (not decode))) tokens) - (when-let (((not (string-empty-p s))) - ((eq ?@ (aref s 0))) - (m (string-match " " s)) - (u (substring s 1 m))) + (when-let* (((not (string-empty-p s))) + ((eq ?@ (aref s 0))) + (m (string-match " " s)) + (u (substring s 1 m))) (setf (erc-d-i-message.tags mes) (erc-d-i--validate-tags u) s (substring s (1+ m)))) - (if-let ((m (string-search " :" s)) - (other-toks (split-string (substring s 0 m) " " t)) - (rest (substring s (+ 2 m)))) + (if-let* ((m (string-search " :" s)) + (other-toks (split-string (substring s 0 m) " " t)) + (rest (substring s (+ 2 m)))) (setf (erc-d-i-message.contents mes) rest tokens (nconc other-toks (list rest))) (setf tokens (split-string s " " t " ") diff --git a/test/lisp/erc/resources/erc-d/erc-d-t.el b/test/lisp/erc/resources/erc-d/erc-d-t.el index 2dc8398198f..d0d48c6ce4d 100644 --- a/test/lisp/erc/resources/erc-d/erc-d-t.el +++ b/test/lisp/erc/resources/erc-d/erc-d-t.el @@ -38,11 +38,11 @@ (when (and (boundp 'erc-server-flood-timer) (timerp erc-server-flood-timer)) (cancel-timer erc-server-flood-timer)) - (when-let ((proc (get-buffer-process buf))) + (when-let* ((proc (get-buffer-process buf))) (delete-process proc)) (when (buffer-live-p buf) (kill-buffer buf)))) - (while (when-let ((buf (pop erc-d-u--canned-buffers))) + (while (when-let* ((buf (pop erc-d-u--canned-buffers))) (kill-buffer buf)))) (defun erc-d-t-silence-around (orig &rest args) @@ -74,10 +74,10 @@ returning." (push o procs))) (dolist (proc procs) (delete-process proc) - (when-let ((buf (process-buffer proc))) + (when-let* ((buf (process-buffer proc))) (push buf bufs))) (dolist (buf bufs) - (when-let ((proc (get-buffer-process buf))) + (when-let* ((proc (get-buffer-process buf))) (delete-process proc)) (when (bufferp buf) (ignore-errors (kill-buffer buf))))) diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el b/test/lisp/erc/resources/erc-d/erc-d-tests.el index a626ddd8edc..22afe8454ee 100644 --- a/test/lisp/erc/resources/erc-d/erc-d-tests.el +++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el @@ -318,23 +318,23 @@ m (erc-d-i--parse-message input)) (ert-info ("Parses tags correctly") (setq ours (erc-d-i-message.tags m)) - (if-let ((tags (assoc-default 'tags atoms))) + (if-let* ((tags (assoc-default 'tags atoms))) (pcase-dolist (`(,key . ,value) ours) (should (string= (cdr (assq key tags)) (or value "")))) (should-not ours))) (ert-info ("Parses verbs correctly") (setq ours (erc-d-i-message.command m)) - (if-let ((verbs (assoc-default 'verb atoms))) + (if-let* ((verbs (assoc-default 'verb atoms))) (should (string= (downcase verbs) (downcase ours))) (should (string-empty-p ours)))) (ert-info ("Parses sources correctly") (setq ours (erc-d-i-message.sender m)) - (if-let ((source (assoc-default 'source atoms))) + (if-let* ((source (assoc-default 'source atoms))) (should (string= source ours)) (should (string-empty-p ours)))) (ert-info ("Parses params correctly") (setq ours (erc-d-i-message.command-args m)) - (if-let ((params (assoc-default 'params atoms))) + (if-let* ((params (assoc-default 'params atoms))) (should (equal ours params)) (should-not ours)))))) diff --git a/test/lisp/erc/resources/erc-d/erc-d-u.el b/test/lisp/erc/resources/erc-d/erc-d-u.el index 11202f41112..8ba33fc9032 100644 --- a/test/lisp/erc/resources/erc-d/erc-d-u.el +++ b/test/lisp/erc/resources/erc-d/erc-d-u.el @@ -150,7 +150,7 @@ of zero or more response specs." (erc-d-u--canned-read dialog)) (defun erc-d-u--read-exchange-slowly (num orig info) - (when-let ((spec (funcall orig info))) + (when-let* ((spec (funcall orig info))) (when (symbolp (car spec)) (setf spec (copy-sequence spec) (nth 1 spec) (cond ((functionp num) (funcall num (nth 1 spec))) diff --git a/test/lisp/erc/resources/erc-d/erc-d.el b/test/lisp/erc/resources/erc-d/erc-d.el index 89701442ff6..08c8a958c6b 100644 --- a/test/lisp/erc/resources/erc-d/erc-d.el +++ b/test/lisp/erc/resources/erc-d/erc-d.el @@ -382,7 +382,7 @@ Return associated server." "Raise timeout error for EXCHANGE. This will start the teardown for DIALOG." (setf (erc-d-exchange-spec exchange) nil) - (if-let ((finalizer (erc-d-dialog-finalizer dialog))) + (if-let* ((finalizer (erc-d-dialog-finalizer dialog))) (funcall finalizer dialog exchange) (erc-d--teardown 'erc-d-timeout "Timed out awaiting request: %s" (list :name (erc-d-exchange-tag exchange) @@ -801,7 +801,7 @@ with leading-tilde tags." (defun erc-d--finalize-done (dialog) ;; Linger logic for individual dialogs is handled elsewhere - (if-let ((finalizer (erc-d-dialog-finalizer dialog))) + (if-let* ((finalizer (erc-d-dialog-finalizer dialog))) (funcall finalizer dialog) (let ((d (process-get (erc-d-dialog-process dialog) :dialog-linger-secs))) (push (run-at-time d nil #'erc-d--teardown) @@ -876,7 +876,7 @@ back others indicating the lifecycle stage of the current dialog." (apply #'erc-d--teardown matched) (erc-d-on-match dialog matched) (setf (erc-d-dialog-matched dialog) matched) - (if-let ((s (erc-d--command-meter-replies dialog matched nil))) + (if-let* ((s (erc-d--command-meter-replies dialog matched nil))) (throw 'yield s) (setf (erc-d-dialog-matched dialog) nil)))) (erc-d--command-refresh dialog matched))))))) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 130b0aae109..1f663a90f78 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -185,8 +185,8 @@ Dialog resource directories are located by expanding the variable (ert-info ("Restore autojoin, etc., kill ERC buffers") (dolist (buf (buffer-list)) - (when-let ((erc-d-u--process-buffer) - (proc (get-buffer-process buf))) + (when-let* ((erc-d-u--process-buffer) + (proc (get-buffer-process buf))) (delete-process proc))) (erc-scenarios-common--remove-silence) diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index db0c5d626c9..a9495ecb28d 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -246,8 +246,8 @@ For simplicity, assume string evaluates to itself." (defvar erc-stamp--deferred-date-stamp) (let (erc-stamp--deferred-date-stamp) (prog1 (apply orig args) - (when-let ((inst erc-stamp--deferred-date-stamp) - (fn (erc-stamp--date-fn inst))) + (when-let* ((inst erc-stamp--deferred-date-stamp) + (fn (erc-stamp--date-fn inst))) (funcall fn))))) (defun erc-tests-common-display-message (&rest args) @@ -338,8 +338,8 @@ string." "Return subprocess for running CODE in an inferior Emacs. Include SWITCHES, like \"-batch\", as well as libs, after interspersing \"-l\" between members." - (let* ((package (if-let ((found (getenv "ERC_PACKAGE_NAME")) - ((string-prefix-p "erc-" found))) + (let* ((package (if-let* ((found (getenv "ERC_PACKAGE_NAME")) + ((string-prefix-p "erc-" found))) (intern found) 'erc)) ;; For integrations testing with managed configs that use a diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el index ea9e663b1ad..4422bbe6660 100644 --- a/test/lisp/ibuffer-tests.el +++ b/test/lisp/ibuffer-tests.el @@ -132,7 +132,7 @@ (ibuffer-switch-to-saved-filter-groups "saved-filters") (should (assoc "Elisp" (cdar ibuffer-saved-filter-groups)))) (setq ibuffer-saved-filter-groups orig-filters) - (when-let ((it (get-buffer "*Ibuffer*"))) + (when-let* ((it (get-buffer "*Ibuffer*"))) (and (buffer-live-p it) (kill-buffer it)))))) diff --git a/test/lisp/international/mule-tests.el b/test/lisp/international/mule-tests.el index 9c869cc8e6f..5bcb8f5a551 100644 --- a/test/lisp/international/mule-tests.el +++ b/test/lisp/international/mule-tests.el @@ -67,7 +67,7 @@ (ert-deftest mule-cmds-tests--ucs-names-missing-names () (let (code-points) (dotimes (u (1+ (max-char 'ucs))) - (when-let ((name (get-char-code-property u 'name))) + (when-let* ((name (get-char-code-property u 'name))) (when (and (not (<= #xD800 u #xDFFF)) (not (<= #x18800 u #x18AFF)) (not (char-from-name name))) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 9eef82e9c90..4cc4040d0ff 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -3790,8 +3790,8 @@ condition is met. If env string EMACS_PYTHON_INTERPRETER exists, use it as preferred one." (unless python-tests-shell-interpreters (setq python-tests-shell-interpreters - (if-let ((interpreter (getenv "EMACS_PYTHON_INTERPRETER"))) - (if-let ((info (python-tests--get-interpreter-info interpreter))) + (if-let* ((interpreter (getenv "EMACS_PYTHON_INTERPRETER"))) + (if-let* ((info (python-tests--get-interpreter-info interpreter))) (list info) (error "Couldn't find EMACS_PYTHON_INTERPRETER(%s) in path" interpreter)) @@ -3805,7 +3805,7 @@ as preferred one." "Get Python interpreter information specified by NAME. The information returned is a cons cell consisting of the file path and the version string." - (when-let ((interpreter (executable-find name))) + (when-let* ((interpreter (executable-find name))) (with-temp-buffer (and (equal (call-process interpreter nil t nil "--version") 0) (goto-char (point-min)) diff --git a/test/lisp/progmodes/ruby-ts-mode-tests.el b/test/lisp/progmodes/ruby-ts-mode-tests.el index 05d98974acf..08620294ebe 100644 --- a/test/lisp/progmodes/ruby-ts-mode-tests.el +++ b/test/lisp/progmodes/ruby-ts-mode-tests.el @@ -275,8 +275,8 @@ The whitespace before and including \"|\" on each line is removed." expected)))))) (defmacro ruby-ts-resource-file (file) - `(when-let ((testfile ,(or (macroexp-file-name) - buffer-file-name))) + `(when-let* ((testfile ,(or (macroexp-file-name) + buffer-file-name))) (let ((default-directory (file-name-directory testfile))) (file-truename (expand-file-name (format "ruby-mode-resources/%s" ,file)))))) diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index 11260204750..5efb75b6d85 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -547,7 +547,7 @@ Return the last evalled form in BODY." (delq nil (mapcar (lambda (chr) - (when-let (it (alist-get chr char-nums)) + (when-let* ((it (alist-get chr char-nums))) (if (cdr it) `(,(cons 'or it) ,chr) `(,(car it) ,chr)))) diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el index 19c3793b93d..06b0b00862b 100644 --- a/test/src/emacs-tests.el +++ b/test/src/emacs-tests.el @@ -221,7 +221,7 @@ which the process was running." (terpri) (princ (buffer-substring-no-properties (point-min) (point-max))) ;; Search audit logs for Seccomp messages. - (when-let ((ausearch (executable-find "ausearch"))) + (when-let* ((ausearch (executable-find "ausearch"))) (terpri) (princ "Potentially relevant Seccomp audit events:") (terpri) @@ -236,7 +236,7 @@ which the process was running." (format-time-string "%T" end-time) "--interpret"))) ;; Print coredump information if available. - (when-let ((coredumpctl (executable-find "coredumpctl"))) + (when-let* ((coredumpctl (executable-find "coredumpctl"))) (terpri) (princ "Potentially useful coredump information:") (terpri) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 862416a49a9..98bdbbd42ee 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -946,8 +946,8 @@ COMMAND must be a list returned by (defun process-tests--emacs-command () "Return a command to reinvoke the current Emacs instance. Return nil if that doesn't appear to be possible." - (when-let ((binary (process-tests--emacs-binary)) - (dump (process-tests--dump-file))) + (when-let* ((binary (process-tests--emacs-binary)) + (dump (process-tests--dump-file))) (cons binary (unless (eq dump :not-needed) (list (concat "--dump-file=" @@ -962,18 +962,18 @@ Return nil if that can't be determined." (stringp invocation-directory) (not (file-remote-p invocation-directory)) (file-name-absolute-p invocation-directory) - (when-let ((file (process-tests--usable-file-for-reinvoke - (expand-file-name invocation-name - invocation-directory)))) + (when-let* ((file (process-tests--usable-file-for-reinvoke + (expand-file-name invocation-name + invocation-directory)))) (and (file-executable-p file) file)))) (defun process-tests--dump-file () "Return the filename of the dump file used to start Emacs. Return nil if that can't be determined. Return `:not-needed' if Emacs wasn't started with a dump file." - (if-let ((stats (and (fboundp 'pdumper-stats) (pdumper-stats)))) - (when-let ((file (process-tests--usable-file-for-reinvoke - (cdr (assq 'dump-file-name stats))))) + (if-let* ((stats (and (fboundp 'pdumper-stats) (pdumper-stats)))) + (when-let* ((file (process-tests--usable-file-for-reinvoke + (cdr (assq 'dump-file-name stats))))) (and (file-readable-p file) file)) :not-needed)) diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index ca595c41244..50f205421d7 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -1022,10 +1022,10 @@ and \"]\"." ;; Four functions: next-end, prev-beg, next-beg, prev-end. (mapcar (lambda (conf) (lambda () - (if-let ((pos (funcall - #'treesit-navigate-thing - (point) (car conf) (cdr conf) - treesit-defun-type-regexp tactic))) + (if-let* ((pos (funcall + #'treesit-navigate-thing + (point) (car conf) (cdr conf) + treesit-defun-type-regexp tactic))) (save-excursion (goto-char pos) (funcall treesit-defun-skipper) commit d3e98487d08eaed69db827ce489b69da1c7a084e Author: Sean Whitton Date: Thu Oct 24 15:39:34 2024 +0800 ; * lisp/loadup.el: Improve file abstract diff --git a/lisp/loadup.el b/lisp/loadup.el index 6d1e13f44bf..bd74a9d6aff 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -1,4 +1,4 @@ -;;; loadup.el --- load up standardly loaded Lisp files for Emacs -*- lexical-binding: t; -*- +;;; loadup.el --- load up always-loaded Lisp files for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1985-1986, 1992, 1994, 2001-2024 Free Software ;; Foundation, Inc. commit 1a91d37a21c43e4941f6c5913bcab507161e6be6 Author: Eli Zaretskii Date: Thu Oct 24 08:42:29 2024 +0300 ; * doc/lispref/control.texi (Conditionals): Fix markup. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 5ccc8462c9e..41f40ea852c 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -334,8 +334,8 @@ Like @code{if-let*}, but without @var{else-forms}. @defmac and-let* varlist then-forms... Like @code{when-let*}, but in addition, if there are no -@var{then-forms} and all the bindings evaluate to non-nil, return the -value of the last binding. +@var{then-forms} and all the bindings evaluate to non-@code{nil}, return +the value of the last binding. @end defmac @defmac while-let spec then-forms... commit 698d75a3355673773c095081c0000e52c36f93f0 Merge: ec9eecbe91e eae798486a9 Author: Sean Whitton Date: Thu Oct 24 12:13:20 2024 +0800 Merge from origin/emacs-30 eae798486a9 Update special conditionals documentation commit ec9eecbe91e6f4c40813bb221c9247053efcf1a8 Merge: 95f89c736fd 75584a3a961 Author: Sean Whitton Date: Thu Oct 24 12:13:20 2024 +0800 ; Merge from origin/emacs-30 The following commit was skipped: 75584a3a961 ; * test/lisp/proced-tests.el (proced--within-buffer): In... commit 95f89c736fd80f27e586127009880f89a77adb3b Merge: 3bb1b85b78b f5451b6a066 Author: Sean Whitton Date: Thu Oct 24 12:13:20 2024 +0800 Merge from origin/emacs-30 f5451b6a066 ; Improve comment from last change 09e05f7ee4d Document and-let* vs. when-let* usage convention b7a375f5c49 Fix error when splicing Eshell globs and a glob expands t... 2289e162268 * etc/package-keyring.gpg: Update expiration and add new key 48024096fea Avoid crashes when scrolling images under winner-mode c35d6ba9f07 ; * doc/lispref/display.texi (Fontsets): Clarify wording. 88a1a32fc57 ; * doc/lispref/display.texi (Fontsets): Fix typo. 6be47058cd7 ; Add indexing for 'use-default-font-for-symbols' 681f70ea04a * src/lread.c (READ_AND_BUFFER): Reject negative chars (b... ac4151e0023 * test/Makefile.in: Do not show emacs-module-tests.log by... 4e0cb960dbd Fix 'php-ts-mode': better indentation and font locking commit eae798486a965ec176bef3cc343625c164986c3f Author: Sean Whitton Date: Thu Oct 24 12:10:09 2024 +0800 Update special conditionals documentation * doc/lispref/control.texi (Conditionals): Document if-let* and when-let*, not if-let and when-let. Document and-let*. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 58063ecf8db..5ccc8462c9e 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -313,30 +313,41 @@ to make this easier and more readable. The above can be written the following way instead: @example -(when-let ((result1 (do-computation)) - (result2 (do-more result1))) +(when-let* ((result1 (do-computation)) + (result2 (do-more result1))) (do-something result2)) @end example There's a number of variations on this theme, and they're briefly described below. -@defmac if-let spec then-form else-forms... -Evaluate each binding in @var{spec} in turn, like in @code{let*} +@defmac if-let* varlist then-form else-forms... +Evaluate each binding in @var{varlist} in turn, like in @code{let*} (@pxref{Local Variables}), stopping if a binding value is @code{nil}. If all are non-@code{nil}, return the value of @var{then-form}, otherwise the last form in @var{else-forms}. @end defmac -@defmac when-let spec then-forms... -Like @code{if-let}, but without @var{else-forms}. +@defmac when-let* varlist then-forms... +Like @code{if-let*}, but without @var{else-forms}. +@end defmac + +@defmac and-let* varlist then-forms... +Like @code{when-let*}, but in addition, if there are no +@var{then-forms} and all the bindings evaluate to non-nil, return the +value of the last binding. @end defmac @defmac while-let spec then-forms... -Like @code{when-let}, but repeat until a binding in @var{spec} is +Like @code{when-let*}, but repeat until a binding in @var{spec} is @code{nil}. The return value is always @code{nil}. @end defmac +Some Lisp programmers follow the convention that @code{and} and +@code{and-let*} are for forms evaluated for return value, and +@code{when} and @code{when-let*} are for forms evaluated for side-effect +with returned values ignored. + @node Combining Conditions @section Constructs for Combining Conditions @cindex combining conditions commit 3bb1b85b78b8079e160dcb10774fe82c2daa1b4d Author: Sean Whitton Date: Thu Oct 24 11:26:27 2024 +0800 vc-allow-rewriting-published-history: Use nil->ask->t * lisp/vc/vc.el (vc-allow-rewriting-published-history): Use increasingly permissive values nil->ask->t rather than nil->t->no-ask. Recommend `ask' or nil. * lisp/vc/vc-git.el (vc-git--assert-allowed-rewrite): Update accordingly. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 899358339f3..f2dc584bba9 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1966,7 +1966,8 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." "log" "--max-count=1" "--pretty=format:%B" rev))) (defun vc-git--assert-allowed-rewrite (rev) - (when (and (not (eq vc-allow-rewriting-published-history 'no-ask)) + (when (and (not (and vc-allow-rewriting-published-history + (not (eq vc-allow-rewriting-published-history 'ask)))) ;; Check there is an upstream. (with-temp-buffer (vc-git--out-ok "config" "--get" @@ -1978,7 +1979,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." "--pretty=format:%H" "@{upstream}..HEAD"))))) (unless (or (cl-member rev outgoing :test #'string-prefix-p) - (and vc-allow-rewriting-published-history + (and (eq vc-allow-rewriting-published-history 'ask) (yes-or-no-p (format "Commit %s appears published; allow rewriting history?" rev)))) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 97b05362d8c..f64fd55f6a8 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -931,12 +931,17 @@ the ordinary way until you take special action. For example, for Git, see \"Recovering from Upstream Rebase\" in the Man page git-rebase(1). Normally, Emacs refuses to run VCS commands that it thinks will rewrite -published history. If you customize this variable to a non-nil value, -Emacs will instead prompt you to confirm that you really want to perform -the rewrite. A value of `no-ask' means to proceed with no prompting." +published history. If you customize this variable to `ask', Emacs will +instead prompt you to confirm that you really want to perform the +rewrite. Any other non-nil value means to proceed with no prompting. + +We recommend customizing this variable to `ask' or leaving it nil, +because if published history is rewritten unexpectedly it can be fairly +time-consuming to recover. Only customize this variable to a non-nil +value other than `ask' if you have a strong grasp of the VCS in use." :type '(choice (const :tag "Don't allow" nil) - (const :tag "Prompt to allow" t) - (const :tag "Allow without prompting" no-ask)) + (const :tag "Prompt to allow" ask) + (const :tag "Allow without prompting" t)) :version "31.1") commit bc8f416ee97795e77a36d6dd25a2a037bdc4a5c4 Author: Dmitry Gutov Date: Wed Oct 23 22:49:13 2024 +0300 ; Update the NEWS entry to mention project-prompter correctly diff --git a/etc/NEWS b/etc/NEWS index f7ad41b1b9f..a6c2c895985 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -137,9 +137,9 @@ It is equivalent to running ‘project-any-command’ with ‘find-file’. --- *** The MAYBE-PROMPT argument of 'project-current' can be a string. -When such value is used, the 'project-prompt' values are called with it -as the first argument. This is a way for the callers to indicate, for -example, the reason or the context why the project is asked for. +When such value is used, the 'project-prompter' is called with it as the +first argument. This is a way for the callers to indicate, for example, +the reason or the context why the project is asked for. ** Registers commit efaec5f61df967e2a4b85c5607f559f92f220ca9 Author: Dmitry Gutov Date: Wed Oct 23 22:43:18 2024 +0300 project-prompter: Update the docstring for the recent change * lisp/progmodes/project.el (project-prompter): Update the docstring too (bug#70833). diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 3cdaa7c2a76..5062021f8a6 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -199,7 +199,9 @@ When it is non-nil, `project-current' will always skip prompting too.") (defcustom project-prompter #'project-prompt-project-dir "Function to call to prompt for a project. -Called with no arguments and should return a project root dir." +The function is either called with no arguments or with one argument, +which is the prompt string to use. It should return a project root +directory." :type '(choice (const :tag "Prompt for a project directory" project-prompt-project-dir) (const :tag "Prompt for a project name" commit 75584a3a9614541478cf05edc6223de8db3d350c Author: Michael Albinus Date: Wed Oct 23 17:01:08 2024 +0200 ; * test/lisp/proced-tests.el (proced--within-buffer): Instrument macro. Do not merge with master diff --git a/test/lisp/proced-tests.el b/test/lisp/proced-tests.el index 6f16a241146..682c1328549 100644 --- a/test/lisp/proced-tests.el +++ b/test/lisp/proced-tests.el @@ -28,11 +28,13 @@ `(let ((proced-format ,format) (proced-filter ,filter) (proced-auto-update-flag nil) - (inhibit-message t)) + (inhibit-message (not (getenv "EMACS_EMBA_CI")))) (proced) (unwind-protect (with-current-buffer "*Proced*" ,@body) + (with-current-buffer "*Proced*" + (message "%s" (buffer-string))) (kill-buffer "*Proced*")))) (defun proced--assert-emacs-pid-in-buffer () commit 5e5689a2a40cd16d7593a0c7ddea5511adc3bf22 Author: Alan Coopersmith Date: Wed Oct 23 15:41:08 2024 +0200 configure.ac: Fix FIONREAD check with gcc-14 on Solaris Before this fix, it would fail to build with gcc-14 with the error: conftest.c: In function 'main': conftest.c:265:11: error: implicit declaration of function 'ioctl' [-Wimplicit-function-declaration] 265 | int foo = ioctl (0, FIONREAD, &foo); | ^~~~~ Solaris documents ioctl() as being defined in . * configure.ac: Fix FIONREAD check with gcc-14 on Solaris. Ref: https://lists.gnu.org/r/emacs-devel/2024-10/msg00195.html Copyright-paperwork-exempt: yes diff --git a/configure.ac b/configure.ac index 8a5ba7db3d1..947c2827b8e 100644 --- a/configure.ac +++ b/configure.ac @@ -7117,6 +7117,9 @@ AC_CACHE_CHECK([for usable FIONREAD], [emacs_cv_usable_FIONREAD], #ifdef USG5_4 # include #endif + #ifdef HAVE_UNISTD_H + # include /* defines ioctl() on Solaris */ + #endif ]], [[int foo = ioctl (0, FIONREAD, &foo);]])], [emacs_cv_usable_FIONREAD=yes], commit f5451b6a0668f4dc9992562b62ed37a199f1fdad Author: Sean Whitton Date: Wed Oct 23 10:53:02 2024 +0800 ; Improve comment from last change diff --git a/lisp/subr.el b/lisp/subr.el index d1b2a1efe6e..0acc24042f8 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2654,8 +2654,9 @@ are non-nil, then the result is the value of the last binding. Some Lisp programmers follow the convention that `and' and `and-let*' are for forms evaluated for return value, and `when' and `when-let*' are for forms evaluated for side-effect with returned values ignored." - ;; Document this convention here because it partially explains why we - ;; have both `when-let*' and `and-let*'. + ;; ^ Document this convention here because it explains why we have + ;; both `when-let*' and `and-let*' (in addition to the additional + ;; feature of `and-let*' when BODY is empty). (declare (indent 1) (debug if-let*)) (let (res) (if varlist commit 09e05f7ee4de89f5f1dd95aa9498feccfa9a78d6 Author: Sean Whitton Date: Wed Oct 23 09:07:06 2024 +0800 Document and-let* vs. when-let* usage convention * lisp/subr.el (and-let*): Document and/and-let* vs. when/when-let* usage convention (some discussion in bug#73853). (when-let*): Add cross-reference to and-let*. diff --git a/lisp/subr.el b/lisp/subr.el index 28ba30f584e..d1b2a1efe6e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2640,14 +2640,22 @@ This is like `if-let' but doesn't handle a VARLIST of the form (defmacro when-let* (varlist &rest body) "Bind variables according to VARLIST and conditionally evaluate BODY. This is like `when-let' but doesn't handle a VARLIST of the form -\(SYMBOL SOMETHING) specially." +\(SYMBOL SOMETHING) specially. + +See also `and-let*'." (declare (indent 1) (debug if-let*)) (list 'if-let* varlist (macroexp-progn body))) (defmacro and-let* (varlist &rest body) "Bind variables according to VARLIST and conditionally evaluate BODY. Like `when-let*', except if BODY is empty and all the bindings -are non-nil, then the result is the value of the last binding." +are non-nil, then the result is the value of the last binding. + +Some Lisp programmers follow the convention that `and' and `and-let*' +are for forms evaluated for return value, and `when' and `when-let*' are +for forms evaluated for side-effect with returned values ignored." + ;; Document this convention here because it partially explains why we + ;; have both `when-let*' and `and-let*'. (declare (indent 1) (debug if-let*)) (let (res) (if varlist commit b7a375f5c49ac86399b9af7a6a74720ed294abd7 Author: Jim Porter Date: Tue Oct 22 09:43:00 2024 -0700 Fix error when splicing Eshell globs and a glob expands to itself This could happen when 'eshell-extended-glob' determines that a "glob" is not really a glob. This mainly happens for remote file names with a "~" in them, like "/ssh:remote:~/file.txt". * lisp/eshell/em-glob.el (eshell-extended-glob): Return a list when 'eshell-glob-splice-results' is non-nil. * test/lisp/eshell/em-glob-tests.el (em-glob-test/expand/splice-results) em-glob-test/expand/no-splice-results): Extend tests. diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index 36e4f90aed2..2aceaf188f3 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -348,7 +348,7 @@ regular expressions, and these cannot support the above constructs." ;; always be sure if the "~" is a home directory reference or ;; part of a glob (e.g. if the argument was assembled from ;; variables). - glob + (if eshell-glob-splice-results (list glob) glob) (unwind-protect (apply #'eshell-glob-entries globs) (if message-shown diff --git a/test/lisp/eshell/em-glob-tests.el b/test/lisp/eshell/em-glob-tests.el index 2efb3a9df69..88e9cc73bbd 100644 --- a/test/lisp/eshell/em-glob-tests.el +++ b/test/lisp/eshell/em-glob-tests.el @@ -74,7 +74,13 @@ component ending in \"symlink\" is treated as a symbolic link." ;; Ensure the default expansion splices the glob. (eshell-command-result-equal "funcall list *.el" '("a.el" "b.el")) (eshell-command-result-equal "funcall list *.txt" '("c.txt")) - (eshell-command-result-equal "funcall list *.no" '("*.no"))))) + ;; When spliting, no-matches cases also return a list containing + ;; the original non-matching glob. + (eshell-command-result-equal "funcall list *.no" '("*.no")) + (when (eshell-tests-remote-accessible-p) + (let ((remote (file-remote-p ert-remote-temporary-file-directory))) + (eshell-command-result-equal (format "funcall list %s~/a.el" remote) + `(,(format "%s~/a.el" remote)))))))) (ert-deftest em-glob-test/expand/no-splice-results () "Test that globs are treated as lists when @@ -85,9 +91,13 @@ component ending in \"symlink\" is treated as a symbolic link." ;; Ensure the default expansion splices the glob. (eshell-command-result-equal "funcall list *.el" '(("a.el" "b.el"))) (eshell-command-result-equal "funcall list *.txt" '(("c.txt"))) - ;; The no-matches case is special here: the glob is just the + ;; The no-matches cases are special here: the glob is just the ;; string, not the list of results. - (eshell-command-result-equal "funcall list *.no" '("*.no"))))) + (eshell-command-result-equal "funcall list *.no" '("*.no")) + (when (eshell-tests-remote-accessible-p) + (let ((remote (file-remote-p ert-remote-temporary-file-directory))) + (eshell-command-result-equal (format "funcall list %s~/a.el" remote) + `(,(format "%s~/a.el" remote)))))))) (ert-deftest em-glob-test/expand/explicitly-splice-results () "Test explicitly splicing globs works the same no matter the commit 2289e162268b82d1d757c2354bf3fdf92316e91d Author: Stefan Monnier Date: Tue Oct 22 12:35:18 2024 -0400 * etc/package-keyring.gpg: Update expiration and add new key diff --git a/etc/package-keyring.gpg b/etc/package-keyring.gpg index 563acbb16b6..f88d60b2457 100644 Binary files a/etc/package-keyring.gpg and b/etc/package-keyring.gpg differ commit 48024096fea5ccdeb79dab5793a6f7a293b95919 Author: Eli Zaretskii Date: Mon Oct 21 20:42:01 2024 +0300 Avoid crashes when scrolling images under winner-mode * src/window.c (window_scroll_pixel_based): Fix calculation of a window's vscroll. (Bug#73933) diff --git a/src/window.c b/src/window.c index dba2d6a3523..a2b40cb197f 100644 --- a/src/window.c +++ b/src/window.c @@ -6017,7 +6017,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) /* The last line was only partially visible, make it fully visible. */ w->vscroll = (it.last_visible_y - - it.current_y + it.max_ascent + it.max_descent); + - (it.current_y + it.max_ascent + it.max_descent)); adjust_frame_glyphs (it.f); } else commit c35d6ba9f07b0a8417ef116359049c0dd63e12b5 Author: Eli Zaretskii Date: Mon Oct 21 18:32:07 2024 +0300 ; * doc/lispref/display.texi (Fontsets): Clarify wording. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index ac712c43208..afb1272ae41 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -4030,7 +4030,8 @@ that case, use @var{font-spec} for all the characters in the charset. char-script-table}). In that case, use @var{font-spec} for all the characters belonging to the script. See also @code{use-default-font-for-symbols}, which affects font selection -when @var{characters} is @code{symbol}. +when @var{characters} specify or belong to the @code{symbol} script +(which includes symbol and punctuation characters). @var{characters} may be @code{nil}, which means to use @var{font-spec} for any character in @var{fontset} for which no font-spec is commit 88a1a32fc57817d5e0e1f79b83ff23d7274cbace Author: Eli Zaretskii Date: Mon Oct 21 13:04:18 2024 +0300 ; * doc/lispref/display.texi (Fontsets): Fix typo. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 3492f4dc29b..ac712c43208 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -4030,7 +4030,7 @@ that case, use @var{font-spec} for all the characters in the charset. char-script-table}). In that case, use @var{font-spec} for all the characters belonging to the script. See also @code{use-default-font-for-symbols}, which affects font selection -when @var{fontset} is @code{symbol}. +when @var{characters} is @code{symbol}. @var{characters} may be @code{nil}, which means to use @var{font-spec} for any character in @var{fontset} for which no font-spec is commit 6be47058cd741e5868f5c2fdef0fd59e296f18b6 Author: Eli Zaretskii Date: Mon Oct 21 13:01:53 2024 +0300 ; Add indexing for 'use-default-font-for-symbols' * doc/emacs/mule.texi (Modifying Fontsets): * doc/lispref/display.texi (Fontsets): Index 'use-default-font-for-symbols'. diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index 8b16c661a7e..84edc0d086a 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -1681,6 +1681,7 @@ used. Some examples are: nil 'append) @end example +@vindex use-default-font-for-symbols When modifying the fontset for the @code{symbol} script, the value of @code{use-default-font-for-symbols} will affect whether the fontset is actually used. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 1d5ba98f062..3492f4dc29b 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -4025,6 +4025,7 @@ in the range @var{from} and @var{to} (inclusive). @var{characters} may be a charset symbol (@pxref{Character Sets}). In that case, use @var{font-spec} for all the characters in the charset. +@vindex use-default-font-for-symbols @var{characters} may be a script symbol (@pxref{Character Properties, char-script-table}). In that case, use @var{font-spec} for all the characters belonging to the script. See also commit 681f70ea04a30bb43bb87448a6d71458d773d247 Author: Eli Zaretskii Date: Sun Oct 20 22:39:53 2024 +0300 * src/lread.c (READ_AND_BUFFER): Reject negative chars (bug#73914). diff --git a/src/lread.c b/src/lread.c index c336c6db6e1..854aaa784ad 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3913,6 +3913,8 @@ read_stack_reset (intmax_t sp) #define READ_AND_BUFFER(c) \ c = READCHAR; \ + if (c < 0) \ + INVALID_SYNTAX_WITH_BUFFER (); \ if (multibyte) \ p += CHAR_STRING (c, (unsigned char *) p); \ else \ commit ac4151e0023f4bf17eb128036c006618332f1ac0 Author: Michael Albinus Date: Sun Oct 20 11:35:06 2024 +0200 * test/Makefile.in: Do not show emacs-module-tests.log by default. diff --git a/test/Makefile.in b/test/Makefile.in index 3cbdbec4414..7a3178546a1 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -170,7 +170,7 @@ WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; } endif ## On Emba, always show logs for certain problematic tests. ifdef EMACS_EMBA_CI -lisp/filenotify-tests.log lisp/net/tramp-tests.log src/emacs-module-tests.log \ +lisp/filenotify-tests.log lisp/net/tramp-tests.log \ : WRITE_LOG = 2>&1 | tee $@ endif commit 4e0cb960dbd95c8001b08c62682b085292184b87 Author: Vincenzo Pupillo Date: Thu Oct 10 16:06:37 2024 +0200 Fix 'php-ts-mode': better indentation and font locking Incomplete compound_statement or colon_block (statement-group without a closing brace or closing keyword) that are not inside a function or method are not recognized as such by tree-sitter-php. A new function 'php-ts-mode--open-statement-group-heuristic' handles this case. Font locking of magic methods and better support for alternative control structure syntax. Support for latest grammar version. * lisp/progmodes/php-ts-mode.el (php-ts-mode--language-source-alist): Updated grammar version. (php-ts-mode--possibly-braceless-keyword-re): Regular expression for braceless keyword. (php-ts-mode--open-statement-group-heuristic): New function. (php-ts-mode--parent-html-bol): Use the new function and doc fix. (php-ts-mode--parent-html-heuristic): Use the new function and doc fix. (php-ts-mode--indent-styles): Use the new function and add 'colon_block' support. (php-ts-mode--class-magic-methods): New predefined magic methods list. (php-ts-mode--test-namespace-name-as-prefix-p): Doc fix. (php-ts-mode--test-namespace-aliasing-clause-p): Fix the test and doc. (php-ts-mode--test-namespace-use-group-clause-p): Doc fix. (php-ts-mode--test-visibility-modifier-operation-clause-p): New function for the new asymmetric property visibility feature of PHP 8.4. (php-ts-mode--font-lock-settings): Font lock for class magic methods and alternative syntax. Better font lock for 'instanceof'. Use 'font-lock-function-call-face' for scoped and member call expression. (bug#73779) diff --git a/lisp/progmodes/php-ts-mode.el b/lisp/progmodes/php-ts-mode.el index d2559e5a45f..1c5fdb6f617 100644 --- a/lisp/progmodes/php-ts-mode.el +++ b/lisp/progmodes/php-ts-mode.el @@ -84,7 +84,7 @@ ;;; Install treesitter language parsers (defvar php-ts-mode--language-source-alist - '((php . ("https://github.com/tree-sitter/tree-sitter-php" "v0.23.0" "php/src")) + '((php . ("https://github.com/tree-sitter/tree-sitter-php" "v0.23.4" "php/src")) (phpdoc . ("https://github.com/claytonrcarter/tree-sitter-phpdoc")) (html . ("https://github.com/tree-sitter/tree-sitter-html" "v0.23.0")) (javascript . ("https://github.com/tree-sitter/tree-sitter-javascript" "v0.23.0")) @@ -428,6 +428,27 @@ Useful for debugging." ;;; Indent +(defconst php-ts-mode--possibly-braceless-keyword-re + (regexp-opt '("if" "for" "foreach" "while" "do") 'symbols) + "Regexp matching keywords optionally followed by an opening brace.") + +(defun php-ts-mode--open-statement-group-heuristic (node _parent bol &rest _) + "Heuristic matcher for statement-group without closing bracket. + +Return `php-ts-mode-indent-offset' plus 1 when BOL is after +`php-ts-mode--possibly-braceless-keyword-re', otherwise return 0. It's +usefull for matching incomplete compound_statement or colon_block. +PARENT is NODE's parent, BOL is the beginning of non-whitespace +characters of the current line." + (and (null node) + (save-excursion + (forward-line -1) + (if (re-search-forward + php-ts-mode--possibly-braceless-keyword-re + bol t) + (+ 1 php-ts-mode-indent-offset) + 0)))) + ;; taken from c-ts-mode (defun php-ts-mode--else-heuristic (node parent bol &rest _) "Heuristic matcher for when \"else\" is followed by a closing bracket. @@ -475,43 +496,50 @@ NODE is the node to match and PARENT is its parent." (goto-char (treesit-node-start parent)) (line-end-position))) -(defun php-ts-mode--parent-html-bol (node parent _bol &rest _) +(defun php-ts-mode--parent-html-bol (node parent bol &rest _) "Find the first non-space characters of the HTML tags before NODE. +When NODE is nil call `php-ts-mode--open-statement-group-heuristic'. PARENT is NODE's parent, BOL is the beginning of non-whitespace characters of the current line." - (save-excursion - (let ((html-node (treesit-search-forward node "text" t))) - (if html-node - (let ((end-html (treesit-node-end html-node))) - (goto-char end-html) - (backward-word) - (back-to-indentation) - (point)) - (treesit-node-start parent))))) - -(defun php-ts-mode--parent-html-heuristic (node parent _bol &rest _) + (if (null node) + ;; If NODE is nil it could be an open statement-group. + (php-ts-mode--open-statement-group-heuristic node parent bol) + (save-excursion + (let ((html-node (treesit-search-forward node "text" t))) + (if html-node + (let ((end-html (treesit-node-end html-node))) + (goto-char end-html) + (backward-word) + (back-to-indentation) + (point)) + (treesit-node-start parent)))))) + +(defun php-ts-mode--parent-html-heuristic (node parent bol &rest _) "Return position based on html indentation. Returns 0 if the NODE is after the , otherwise returns the -indentation point of the last word before the NODE, plus the -indentation offset. If there is no HTML tag, it returns the beginning -of the parent. +indentation point of the last word before the NODE, plus the indentation +offset. If there is no HTML tag, it returns the beginning of the +parent. When NODE is nil call `php-ts-mode--open-statement-group-heuristic'. It can be used when you want to indent PHP code relative to the HTML. PARENT is NODE's parent, BOL is the beginning of non-whitespace characters of the current line." - (let ((html-node (treesit-search-forward node "text" t))) - (if html-node - (let ((end-html (treesit-node-end html-node))) - (save-excursion - (goto-char end-html) - (backward-word) - (back-to-indentation) - (if (search-forward "" end-html t 1) - 0 - (+ (point) php-ts-mode-indent-offset)))) - ;; Maybe it's better to use bol? - (treesit-node-start parent)))) + (if (null node) + ;; If NODE is nil it could be an open statement-group. + (php-ts-mode--open-statement-group-heuristic node parent bol) + (let ((html-node (treesit-search-forward node "text" t))) + (if html-node + (let ((end-html (treesit-node-end html-node))) + (save-excursion + (goto-char end-html) + (backward-word) + (back-to-indentation) + (if (search-forward "" end-html t 1) + 0 + (+ (point) php-ts-mode-indent-offset)))) + ;; Maybe it's better to use bol? + (treesit-node-start parent))))) (defun php-ts-mode--array-element-heuristic (_node parent _bol &rest _) "Return of the position of the first element of the array. @@ -648,16 +676,22 @@ characters of the current line." ((parent-is "initializer_list") parent-bol php-ts-mode-indent-offset) ;; Statement in {} blocks. - ((or (and (parent-is "compound_statement") + ((or (and (or (parent-is "compound_statement") + (parent-is "colon_block")) ;; If the previous sibling(s) are not on their ;; own line, indent as if this node is the first ;; sibling php-ts-mode--first-sibling) - (match null "compound_statement")) + (or (match null "compound_statement") + (match null "colon_block"))) standalone-parent php-ts-mode-indent-offset) - ((parent-is "compound_statement") parent-bol php-ts-mode-indent-offset) + ((or (parent-is "compound_statement") + (parent-is "colon_block")) + parent-bol php-ts-mode-indent-offset) ;; Opening bracket. - ((node-is "compound_statement") standalone-parent php-ts-mode-indent-offset) + ((or (node-is "compound_statement") + (node-is "colon_block")) + standalone-parent php-ts-mode-indent-offset) ((parent-is "match_block") parent-bol php-ts-mode-indent-offset) ((parent-is "switch_block") parent-bol 0) @@ -667,6 +701,7 @@ characters of the current line." ;; rule for PHP alternative syntax ((or (node-is "else_if_clause") (node-is "endif") + (node-is "endfor") (node-is "endforeach") (node-is "endwhile")) parent-bol 0) @@ -679,9 +714,13 @@ characters of the current line." (parent-is "switch_statement") (parent-is "case_statement") (parent-is "empty_statement")) - parent-bol php-ts-mode-indent-offset)))) + parent-bol php-ts-mode-indent-offset) + + ;; Workaround: handle "for" open statement group. Currently + ;; the grammar handles it differently than other control structures. + (no-node php-ts-mode--open-statement-group-heuristic 0)))) `((psr2 - ((parent-is "program") parent-bol 0) + ((parent-is "program") php-ts-mode--open-statement-group-heuristic 0) ((parent-is "text_interpolation") column-0 0) ((parent-is "function_call_expression") parent-bol php-ts-mode-indent-offset) ,@common) @@ -774,21 +813,32 @@ characters of the current line." "__FUNCTION__" "__LINE__" "__METHOD__" "__NAMESPACE__" "__TRAIT__") "PHP predefined constant.") -(defun php-ts-mode--test-namespace-name-as-prefix-p () - "Return t if namespace_name_as_prefix keyword is a named node, nil otherwise." +(defconst php-ts-mode--class-magic-methods + '("__construct" "__destruct" "__call" "__callStatic" "__get" "__set" + "__isset" "__unset" "__sleep" "__wakeup" "__serialize" "__unserialize" + "__toString" "__invoke" "__set_state" "__clone" "__debugInfo") + "PHP predefined magic methods.") + +(defun php-ts-mode--test-namespace-name-as-prefix-p () + "Return t if namespace_name_as_prefix is a named node, nil otherwise." (ignore-errors (progn (treesit-query-compile 'php "(namespace_name_as_prefix)" t) t))) -(defun php-ts-mode--test-namespace-aliasing-clause-p () - "Return t if namespace_name_as_prefix keyword is named node, nil otherwise." +(defun php-ts-mode--test-namespace-aliasing-clause-p () + "Return t if namespace_aliasing_clause is a named node, nil otherwise." (ignore-errors - (progn (treesit-query-compile 'php "(namespace_name_as_prefix)" t) t))) + (progn (treesit-query-compile 'php "(namespace_aliasing_clause)" t) t))) (defun php-ts-mode--test-namespace-use-group-clause-p () - "Return t if namespace_use_group_clause keyword is named node, nil otherwise." + "Return t if namespace_use_group_clause is a named node, nil otherwise." (ignore-errors (progn (treesit-query-compile 'php "(namespace_use_group_clause)" t) t))) +(defun php-ts-mode--test-visibility-modifier-operation-clause-p () + "Return t if (visibility_modifier (operation)) is defined, nil otherwise." + (ignore-errors + (progn (treesit-query-compile 'php "(visibility_modifier (operation))" t) t))) + (defun php-ts-mode--font-lock-settings () "Tree-sitter font-lock settings." (treesit-font-lock-rules @@ -796,7 +846,10 @@ characters of the current line." :language 'php :feature 'keyword :override t - `([,@php-ts-mode--keywords] @font-lock-keyword-face) + `([,@php-ts-mode--keywords] @font-lock-keyword-face + ,@(when (php-ts-mode--test-visibility-modifier-operation-clause-p) + '((visibility_modifier (operation) @font-lock-builtin-face))) + (var_modifier) @font-lock-builtin-face) :language 'php :feature 'comment @@ -826,7 +879,6 @@ characters of the current line." (named_label_statement (name) @font-lock-constant-face)) :language 'php - ;;:override t :feature 'delimiter `((["," ":" ";" "\\"]) @font-lock-delimiter-face) @@ -850,7 +902,6 @@ characters of the current line." :language 'php :feature 'string - ;;:override t `(("\"") @font-lock-string-face (encapsed_string) @font-lock-string-face (string_content) @font-lock-string-face @@ -892,32 +943,37 @@ characters of the current line." name: (_) @font-lock-type-face) (trait_declaration name: (_) @font-lock-type-face) - (property_declaration - (visibility_modifier) @font-lock-keyword-face) - (property_declaration - (var_modifier) @font-lock-keyword-face) (enum_declaration name: (_) @font-lock-type-face) (function_definition name: (_) @font-lock-function-name-face) (method_declaration name: (_) @font-lock-function-name-face) + (method_declaration + name: (name) @font-lock-builtin-face + (:match ,(rx-to-string + `(: bos (or ,@php-ts-mode--class-magic-methods) eos)) + @font-lock-builtin-face)) ("=>") @font-lock-keyword-face (object_creation_expression (name) @font-lock-type-face) ,@(when (php-ts-mode--test-namespace-name-as-prefix-p) - '((namespace_name_as_prefix "\\" @font-lock-delimiter-face) - (namespace_name_as_prefix - (namespace_name (name)) @font-lock-type-face))) + '((namespace_name_as_prefix "\\" @font-lock-delimiter-face) + (namespace_name_as_prefix + (namespace_name (name)) @font-lock-type-face))) ,@(if (php-ts-mode--test-namespace-aliasing-clause-p) - '((namespace_aliasing_clause (name) @font-lock-type-face)) - '((namespace_use_clause alias: (name) @font-lock-type-face))) + '((namespace_aliasing_clause (name) @font-lock-type-face)) + '((namespace_use_clause alias: (name) @font-lock-type-face))) ,@(when (not (php-ts-mode--test-namespace-use-group-clause-p)) - '((namespace_use_group - (namespace_use_clause (name) @font-lock-type-face)))) + '((namespace_use_group + (namespace_use_clause (name) @font-lock-type-face)))) (namespace_name "\\" @font-lock-delimiter-face) (namespace_name (name) @font-lock-type-face) - (use_declaration (name) @font-lock-property-use-face)) + (use_declaration (name) @font-lock-property-use-face) + (use_instead_of_clause (name) @font-lock-type-face) + (binary_expression + operator: "instanceof" + right: (name) @font-lock-type-face)) :language 'php :feature 'function-scope @@ -932,9 +988,9 @@ characters of the current line." '((function_call_expression function: (name) @font-lock-function-call-face) (scoped_call_expression - name: (_) @font-lock-function-name-face) + name: (_) @font-lock-function-call-face) (member_call_expression - name: (_) @font-lock-function-name-face) + name: (_) @font-lock-function-call-face) (nullsafe_member_call_expression name: (_) @font-lock-constant-face))