commit a6de0d22e4209e2c75dbf1e8c005dfc9d8c64cce (HEAD, refs/remotes/origin/master) Author: F. Jason Park Date: Sun Jun 25 06:43:56 2023 -0700 ; * doc/misc/erc.texi: Mention ERC's own mailing list. diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index e848ed21a50..ddfdb2e2b64 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -1531,7 +1531,9 @@ Getting Help and Reporting Bugs @item You can ask questions about using ERC on the Emacs mailing list, -@uref{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs}. +@uref{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs}, as well +as on ERC's own low-volume list, +@uref{https://lists.gnu.org/mailman/listinfo/emacs-erc}. @item You can visit the IRC Libera.Chat channel @samp{#emacs}. Many of the commit 34416e21da224e5cb9f447f850ef2dbd3db0bbb0 Author: F. Jason Park Date: Sun Jun 25 06:15:11 2023 -0700 Avoid "shadows" warning from erc-button--nick slots * lisp/erc/erc-button.el (erc-button-nick): Rename slots that share names with user options to avoid "lexical argument shadows the dynamic variable" warning. (erc-button-add-nickname-buttons): Remove "erc-button-" namespace from slot accessors. diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 08610860630..0c616a6026d 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -355,11 +355,11 @@ erc-button--nick ( cuser nil :type (or null erc-channel-user) ;; The CDR of a value from an `erc-channel-users' table. :documentation "A possibly nil `erc-channel-user'.") - ( erc-button-face erc-button-face :type symbol + ( face erc-button-face :type symbol :documentation "Temp `erc-button-face' while buttonizing.") - ( erc-button-nickname-face erc-button-nickname-face :type symbol + ( nickname-face erc-button-nickname-face :type symbol :documentation "Temp `erc-button-nickname-face' while buttonizing.") - ( erc-button-mouse-face erc-button-mouse-face :type symbol + ( mouse-face erc-button-mouse-face :type symbol :documentation "Temp `erc-button-mouse-face' while buttonizing.")) ;; This variable is intended to serve as a "core" to be wrapped by @@ -463,11 +463,11 @@ erc-button-add-nickname-buttons (setq bounds (erc-button--nick-bounds obj) data (erc-button--nick-data obj) erc-button-mouse-face - (erc-button--nick-erc-button-mouse-face obj) + (erc-button--nick-mouse-face obj) erc-button-nickname-face - (erc-button--nick-erc-button-nickname-face obj) + (erc-button--nick-nickname-face obj) erc-button-face - (erc-button--nick-erc-button-face obj)))) + (erc-button--nick-face obj)))) (erc-button-add-button (car bounds) (cdr bounds) fun t data)))))))) commit d2a7b0c76d12d15eb4c6d1cd183c192ad4e872ed Author: F. Jason Park Date: Mon Jun 19 23:14:40 2023 -0700 Revert "Allow erc-reuse-frames to favor connections" This (mostly) reverts commit 0e4c07dc7448aafd2aa5f6e101d7b7aac23d8a6b. * etc/ERC-NEWS: Also revert hunk from 52c8d537 "* etc/ERC-NEWS: Add section for ERC 5.6." because it announced this feature, which no longer exists. * lisp/erc/erc.el (erc-reuse-frames): Revise doc string instead of reverting completely. (Bug#62833) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 68f1083621c..68cf0e2d6ca 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -82,14 +82,6 @@ connectivity before attempting to reconnect in earnest. See options 'erc-server-reconnect-function' and 'erc-nickname-in-use-functions' to get started. -** Easily constrain all ERC-related business to a dedicated frame. -The option 'erc-reuse-frames' can now be set to 'displayed', which -tells ERC to show new buffers in frames already occupied by buffers -from the same connection. This customization depends on the option -'erc-buffer-display' (formerly 'erc-join-buffer') being set to -'frame'. If you find the name 'displayed' unhelpful, please suggest -an alternative by writing to the mailing list. - ** Module 'fill' can add a bit of space between messages. On graphical displays, it's now possible to add some breathing room around certain messages via the new option 'erc-fill-line-spacing'. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index a1538962602..70adbb15b5f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1626,23 +1626,14 @@ erc-frame-dedicated-flag (defcustom erc-reuse-frames t "Determines whether new frames are always created. - -A value of t means only create a frame for undisplayed buffers. -`displayed' means use any existing, potentially hidden frame -already displaying a buffer from the same network context or, -failing that, a frame showing any ERC buffer. As a last resort, -`displayed' defaults to the selected frame, except for brand new -connections, for which the invoking frame is always used. When -this option is nil, a new frame is always created. - -Regardless of its value, this option is ignored unless -`erc-join-buffer' is set to `frame'. And like most options in -the `erc-buffer' customize group, this has no effect on server -buffers while reconnecting because those are always buried." - :package-version '(ERC . "5.6") ; FIXME sync on release +Non-nil means only create a frame for undisplayed buffers. Nil +means always create a new frame. Regardless of its value, ERC +ignores this option unless `erc-join-buffer' is `frame'. And +like most options in the `erc-buffer' customize group, this has +no effect on server buffers while reconnecting because ERC always +buries those." :group 'erc-buffers - :type '(choice boolean - (const displayed))) + :type 'boolean) (defun erc-channel-p (channel) "Return non-nil if CHANNEL seems to be an IRC channel name." @@ -2095,35 +2086,6 @@ erc--updating-modules-p confidently call (erc-foo-mode 1) without having to learn anything about the dependency's implementation.") -(defun erc--setup-buffer-first-window (frame a b) - (catch 'found - (walk-window-tree - (lambda (w) - (when (cond ((functionp a) (with-current-buffer (window-buffer w) - (funcall a b))) - (t (eq (buffer-local-value a (window-buffer w)) b))) - (throw 'found t))) - frame nil 0))) - -(defun erc--display-buffer-use-some-frame (buffer alist) - "Maybe display BUFFER in an existing frame for the same connection. -If performed, return window used; otherwise, return nil. Forward ALIST -to display-buffer machinery." - (when-let* - ((idp (lambda (value) - (and erc-networks--id - (erc-networks--id-equal-p erc-networks--id value)))) - (procp (lambda (frame) - (erc--setup-buffer-first-window frame idp erc-networks--id))) - (ercp (lambda (frame) - (erc--setup-buffer-first-window frame 'major-mode 'erc-mode))) - ((or (cdr (frame-list)) (funcall ercp (selected-frame))))) - ;; Workaround to avoid calling `window--display-buffer' directly - (or (display-buffer-use-some-frame buffer - `((frame-predicate . ,procp) ,@alist)) - (display-buffer-use-some-frame buffer - `((frame-predicate . ,ercp) ,@alist))))) - (defvar erc--setup-buffer-hook nil "Internal hook for module setup involving windows and frames.") @@ -2142,21 +2104,15 @@ erc-setup-buffer ('bury nil) ('frame - (cond - ((and (eq erc-reuse-frames 'displayed) - (not (get-buffer-window buffer t))) - (display-buffer buffer '((erc--display-buffer-use-some-frame) - (inhibit-switch-frame . t) - (inhibit-same-window . t)))) - ((or (not erc-reuse-frames) - (not (get-buffer-window buffer t))) + (when (or (not erc-reuse-frames) + (not (get-buffer-window buffer t))) (let ((frame (make-frame (or erc-frame-alist default-frame-alist)))) (raise-frame frame) (select-frame frame)) (switch-to-buffer buffer) (when erc-frame-dedicated-flag - (set-window-dedicated-p (selected-window) t))))) + (set-window-dedicated-p (selected-window) t)))) (_ (if (active-minibuffer-window) (display-buffer buffer) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index f3489a16386..b751ef50520 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -503,309 +503,6 @@ erc--switch-to-buffer (dolist (b '("server" "other" "#chan" "#foo" "#fake")) (kill-buffer b)))) -(defun erc-tests--run-in-term (&optional debug) - (let* ((default-directory (getenv "EMACS_TEST_DIRECTORY")) - (emacs (expand-file-name invocation-name invocation-directory)) - (process-environment (cons "ERC_TESTS_SUBPROCESS=1" - process-environment)) - (name (ert-test-name (ert-running-test))) - (temp-file (make-temp-file "erc-term-test-")) - (cmd `(let ((stats 1)) - (setq enable-dir-local-variables nil) - (unwind-protect - (setq stats (ert-run-tests-batch ',name)) - (unless ',debug - (let ((buf (with-current-buffer (messages-buffer) - (buffer-string)))) - (with-temp-file ,temp-file - (insert buf))) - (kill-emacs (ert-stats-completed-unexpected stats)))))) - ;; `ert-test' object in Emacs 29 has a `file-name' field - (file-name (symbol-file name 'ert--test)) - (default-directory (expand-file-name (file-name-directory file-name))) - (package (if-let* ((found (getenv "ERC_PACKAGE_NAME")) - ((string-prefix-p "erc-" found))) - (intern found) - 'erc)) - (setup (and (featurep 'compat) - `(progn - (require 'package) - (let ((package-load-list '((compat t) (,package t)))) - (package-initialize))))) - ;; Make subprocess terminal bigger than controlling. - (buf (cl-letf (((symbol-function 'window-screen-lines) - (lambda () 20)) - ((symbol-function 'window-max-chars-per-line) - (lambda () 40))) - (make-term (symbol-name name) emacs nil "-Q" "-nw" - "-eval" (prin1-to-string setup) - "-l" file-name "-eval" (format "%S" cmd)))) - (proc (get-buffer-process buf)) - (err (lambda () - (with-temp-buffer - (insert-file-contents temp-file) - (message "Subprocess: %s" (buffer-string)) - (delete-file temp-file))))) - (with-current-buffer buf - (set-process-query-on-exit-flag proc nil) - (with-timeout (10 (funcall err) (error "Timed out awaiting result")) - (while (process-live-p proc) - (accept-process-output proc 0.1))) - (while (accept-process-output proc)) - (goto-char (point-min)) - ;; Otherwise gives process exited abnormally with exit-code >0 - (unless (search-forward (format "Process %s finished" name) nil t) - (funcall err) - (ert-fail (when (search-forward "exited" nil t) - (buffer-substring-no-properties (line-beginning-position) - (line-end-position))))) - (delete-file temp-file) - (when noninteractive - (kill-buffer))))) - -(defun erc-tests--servars (source &rest vars) - (unless (bufferp source) - (setq source (get-buffer source))) - (dolist (var vars) - (should (local-variable-if-set-p var)) - (set var (buffer-local-value var source)))) - -(defun erc-tests--erc-reuse-frames (test &optional debug) - (if (and (or debug noninteractive) (not (getenv "ERC_TESTS_SUBPROCESS"))) - (progn - (when (memq system-type '(windows-nt ms-dos)) - (ert-skip "System must be UNIX")) - (erc-tests--run-in-term debug)) - (should-not erc-frame-dedicated-flag) - (should (eq erc-reuse-frames t)) - (let ((erc-join-buffer 'frame) - (erc-reuse-frames t) - (erc-frame-alist nil) - (orig-frame (selected-frame)) - erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) - (delete-other-frames) - (delete-other-windows) - (set-window-buffer (selected-window) "*scratch*") - (funcall test orig-frame) - (delete-other-frames orig-frame) - (delete-other-windows)))) - -;; TODO add cases for frame-display behavior while reconnecting - -(defun erc-tests--erc-reuse-frames--t (_) - (ert-info ("New server buffer creates and raises second frame") - (with-current-buffer (generate-new-buffer "server") - (erc-mode) - (setq erc-server-process (start-process "server" - (current-buffer) "sleep" "10") - erc-frame-alist (cons '(name . "server") default-frame-alist) - erc-network 'foonet - erc-networks--id (erc-networks--id-create nil) - erc--server-last-reconnect-count 0) - (set-process-buffer erc-server-process (current-buffer)) - (set-process-query-on-exit-flag erc-server-process nil) - (should-not (get-buffer-window (current-buffer) t)) - (erc-setup-buffer (current-buffer)) - (should (equal "server" (frame-parameter (window-frame) 'name))) - (should (get-buffer-window (current-buffer) t)))) - - (ert-info ("New channel creates and raises third frame") - (with-current-buffer (generate-new-buffer "#chan") - (erc-mode) - (erc-tests--servars "server" 'erc-server-process 'erc-networks--id - 'erc-network) - (setq erc-frame-alist (cons '(name . "#chan") default-frame-alist) - erc-default-recipients '("#chan")) - (should-not (get-buffer-window (current-buffer) t)) - (erc-setup-buffer (current-buffer)) - (should (equal "#chan" (frame-parameter (window-frame) 'name))) - (should (get-buffer-window (current-buffer) t)) - (should (cddr (frame-list)))))) - -(ert-deftest erc-reuse-frames--t () - :tags '(:unstable :expensive-test) - (erc-tests--erc-reuse-frames - (lambda (orig-frame) - (erc-tests--erc-reuse-frames--t orig-frame) - (dolist (b '("server" "#chan")) - (kill-buffer b))))) - -(defun erc-tests--erc-reuse-frames--displayed-single (_ server-name chan-name) - - (should (eq erc-reuse-frames 'displayed)) - - (ert-info ("New server buffer shown in existing frame") - (with-current-buffer (generate-new-buffer server-name) - (erc-mode) - (setq erc-server-process (start-process server-name (current-buffer) - "sleep" "10") - erc-frame-alist (cons `(name . ,server-name) default-frame-alist) - erc-network (make-symbol server-name) - erc-server-current-nick "tester" - erc-networks--id (erc-networks--id-create nil) - erc--server-last-reconnect-count 0) - (set-process-buffer erc-server-process (current-buffer)) - (set-process-query-on-exit-flag erc-server-process nil) - (should-not (get-buffer-window (current-buffer) t)) - (erc-setup-buffer (current-buffer)) - (should-not (equal server-name (frame-parameter (window-frame) 'name))) - ;; New server buffer window appears in split below ERT/scratch - (should (get-buffer-window (current-buffer) t)))) - - (ert-info ("New channel shown in existing frame") - (with-current-buffer (generate-new-buffer chan-name) - (erc-mode) - (erc-tests--servars server-name 'erc-server-process 'erc-networks--id - 'erc-network) - (setq erc-frame-alist (cons `(name . ,chan-name) default-frame-alist) - erc-default-recipients (list chan-name)) - (should-not (get-buffer-window (current-buffer) t)) - (erc-setup-buffer (current-buffer)) - (should-not (equal chan-name (frame-parameter (window-frame) 'name))) - ;; New channel buffer replaces server in lower window - (should (get-buffer-window (current-buffer) t)) - (should-not (get-buffer-window server-name t))))) - -(ert-deftest erc-reuse-frames--displayed-single () - :tags '(:unstable :expensive-test) - (erc-tests--erc-reuse-frames - (lambda (orig-frame) - (let ((erc-reuse-frames 'displayed)) - (erc-tests--erc-reuse-frames--displayed-single orig-frame - "server" "#chan") - (should-not (cdr (frame-list)))) - (dolist (b '("server" "#chan")) - (kill-buffer b))))) - -(defun erc-tests--assert-server-split (buffer-or-name frame-name) - ;; Assert current buffer resides on one side of a horizontal split - ;; in the "server" frame but is not selected. - (let* ((buffer-window (get-buffer-window buffer-or-name t)) - (buffer-frame (window-frame buffer-window))) - (should (equal frame-name (frame-parameter buffer-frame 'name))) - (should (memq buffer-window (car-safe (window-tree buffer-frame)))) - (should-not (eq buffer-window (frame-selected-window))) - buffer-frame)) - -(defun erc-tests--erc-reuse-frames--displayed-double (_) - (should (eq erc-reuse-frames 'displayed)) - - (make-frame '((name . "other"))) - (select-frame (make-frame '((name . "server"))) 'no-record) - (set-window-buffer (selected-window) "*scratch*") ; invokes `erc' - - ;; A user invokes an entry point and switches immediately to a new - ;; frame before autojoin kicks in (bug#55540). - - (ert-info ("New server buffer shown in selected frame") - (with-current-buffer (generate-new-buffer "server") - (erc-mode) - (setq erc-server-process (start-process "server" (current-buffer) - "sleep" "10") - erc-network 'foonet - erc-server-current-nick "tester" - erc-networks--id (erc-networks--id-create nil) - erc--server-last-reconnect-count 0) - (set-process-buffer erc-server-process (current-buffer)) - (set-process-query-on-exit-flag erc-server-process nil) - (should-not (get-buffer-window (current-buffer) t)) - (erc-setup-buffer (current-buffer)) - (should (equal "server" (frame-parameter (window-frame) 'name))) - (should (get-buffer-window (current-buffer) t)))) - - (select-frame-by-name "other") - - (ert-info ("New channel shown in dedicated frame") - (with-current-buffer (generate-new-buffer "#chan") - (erc-mode) - (erc-tests--servars "server" 'erc-server-process 'erc-networks--id - 'erc-network) - (setq erc-frame-alist (cons '(name . "#chan") default-frame-alist) - erc-default-recipients '("#chan")) - (should-not (get-buffer-window (current-buffer) t)) - (erc-setup-buffer (current-buffer)) - (erc-tests--assert-server-split (current-buffer) "server") - ;; New channel buffer replaces server in lower window of other frame - (should-not (get-buffer-window "server" t))))) - -(ert-deftest erc-reuse-frames--displayed-double () - :tags '(:unstable :expensive-test) - (erc-tests--erc-reuse-frames - (lambda (orig-frame) - (let ((erc-reuse-frames 'displayed)) - (erc-tests--erc-reuse-frames--displayed-double orig-frame)) - (dolist (b '("server" "#chan")) - (kill-buffer b))))) - -;; If a frame showing ERC buffers exists among other frames, new, -;; additional connections will use the existing IRC frame. However, -;; if two or more frames exist with ERC buffers unique to a particular -;; connection, the correct frame will be found. - -(defun erc-tests--erc-reuse-frames--displayed-full (orig-frame) - (erc-tests--erc-reuse-frames--displayed-double orig-frame) - ;; Server buffer is not displayed because #chan has replaced it in - ;; the "server" frame, which is not selected. - (should (equal "other" (frame-parameter (window-frame) 'name))) - (erc-tests--erc-reuse-frames--displayed-single orig-frame "ircd" "#spam") - (should (equal "other" (frame-parameter (window-frame) 'name))) - - ;; Buffer "#spam" has replaced "ircd", which earlier replaced - ;; "#chan" in frame "server". But this is confusing, so... - (ert-info ("Arrange windows for second connection in other frame") - (set-window-buffer (selected-window) "ircd") - (split-window-below) - (set-window-buffer (next-window) "#spam") - (should (equal (cddar (window-tree)) - (list (get-buffer-window "ircd" t) - (get-buffer-window "#spam" t))))) - - (ert-info ("Arrange windows for first connection in server frame") - (select-frame-by-name "server") - (set-window-buffer (selected-window) "server") - (set-window-buffer (next-window) "#chan") - (should (equal (cddar (window-tree)) - (list (get-buffer-window "server" t) - (get-buffer-window "#chan" t))))) - - ;; Select original ERT frame - (ert-info ("New target for connection server finds appropriate frame") - (select-frame orig-frame 'no-record) - (with-current-buffer (window-buffer (selected-window)) - (should (member (buffer-name) '("*ert*" "*scratch*"))) - (with-current-buffer (generate-new-buffer "alice") - (erc-mode) - (erc-tests--servars "server" 'erc-server-process 'erc-networks--id) - (setq erc-default-recipients '("alice")) - (should-not (get-buffer-window (current-buffer) t)) - (erc-setup-buffer (current-buffer)) - ;; Window created in frame "server" - (should (eq (selected-frame) orig-frame)) - (erc-tests--assert-server-split (current-buffer) "server")))) - - (ert-info ("New target for connection ircd finds appropriate frame") - (select-frame orig-frame 'no-record) - (with-current-buffer (window-buffer (selected-window)) - (should (member (buffer-name) '("*ert*" "*scratch*"))) - (with-current-buffer (generate-new-buffer "bob") - (erc-mode) - (erc-tests--servars "ircd" 'erc-server-process 'erc-networks--id) - (setq erc-default-recipients '("bob")) - (should-not (get-buffer-window (current-buffer) t)) - (erc-setup-buffer (current-buffer)) - ;; Window created in frame "other" - (should (eq (selected-frame) orig-frame)) - (erc-tests--assert-server-split (current-buffer) "other"))))) - -(ert-deftest erc-reuse-frames--displayed-full () - :tags '(:unstable :expensive-test) - (erc-tests--erc-reuse-frames - (lambda (orig-frame) - (let ((erc-reuse-frames 'displayed)) - (erc-tests--erc-reuse-frames--displayed-full orig-frame)) - (dolist (b '("server" "ircd" "bob" "alice" "#spam" "#chan")) - (kill-buffer b))))) - (ert-deftest erc-lurker-maybe-trim () (let (erc-lurker-trim-nicks (erc-lurker-ignore-chars "_`")) commit c64021d58a17d2e4c8f040cf05d7a7458c37b647 Merge: 4c50af02ab0 7220bbe0511 Author: Stefan Monnier Date: Sun Jun 25 11:39:01 2023 -0400 Merge remote-tracking branch 'refs/remotes/origin/master' commit 4c50af02ab08130346715df4c44d602b867477e6 Author: Stefan Monnier Date: Sun Jun 25 11:38:40 2023 -0400 cl-macs.el: Silence recent new "lexical arg shadows" warnings * lisp/emacs-lisp/cl-macs.el (cl--slet): Add `nowarn` arg. (cl--defsubst-expand): Use it. (cl-defstruct): Silence warnings abour lexical shadowing when a slot's name happens to be the same as a dynbound var. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 1de5409f7ee..aadb498609a 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -243,17 +243,20 @@ cl--bind-defs (defvar cl--bind-enquote) ;Non-nil if &cl-quote was in the formal arglist! (defvar cl--bind-lets) (defvar cl--bind-forms) -(defun cl--slet (bindings body) +(defun cl--slet (bindings body &optional nowarn) "Like `cl--slet*' but for \"parallel let\"." - (let ((dyn nil)) ;Is there a var declared as dynbound among the bindings? + (let ((dyns nil)) ;Vars declared as dynbound among the bindings? ;; `seq-some' lead to bootstrap problems. (dolist (binding bindings) - (if (macroexp--dynamic-variable-p (car binding)) (setq dyn t))) + (when (macroexp--dynamic-variable-p (car binding)) + (push (car binding) dyns))) (cond - (dyn - `(funcall (lambda (,@(mapcar #'car bindings)) - ,@(macroexp-unprogn body)) - ,@(mapcar #'cadr bindings))) + (dyns + (let ((form `(funcall (lambda (,@(mapcar #'car bindings)) + ,@(macroexp-unprogn body)) + ,@(mapcar #'cadr bindings)))) + (if (not nowarn) form + `(with-suppressed-warnings ((lexical ,@dyns)) ,form)))) ((null (cdr bindings)) (macroexp-let* bindings body)) (t `(let ,bindings ,@(macroexp-unprogn body)))))) @@ -2920,7 +2923,7 @@ cl--defsubst-expand (if (and whole (not (cl--safe-expr-p (macroexp-progn argvs)))) whole ;; Function arguments are unconditionally statically scoped (bug#47552). - (cl--slet (cl-mapcar #'list argns argvs) body))) + (cl--slet (cl-mapcar #'list argns argvs) body 'nowarn))) ;;; Structures. @@ -3012,6 +3015,7 @@ cl-defstruct (defsym (if cl--struct-inline 'cl-defsubst 'defun)) (forms nil) (docstring (if (stringp (car descs)) (pop descs))) + (dynbound-slotnames '()) pred-form pred-check) ;; Can't use `cl-check-type' yet. (unless (cl--struct-name-p name) @@ -3131,6 +3135,8 @@ cl-defstruct (while descp (let* ((desc (pop descp)) (slot (pop desc))) + (when (macroexp--dynamic-variable-p slot) + (push slot dynbound-slotnames)) (if (memq slot '(cl-tag-slot cl-skip-slot)) (progn (push nil slots) @@ -3261,7 +3267,10 @@ cl-defstruct ;; forms)) `(progn (defvar ,tag-symbol) - ,@(nreverse forms) + ,@(if (null dynbound-slotnames) + (nreverse forms) + `((with-suppressed-warnings ((lexical . ,dynbound-slotnames)) + ,@(nreverse forms)))) :autoload-end ;; Call cl-struct-define during compilation as well, so that ;; a subsequent cl-defstruct in the same file can correctly include this commit 0228421e349e77c00108ea9f6927285a6d04f4b5 Author: Stefan Monnier Date: Sun Jun 25 11:11:03 2023 -0400 Allow suppressing the "lexical arg shadows dynbound var" warning In most cases the right way to fix this warning is by renaming the offending argument, but in some cases this is inconvenient, as is the case in `cl-defstruct` where arg names are imposed by slot names. This patch also happens to fix a few bugs along the way: - miscompilation of (lambda (gcs-done) (lambda (x) (+ x gcs-done))) - errors about void function `byte-compile-warn-x` if the warning was emitted via `cconv-fv` when bytecomp was not loaded. Oh, and it improves the warning by making the location info slightly more precise. * lisp/emacs-lisp/cconv.el (cconv--analyze-function): Remove this warning. * lisp/emacs-lisp/bytecomp.el (byte-compile-check-lambda-list): Warn about it here instead. Let `with-suppressed-warnings` control it under `lexical`. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 64a57948017..659d698b603 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3082,6 +3082,14 @@ byte-compile-check-lambda-list (byte-compile-warn-x arg "repeated variable %s in lambda-list" arg)) (t + (when (and lexical-binding + (cconv--not-lexical-var-p + arg byte-compile-bound-variables) + (byte-compile-warning-enabled-p 'lexical arg)) + (byte-compile-warn-x + arg + "Lexical argument shadows the dynamic variable %S" + arg)) (push arg vars)))) (setq list (cdr list))))) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 601e2c13d61..3e75020a013 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -682,11 +682,6 @@ cconv--analyze-function (when lexical-binding (dolist (arg args) (cond - ((cconv--not-lexical-var-p arg cconv--dynbound-variables) - (byte-compile-warn-x - arg - "Lexical argument shadows the dynamic variable %S" - arg)) ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... (t (let ((varstruct (list arg nil nil nil nil))) (cl-pushnew arg byte-compile-lexical-variables) commit 7220bbe0511e213cf142059c21bfdd63fc494f28 Author: Alan Mackenzie Date: Sun Jun 25 15:06:05 2023 +0000 Correction to patch on 2023-06-21 15:36:56 +0000. This corrects an error where commenting out a template closer left a subsequent closer without a syntax-table text property. * lisp/progmodes/cc-engine.el (c-unmark-<>-around-region): Don't scan from the inside of 2-character comment delimiters. Replace invalid skip-syntax-forward call with a null string argument by an invocation of c-search-forward-non-nil-char-property. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 0eadeafc836..c4ae8aadd65 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -7158,8 +7158,8 @@ c-unmark-<>-around-region (beg-literal-beg (car (cddr lit-search-beg-s))) (lit-search-end-s (c-semi-pp-to-literal lit-search-end)) (end-literal-beg (car (cddr lit-search-end-s))) - (beg-literal-end (c-end-of-literal lit-search-beg-s beg)) - (end-literal-end (c-end-of-literal lit-search-end-s end)) + (beg-literal-end (c-end-of-literal lit-search-beg-s lit-search-beg)) + (end-literal-end (c-end-of-literal lit-search-end-s lit-search-end)) new-beg new-end search-region) ;; Determine any new end of literal resulting from the insertion/deletion. @@ -7212,13 +7212,12 @@ c-unmark-<>-around-region ;; Save current settings of the 'syntax-table property in ;; (BEG END), then splat these with the punctuation value. (goto-char beg) - (while (progn (skip-syntax-forward "" end) - (< (point) end)) - (setq syn-tab-value - (c-get-char-property (point) 'syntax-table)) - (when (not (c-get-char-property (point) 'category)) - (push (cons (point) syn-tab-value) syn-tab-settings)) - (forward-char)) + (while (setq syn-tab-value + (c-search-forward-non-nil-char-property + 'syntax-table end)) + (when (not (c-get-char-property (1- (point)) 'category)) + (push (cons (1- (point)) syn-tab-value) + syn-tab-settings))) (c-put-char-properties beg end 'syntax-table '(1)) ;; If an open string's opener has just been neutralized,