mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-21 06:55:39 +00:00
Code Issues Releases Activity

Mark if-let and when-let obsolete

Browse Source 
* 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.
This commit is contained in:
Sean Whitton 2024-10-24 16:50:07 +08:00
parent 698d75a335
commit 8903106bb7
197 changed files with 1357 additions and 1346 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
admin/admin.el
View File

@ -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
"<emacs-devel@gnu.org>" ; to-address

4
doc/misc/erc.texi
View File

@ -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))))

7
etc/NEWS
View File

@ -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

8
lisp/ansi-color.el
View File

@ -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)

4
lisp/ansi-osc.el
View File

@ -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)

4
lisp/arc-mode.el
View File

@ -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

6
lisp/auth-source-pass.el
View File

@ -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)))

8
lisp/autorevert.el
View File

@ -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

4
lisp/buff-menu.el
View File

@ -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)))

2
lisp/calendar/parse-time.el
View File

@ -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)

2
lisp/cedet/pulse.el
View File

@ -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)))

4
lisp/comint.el
View File

@ -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))

16
lisp/completion-preview.el
View File

@ -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

6
lisp/cus-edit.el
View File

@ -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)

2
lisp/custom.el
View File

@ -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

8
lisp/descr-text.el
View File

@ -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))

2
lisp/desktop.el
View File

@ -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))

2
lisp/dired-x.el
View File

@ -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"]

20
lisp/dired.el
View File

@ -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)))))

4
lisp/dnd.el
View File

@ -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))))

2
lisp/dom.el
View File

@ -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)

2
lisp/emacs-lisp/byte-opt.el
View File

@ -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)

6
lisp/emacs-lisp/bytecomp.el
View File

@ -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))

4
lisp/emacs-lisp/comp-common.el
View File

@ -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)

20
lisp/emacs-lisp/comp-cstr.el
View File

@ -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))

6
lisp/emacs-lisp/comp-run.el
View File

@ -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)

72
lisp/emacs-lisp/comp.el
View File

@ -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 (_)

8
lisp/emacs-lisp/edebug.el
View File

@ -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"

8
lisp/emacs-lisp/eieio.el
View File

@ -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.

4
lisp/emacs-lisp/ert-x.el
View File

@ -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/")

34
lisp/emacs-lisp/ert.el
View File

@ -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 "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
(insert (format "<testsuites name=\"%s\" tests=\"%s\" errors=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\">\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))))

26
lisp/emacs-lisp/icons.el
View File

@ -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)))

12
lisp/emacs-lisp/lisp-mode.el
View File

@ -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.

8
lisp/emacs-lisp/loaddefs-gen.el
View File

@ -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'.

6
lisp/emacs-lisp/multisession.el
View File

@ -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.

8
lisp/emacs-lisp/package-vc.el
View File

@ -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...")))))

32
lisp/emacs-lisp/package.el
View File

@ -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))))

4
lisp/emacs-lisp/pp.el
View File

@ -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)))

2
lisp/emacs-lisp/subr-x.el
View File

@ -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

4
lisp/emacs-lisp/tabulated-list.el
View File

@ -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)))

2
lisp/emacs-lisp/timer.el
View File

@ -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

28
lisp/emacs-lisp/vtable.el
View File

@ -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

2
lisp/emacs-lisp/warnings.el
View File

@ -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)

2
lisp/epa-file.el
View File

@ -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.

2
lisp/epa.el
View File

@ -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")))

30
lisp/erc/erc-backend.el
View File

@ -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

40
lisp/erc/erc-button.el
View File

@ -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.

4
lisp/erc/erc-common.el
View File

@ -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))

78
lisp/erc/erc-fill.el
View File

@ -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

58
lisp/erc/erc-goodies.el
View File

@ -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))

8
lisp/erc/erc-ibuffer.el
View File

@ -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)
""))

6
lisp/erc/erc-join.el
View File

@ -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

16
lisp/erc/erc-networks.el
View File

@ -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))

72
lisp/erc/erc-nicks.el
View File

@ -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)))

16
lisp/erc/erc-notify.el
View File

@ -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)))

22
lisp/erc/erc-sasl.el
View File

@ -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)))

14
lisp/erc/erc-services.el
View File

@ -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))

28
lisp/erc/erc-speedbar.el
View File

@ -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)))

92
lisp/erc/erc-stamp.el
View File

@ -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

22
lisp/erc/erc-status-sidebar.el
View File

@ -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)))))

36
lisp/erc/erc-track.el
View File

@ -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)

6
lisp/erc/erc-truncate.el
View File

@ -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

152
lisp/erc/erc.el
View File

@ -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'.

4
lisp/eshell/em-alias.el
View File

@ -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)

4
lisp/eshell/em-glob.el
View File

@ -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)

14
lisp/eshell/em-pred.el
View File

@ -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)

6
lisp/eshell/em-prompt.el
View File

@ -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)

4
lisp/eshell/esh-arg.el
View File

@ -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

14
lisp/eshell/esh-cmd.el
View File

@ -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)))

8
lisp/eshell/esh-io.el
View File

@ -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)

2
lisp/eshell/esh-proc.el
View File

@ -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)

16
lisp/eshell/esh-var.el
View File

@ -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)

2
lisp/faces.el
View File

@ -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)

2
lisp/ffap.el
View File

@ -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 '("~")))

2
lisp/filenotify.el
View File

@ -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

8
lisp/files-x.el
View File

@ -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))))

12
lisp/files.el
View File

@ -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)))))

6
lisp/find-dired.el
View File

@ -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))))))

10
lisp/font-lock.el
View File

@ -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)

4
lisp/gnus/gnus-art.el
View File

@ -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))

2
lisp/gnus/gnus-int.el
View File

@ -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)

14
lisp/gnus/gnus-search.el
View File

@ -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))))

8
lisp/gnus/gnus-sum.el
View File

@ -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)))))))

6
lisp/gnus/gnus.el
View File

@ -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))))))

4
lisp/gnus/message.el
View File

@ -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))

4
lisp/gnus/mml.el
View File

@ -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))))

108
lisp/gnus/nnatom.el
View File

@ -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 "<a href=\"%s\">[%s]</a> "
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 "<a href=\"%s\">[%s]</a> "
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 "<a href=\"%s\">[%s]</a> "
link label))))))))

140
lisp/gnus/nnfeed.el
View File

@ -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)

8
lisp/gnus/nnmh.el
View File

@ -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.

18
lisp/help-fns.el
View File

@ -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)

2
lisp/help-mode.el
View File

@ -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))

6
lisp/help.el
View File

@ -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.

2
lisp/hfy-cmap.el
View File

@ -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))))

26
lisp/ibuf-ext.el
View File

@ -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

6
lisp/ibuf-macs.el
View File

@ -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)

14
lisp/ibuffer.el
View File

@ -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

4
lisp/image.el
View File

@ -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,

4
lisp/image/exif.el
View File

@ -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)

10
lisp/image/image-converter.el
View File

@ -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)

2
lisp/image/image-dired-util.el
View File

@ -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 ()

Some files were not shown because too many files have changed in this diff Show More