commit f261226d9be4630572df322b2c4f48713c9c2fce (HEAD, refs/remotes/origin/master) Author: Andrew G Cohen Date: Wed May 3 11:37:45 2023 +0800 Allow X-Message-SMTP-Method to include more MTAs * lisp/gnus/message.el (message-multi-smtp-send-mail): Allow the X-Message-SMTP-Method header to override the default mailer with not only smtp and sendmail but other MTAs as well. * doc/misc/message.texi: Document changes to the usage of X-Message-SMTP-Method. diff --git a/doc/misc/message.texi b/doc/misc/message.texi index c3ad8dd6942..8064af53fc6 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi @@ -1948,11 +1948,9 @@ Mail Variables @cindex X-Message-SMTP-Method If you have a complex @acronym{SMTP} setup, and want some messages to go via one mail server, and other messages to go through another, you -can use the @samp{X-Message-SMTP-Method} header. These are the -supported values: - -@table @samp -@item smtpmail +can use the @samp{X-Message-SMTP-Method} header to override the +default by using the keyword @samp{smtp} followed by the server +information: @example X-Message-SMTP-Method: smtp smtp.fsf.org 587 @@ -1968,16 +1966,19 @@ Mail Variables name when authenticating. This is handy if you have several @acronym{SMTP} accounts on the same server. -@item sendmail +This header may also be used to specify an alternative MTA by using a +@samp{mailer} keyword, where @samp{mailer} is the name of an MTA with +a corresponding @code{message-send-mail-with-'mailer'} function. For +example: @example X-Message-SMTP-Method: sendmail @end example -This will send the message via the locally installed sendmail/exim/etc -installation. +will send the message via the locally installed sendmail program. The +recognized values of @samp{mailer} are sendmail, qmail, mh, and +mailclient. -@end table @item message-mh-deletable-headers @vindex message-mh-deletable-headers diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index b35424a8581..45cc21701b3 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -5009,30 +5009,34 @@ message-multi-smtp-send-mail "Send the current buffer to `message-send-mail-function'. Or, if there's a header that specifies a different method, use that instead." - (let ((method (message-field-value "X-Message-SMTP-Method"))) + (let ((method (message-field-value "X-Message-SMTP-Method")) + send-function) (if (not method) - (funcall message-send-mail-function) + (funcall message-send-mail-function) (message-remove-header "X-Message-SMTP-Method") (setq method (split-string method)) + (setq send-function + (symbol-function + (intern-soft (format "message-send-mail-with-%s" (car method))))) (cond - ((equal (car method) "sendmail") - (message-send-mail-with-sendmail)) ((equal (car method) "smtp") - (require 'smtpmail) - (let* ((smtpmail-store-queue-variables t) + (require 'smtpmail) + (let* ((smtpmail-store-queue-variables t) (smtpmail-smtp-server (nth 1 method)) - (service (nth 2 method)) - (port (string-to-number service)) - ;; If we're talking to the TLS SMTP port, then force a - ;; TLS connection. - (smtpmail-stream-type (if (= port 465) - 'tls - smtpmail-stream-type)) - (smtpmail-smtp-service (if (> port 0) port service)) - (smtpmail-smtp-user (or (nth 3 method) smtpmail-smtp-user))) - (message-smtpmail-send-it))) + (service (nth 2 method)) + (port (string-to-number service)) + ;; If we're talking to the TLS SMTP port, then force a + ;; TLS connection. + (smtpmail-stream-type (if (= port 465) + 'tls + smtpmail-stream-type)) + (smtpmail-smtp-service (if (> port 0) port service)) + (smtpmail-smtp-user (or (nth 3 method) smtpmail-smtp-user))) + (message-smtpmail-send-it))) + (send-function + (funcall send-function)) (t - (error "Unknown method %s" method)))))) + (error "Unknown mail method %s" method)))))) (defun message-send-mail-with-sendmail () "Send off the prepared buffer with sendmail." commit 8d1332d135f81d42f3ca5fe0b0906d0e48b44043 Merge: 53cc61d60db ba44b481844 Author: Dmitry Gutov Date: Sat May 6 03:59:59 2023 +0300 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 53cc61d60dbfe94e5bf47cf167f816837540d2b3 Author: Dmitry Gutov Date: Sat May 6 03:54:59 2023 +0300 package-upgrade: Implement the upgrading of built-ins * lisp/emacs-lisp/package.el (package--upgradeable-packages): Add new argument. When INCLUDE-BUILTINS is non-nil, also search among package--builtins (bug#62720). (package-upgrade): Use the new argument. Bind package-install-upgrade-built-in when necessary. Mark the package as selected if it was previously an "active built-in". (package-upgrade-all): Update the docstring. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 0cd54c3fbe2..2892728ebd9 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2263,25 +2263,26 @@ package-install ;;;###autoload (defun package-upgrade (name) - "Upgrade package NAME if a newer version exists. - -Currently, packages which are part of the Emacs distribution -cannot be upgraded that way. To enable upgrades of such a -package using this command, first upgrade the package to a -newer version from ELPA by using `\\\\[package-menu-mark-install]' after `\\[list-packages]'." + "Upgrade package NAME if a newer version exists." (interactive (list (completing-read - "Upgrade package: " (package--upgradeable-packages) nil t))) + "Upgrade package: " (package--upgradeable-packages t) nil t))) (let* ((package (if (symbolp name) name (intern name))) - (pkg-desc (cadr (assq package package-alist)))) - (if (package-vc-p pkg-desc) + (pkg-desc (cadr (assq package package-alist))) + (package-install-upgrade-built-in (not pkg-desc))) + ;; `pkg-desc' will be nil when the package is an "active built-in". + (if (and pkg-desc (package-vc-p pkg-desc)) (package-vc-upgrade pkg-desc) - (package-delete pkg-desc 'force 'dont-unselect) - (package-install package 'dont-select)))) - -(defun package--upgradeable-packages () + (when pkg-desc + (package-delete pkg-desc 'force 'dont-unselect)) + (package-install package + ;; An active built-in has never been "selected" + ;; before. Mark it as installed explicitly. + (and pkg-desc 'dont-select))))) + +(defun package--upgradeable-packages (&optional include-builtins) ;; Initialize the package system to get the list of package ;; symbols for completion. (package--archives-initialize) @@ -2292,11 +2293,21 @@ package--upgradeable-packages (or (let ((available (assq (car elt) package-archive-contents))) (and available - (version-list-< - (package-desc-version (cadr elt)) - (package-desc-version (cadr available))))) - (package-vc-p (cadr (assq (car elt) package-alist))))) - package-alist))) + (or (and + include-builtins + (not (package-desc-version (cadr elt)))) + (version-list-< + (package-desc-version (cadr elt)) + (package-desc-version (cadr available)))))) + (package-vc-p (cadr elt)))) + (if include-builtins + (append package-alist + (mapcan + (lambda (elt) + (when (not (assq (car elt) package-alist)) + (list (list (car elt) (package--from-builtin elt))))) + package--builtins)) + package-alist)))) ;;;###autoload (defun package-upgrade-all (&optional query) @@ -2306,8 +2317,9 @@ package-upgrade-all Currently, packages which are part of the Emacs distribution are not upgraded by this command. To enable upgrading such a package -using this command, first upgrade the package to a newer version -from ELPA by using `\\\\[package-menu-mark-install]' after `\\[list-packages]'." +using this command, first upgrade the package to a newer version +from ELPA by either using `\\[package-upgrade]' or +`\\\\[package-menu-mark-install]' after `\\[list-packages]'." (interactive (list (not noninteractive))) (package-refresh-contents) (let ((upgradeable (package--upgradeable-packages))) commit 0c6311386a12560c6578ffe50996c1f2c841ddfe Merge: 3baab6c432b 79a886ba368 Author: Dmitry Gutov Date: Sat May 6 03:41:54 2023 +0300 Merge from origin/emacs-29 79a886ba368 (package-upgrade): Don't remove the package from 'package... c0ab4e9ca93 Eglot: re-rename eglot-upgrade to eglot-upgrade-eglot b4e90070f96 Fix arguments of xml.c functions as displayed in Help buf... b1bda8228e5 More fixes for NetBSD/vax a2d4cd06f45 Improve VHDL mode highlighting 2f3a514b6db Clarify documentation wrt floating point division by zero... 94e984e6700 Make loaddefs-generate slightly more tolerant aba41d2c4bb ; Minor doc cleanups in go-ts-mode.el b42ccb2e5c1 ; Minor grammar fix in treesit manual. ab44c8a6f9d Fix order of rcirc-connect arguments 8eb6e33691d Fix rcirc messages printing in the wrong place 2901a3443c7 Prevent unnecessary modifications of 'package-vc-selected... eaad302bd6f Rename eglot-update to eglot-upgrade eaf25b9c6ae go-ts-mode: Use iota query only if supported (Bug#63086) cc090294d77 (rng-complete-tag): Add the (ignored) argument to the :co... 21ec6c1d5cc Update to Transient v0.3.7-219-g3ded15b 8d5aa8df4ad Fix inserting selection data into Mozilla programs 57562c3fd0a Recognize defstruct slot names in various eieio functions b93eb68cc30 Use 'calendar-buffer' instead of fixed string # Conflicts: # etc/EGLOT-NEWS commit 3baab6c432b7763f5435a0f4ffb055d2e33fab69 Merge: 47c424f5ec8 e338a8ac41d Author: Dmitry Gutov Date: Sat May 6 03:36:29 2023 +0300 ; Merge from origin/emacs-29 The following commit was skipped: e338a8ac41d Handle point not at EOB in minibuffer-choose-completion commit 47c424f5ec838c584d67adb3cc94d68b62996f8a Merge: 1ef219e220c fceaf230b06 Author: Dmitry Gutov Date: Sat May 6 03:36:29 2023 +0300 Merge from origin/emacs-29 fceaf230b06 Note that Emacs pauses when handling sentinel errors commit 79a886ba36837c0e13d83172ab33c1c2680c6e62 Author: Dmitry Gutov Date: Sat May 6 03:32:08 2023 +0300 (package-upgrade): Don't remove the package from 'package-selected-packages' * lisp/emacs-lisp/package.el (package-upgrade): Don't remove the package from 'package-selected-packages', fixing the problem described in https://debbugs.gnu.org/62720#718. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 0919ce34448..bbe2b8bb4af 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2282,7 +2282,7 @@ package-upgrade (pkg-desc (cadr (assq package package-alist)))) (if (package-vc-p pkg-desc) (package-vc-upgrade pkg-desc) - (package-delete pkg-desc 'force) + (package-delete pkg-desc 'force 'dont-unselect) (package-install package 'dont-select)))) (defun package--upgradeable-packages () commit ba44b4818446afdda4ff04c92d4ea34803fbc9db Author: F. Jason Park Date: Fri Apr 28 06:34:09 2023 -0700 Add interface for finding users in erc-server-PRIVMSG * lisp/erc/erc-backend.el (erc-server-PRIVMSG): Call new hook `erc--user-from-nick-function' for turning the sender's nick into a channel user, if any. * lisp/erc/erc-button.el (erc-button--add-phantom-speaker): Redo completely using simplified API. (erc-button--fallback-user-function): Add internal function-interface variable for finding an `erc-server-user' object when the usual places disappoint. (erc-button--get-phantom-user): Add new function, a getter for `erc-button--phantom-users'. (erc-button--phantom-users-mode): Replace advice subscription for `erc-button--modify-nick-function' with one for `erc-button--user-from-nick-function' and one for `erc-button--fallback-user-function'. (erc-button--get-user-from-speaker-naive): Remove unused function. (erc-button--add-nickname-buttons): Call `erc-button--fallback-user-function' when a user can't be found in `erc-server-users' or `erc-channel-users'. * lisp/erc/erc.el (erc--user-from-nick-function): New function-interface variable for determining an `erc-server-user' `erc-channel-user' pair from the sender's nick. (erc--examine-nick): Add new function to serve as default value for `erc--user-from-nick-function'. (Bug#60933) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index bc8e603e10a..2de24e7cb25 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -102,6 +102,7 @@ (require 'erc-common) (defvar erc--target) +(defvar erc--user-from-nick-function) (defvar erc-channel-list) (defvar erc-channel-users) (defvar erc-default-nicks) @@ -1912,7 +1913,8 @@ define-erc-response-handler ;; at this point. (erc-update-channel-member (if privp nick tgt) nick nick privp nil nil nil nil nil host login nil nil t) - (let ((cdata (erc-get-channel-user nick))) + (let ((cdata (funcall erc--user-from-nick-function + (erc-downcase nick) sndr parsed))) (setq fnick (funcall erc-format-nick-function (car cdata) (cdr cdata)))))) (cond diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index c7f6685c851..4307dc3b860 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -350,55 +350,56 @@ erc-button--modify-nick-function (defvar-local erc-button--phantom-users nil) -(defun erc-button--add-phantom-speaker (args) - "Maybe substitute fake `server-user' for speaker at point." - (pcase (car args) - ((and obj (cl-struct erc-button--nick bounds downcased (user 'nil))) - ;; Like `with-memoization' but don't cache when value is nil. - (when-let ((user (or (gethash downcased erc-button--phantom-users) - (erc-button--get-user-from-speaker-naive - (car bounds))))) - (cl-assert (null (erc-button--nick-data obj))) - (puthash downcased user erc-button--phantom-users) - (setf (erc-button--nick-data obj) (list (erc-server-user-nickname user)) - (erc-button--nick-user obj) user)) - (list obj)) - (_ args))) - +(defvar erc-button--fallback-user-function #'ignore + "Function to determine `erc-server-user' if not found in the usual places. +Called with DOWNCASED-NICK, NICK, and NICK-BOUNDS when +`erc-button-add-nickname-buttons' cannot find a user object for +DOWNCASED-NICK in `erc-channel-users' or `erc-server-users'.") + +(defun erc-button--add-phantom-speaker (downcased nuh _parsed) + "Stash fictitious `erc-server-user' while processing \"PRIVMSG\". +Expect DOWNCASED to be the downcased nickname, NUH to be a triple +of (NICK LOGIN HOST), and parsed to be an `erc-response' object." + (pcase-let* ((`(,nick ,login ,host) nuh) + (user (or (gethash downcased erc-button--phantom-users) + (make-erc-server-user + :nickname nick + :host (and (not (string-empty-p host)) host) + :login (and (not (string-empty-p login)) login))))) + (list (puthash downcased user erc-button--phantom-users)))) + +(defun erc-button--get-phantom-user (down _word _bounds) + (gethash down erc-button--phantom-users)) + +;; In the future, we'll most likely create temporary +;; `erc-channel-users' tables during BATCH chathistory playback, thus +;; obviating the need for this mode entirely. (define-minor-mode erc-button--phantom-users-mode "Minor mode to recognize unknown speakers. Expect to be used by module setup code for creating placeholder users on the fly during history playback. Treat an unknown -PRIVMSG speaker, like , as if they were present in a 353 and -are thus a member of the channel. However, don't bother creating -an actual `erc-channel-user' object because their status prefix -is unknown. Instead, just spoof an `erc-server-user' by applying -early (outer), args-filtering advice wrapping -`erc-button--modify-nick-function'." +\"PRIVMSG\" speaker, like \"\", as if they previously +appeared in a prior \"353\" message and are thus a known member +of the channel. However, don't bother creating an actual +`erc-channel-user' object because their status prefix is unknown. +Instead, just spoof an `erc-server-user' and stash it during +\"PRIVMSG\" handling via `erc--user-from-nick-function' and +retrieve it during buttonizing via +`erc-button--fallback-user-function'." :interactive nil (if erc-button--phantom-users-mode (progn - (add-function :filter-args (local 'erc-button--modify-nick-function) - #'erc-button--add-phantom-speaker '((depth . -90))) + (add-function :after-until (local 'erc--user-from-nick-function) + #'erc-button--add-phantom-speaker '((depth . -50))) + (add-function :after-until (local 'erc-button--fallback-user-function) + #'erc-button--get-phantom-user '((depth . 50))) (setq erc-button--phantom-users (make-hash-table :test #'equal))) - (remove-function (local 'erc-button--modify-nick-function) + (remove-function (local 'erc--user-from-nick-function) #'erc-button--add-phantom-speaker) + (remove-function (local 'erc-button--fallback-user-function) + #'erc-button--get-phantom-user) (kill-local-variable 'erc-nicks--phantom-users))) -;; FIXME replace this after making ERC account-aware. -(defun erc-button--get-user-from-speaker-naive (point) - "Return `erc-server-user' object for nick at POINT." - (when-let* - (((eql ?< (char-before point))) - ((eq (get-text-property point 'font-lock-face) 'erc-nick-default-face)) - (parsed (erc-get-parsed-vector point))) - (pcase-let* ((`(,nick ,login ,host) - (erc-parse-user (erc-response.sender parsed)))) - (make-erc-server-user - :nickname nick - :host (and (not (string-empty-p host)) host) - :login (and (not (string-empty-p login)) login))))) - (defun erc-button-add-nickname-buttons (entry) "Search through the buffer for nicknames, and add buttons." (let ((form (nth 2 entry)) @@ -422,7 +423,9 @@ erc-button-add-nickname-buttons (gethash down erc-channel-users))) (user (or (and cuser (car cuser)) (and erc-server-users - (gethash down erc-server-users)))) + (gethash down erc-server-users)) + (funcall erc-button--fallback-user-function + down word bounds))) (data (list word))) (when (or (not (functionp form)) (and-let* ((user) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 72ec8134eab..dbf413bac74 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4993,6 +4993,16 @@ erc-is-message-ctcp-and-not-action-p (and (erc-is-message-ctcp-p message) (not (string-match "^\C-aACTION.*\C-a$" message)))) +(defvar erc--user-from-nick-function #'erc--examine-nick + "Function to possibly consider unknown user. +Must return either nil or a cons of an `erc-server-user' and a +possibly nil `erc-channel-user' for formatting a server user's +nick. Called in the appropriate buffer with the downcased nick, +the parsed NUH, and the original `erc-response' object.") + +(defun erc--examine-nick (downcased _nuh _parsed) + (and erc-channel-users (gethash downcased erc-channel-users))) + (defun erc-format-privmessage (nick msg privp msgp) "Format a PRIVMSG in an insertable fashion." (let* ((mark-s (if msgp (if privp "*" "<") "-")) commit d141f7149b67daa93ac13420ee5edf4b0cbbf011 Author: F. Jason Park Date: Sat Apr 15 09:52:05 2023 -0700 Improve erc-button--modify-nick-function interface * lisp/erc/erc-button.el (erc-button--check-nicknames-entry): Remove unused let binding. (erc-button--preserve-bounds): Remove unused function. (erc-button--nick): New struct type to serve as collection plate for `erc-button--modify-nick-function' consumers. (erc-button--modify-nick-function): Reexplain interface, now based on `erc-button--nick' object. Change default value to `identity'. (erc-button--add-phantom-speaker): Redo to expect `erc-button--nick' object. (erc-button-add-nickname-buttons): Rework slightly to construct an `erc-button--nick' object for feeding to `erc-button--modify-nick-function'. Only run the latter when an `erc-server-user' has successfully been found. (Bug#60933) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 7376c18ad4c..c7f6685c851 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -299,16 +299,39 @@ erc-button--maybe-warn-arbitrary-sexp (defun erc-button--check-nicknames-entry () ;; This helper exists because the module is defined after its options. - (when-let (((eq major-mode 'erc-mode)) - (entry (alist-get 'nicknames erc-button-alist))) - (unless (eq 'erc-button-buttonize-nicks (nth 1 entry)) + (when (eq major-mode 'erc-mode) + (unless (eq (nth 1 (alist-get 'nicknames erc-button-alist)) + 'erc-button-buttonize-nicks) (erc-button--display-error-notice-with-keys-and-warn "Values other than `erc-button-buttonize-nicks' in the third slot of " "the `nicknames' entry of `erc-button-alist' are deprecated.")))) -(defun erc-button--preserve-bounds (bounds _ server-user _) - "Return BOUNDS.\n\n(fn BOUNDS NICKNAME SERVER-USER CHANNEL-USER)" - (and server-user bounds)) +(cl-defstruct erc-button--nick + ( bounds nil :type cons + ;; Indicates the nick's position in the current message. BEG is + ;; normally also point. + :documentation "A cons of (BEG . END).") + ( data nil :type (or null cons) + ;; When non-nil, the CAR must be a non-casemapped nickname. For + ;; compatibility, the CDR should probably be nil, but this may + ;; have to change eventually. If non-nil, the entire cons should + ;; be mutated rather than replaced because it's used as a key in + ;; hash tables and text-property searches. + :documentation "A unique cons whose car is a nickname.") + ( downcased nil :type (or null string) + :documentation "The case-mapped nickname sans text properties.") + ( user nil :type (or null erc-server-user) + ;; Not necessarily present in `erc-server-users'. + :documentation "A possibly nil or spoofed `erc-server-user'.") + ( 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 + :documentation "Temp `erc-button-face' while buttonizing.") + ( erc-button-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 + :documentation "Temp `erc-button-mouse-face' while buttonizing.")) ;; This variable is intended to serve as a "core" to be wrapped by ;; (built-in) modules during setup. It's unclear whether @@ -317,31 +340,29 @@ erc-button--preserve-bounds ;; mostly concerned with ensuring one "piece" precedes or follows ;; another (specific piece), which may not yet (or ever) be present. -(defvar erc-button--modify-nick-function #'erc-button--preserve-bounds +(defvar erc-button--modify-nick-function #'identity "Function to possibly modify aspects of nick being buttonized. -Called with four args: BOUNDS NICKNAME SERVER-USER CHANNEL-USER. -BOUNDS is a cons of (BEG . END) marking the position of the nick -in the current message, which occupies the whole of the narrowed -buffer. BEG is normally also point. NICKNAME is a case-mapped -string without text properties. SERVER-USER and CHANNEL-USER are -the nick's `erc-server-users' entry and its associated (though -possibly nil) `erc-channel-user' object. The function should -return BOUNDS or a suitable replacement to indicate that -buttonizing ought to proceed, and nil if it should be inhibited.") +Called with one argument, an `erc-button--nick' object, or nil. +The function should return the same (or similar) object when +buttonizing ought to proceed and nil otherwise. While running, +all faces defined in `erc-button' are bound temporarily and can +be updated at will.") (defvar-local erc-button--phantom-users nil) (defun erc-button--add-phantom-speaker (args) "Maybe substitute fake `server-user' for speaker at point." - (pcase args - (`(,bounds ,downcased-nick nil ,channel-user) - (list bounds downcased-nick - ;; Like `with-memoization' but don't cache when value is nil. - (or (gethash downcased-nick erc-button--phantom-users) - (and-let* ((user (erc-button--get-user-from-speaker-naive - (car bounds)))) - (puthash downcased-nick user erc-button--phantom-users))) - channel-user)) + (pcase (car args) + ((and obj (cl-struct erc-button--nick bounds downcased (user 'nil))) + ;; Like `with-memoization' but don't cache when value is nil. + (when-let ((user (or (gethash downcased erc-button--phantom-users) + (erc-button--get-user-from-speaker-naive + (car bounds))))) + (cl-assert (null (erc-button--nick-data obj))) + (puthash downcased user erc-button--phantom-users) + (setf (erc-button--nick-data obj) (list (erc-server-user-nickname user)) + (erc-button--nick-user obj) user)) + (list obj)) (_ args))) (define-minor-mode erc-button--phantom-users-mode @@ -401,12 +422,24 @@ erc-button-add-nickname-buttons (gethash down erc-channel-users))) (user (or (and cuser (car cuser)) (and erc-server-users - (gethash down erc-server-users))))) + (gethash down erc-server-users)))) + (data (list word))) (when (or (not (functionp form)) - (setq bounds - (funcall form bounds down user (cdr cuser)))) + (and-let* ((user) + (obj (funcall form (make-erc-button--nick + :bounds bounds :data data + :downcased down :user user + :cuser (cdr cuser))))) + (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-nickname-face + (erc-button--nick-erc-button-nickname-face obj) + erc-button-face + (erc-button--nick-erc-button-face obj)))) (erc-button-add-button (car bounds) (cdr bounds) - fun t (list word))))))))) + fun t data)))))))) (defun erc-button-add-buttons-1 (regexp entry) "Search through the buffer for matches to ENTRY and add buttons." commit 5adda2f4683fe23efd659fc7418044c8230772c5 Author: F. Jason Park Date: Sat Apr 15 09:52:05 2023 -0700 Revise FORM-as-function interface in erc-button-alist * lisp/erc/erc-button.el (erc-button-alist): Remove redundant "" entry, which adds nothing beyond highlighting the surrounding bookends at the expense of doubling up on face properties for no reason. Revise the FORM-as-function interface by removing the dynamic binding of face options and treating all implementers as replacements for `erc-button-add-button'. (erc-button--maybe-warn-arbitrary-sexp): Make more robust by having it handle all accepted FORM types other than booleans. (erc-button-add-buttons-1): Rework to only check FORM field once. (erc-button--substitute-command-keys-in-region, erc-button--display-error-with-buttons): Rename former as latter and change signature to conform to new `erc-button-add-buttons' interface. (erc-button--display-error-notice-with-keys): Call renamed helper. * test/lisp/erc/erc-button-tests.el (erc-button-alist--url, erc-button-tests--form, erc-button-tests--some-var, erc-button-tests--erc-button-alist--function-as-form, erc-button-alist--function-as-form, erc-button-tests--erc-button-alist--nil-form, erc-button-alist---nil-form): Add tests and helpers. (Bug#60933) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 3907b7bc5f2..f2a8eb72b95 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -209,7 +209,8 @@ changes are encouraged to voice their concerns on the bug list. Two helper macros from GNU ELPA's Compat library are now available to third-party modules as 'erc-compat-call' and 'erc-compat-function'. In the area of buttons, 'Info-goto-node' has been supplanted by plain -old 'info' in 'erc-button-alist', primarily for autoloading purposes. +old 'info' in 'erc-button-alist', and the bracketed "" +pattern entry has been removed because it was more or less redundant. And the "TAB" key is now bound to a new command, 'erc-tab', that only calls 'completion-at-point' when point is in the input area and module-specific commands, like 'erc-button-next', otherwise. diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index e2447deecde..7376c18ad4c 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -128,7 +128,6 @@ erc-button-alist ;; things hard to maintain. '((nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0) (erc-button-url-regexp 0 t browse-url-button-open-url 0) - (" ]+\\) *>" 0 t browse-url-button-open-url 1) ;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3) ;; emacs internal ("[`‘]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)['’]" @@ -166,17 +165,14 @@ erc-button-alist BUTTON is the number of the regexp grouping actually matching the button. This is ignored if REGEXP is `nicknames'. -FORM is a Lisp symbol for a special variable whose value must be - true for the button to be added. Alternatively, when REGEXP is - not `nicknames', FORM can be a function whose arguments are BEG - and END, the bounds of the button in the current buffer. It's - expected to return a cons of (possibly identical) bounds or - nil, to deny. For the extent of the call, all face options - defined for the button module are re-bound, shadowing - themselves, so the function is free to change their values. - When regexp is the special symbol `nicknames', FORM must be the - symbol `erc-button-buttonize-nicks'. Specifying anything else - is deprecated. +FORM is either a boolean or a special variable whose value must + be non-nil for the button to be added. When REGEXP is the + special symbol `nicknames', FORM must be the symbol + `erc-button-buttonize-nicks'. Anything else is deprecated. + For all other entries, FORM can also be a function to call in + place of `erc-button-add-button' with the exact same arguments. + When FORM is also a special variable, ERC disregards the + variable and calls the function. CALLBACK is the function to call when the user push this button. CALLBACK can also be a symbol. Its variable value will be used @@ -288,15 +284,18 @@ erc-button-add-buttons entry))))))))))) (defun erc-button--maybe-warn-arbitrary-sexp (form) - (if (and (symbolp form) (special-variable-p form)) - (symbol-value form) - (unless (get 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp) - (put 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp t) - (lwarn 'erc :warning - (concat "Arbitrary sexps for the third FORM" - " slot of `erc-button-alist' entries" - " have been deprecated."))) - (eval form t))) + (cl-assert (not (booleanp form))) ; covered by caller + ;; If a special-variable is also a function, favor the function. + (cond ((functionp form) form) + ((and (symbolp form) (special-variable-p form)) (symbol-value form)) + (t (unless (get 'erc-button--maybe-warn-arbitrary-sexp + 'warned-arbitrary-sexp) + (put 'erc-button--maybe-warn-arbitrary-sexp + 'warned-arbitrary-sexp t) + (lwarn 'erc :warning (concat "Arbitrary sexps for the third FORM" + " slot of `erc-button-alist' entries" + " have been deprecated."))) + (eval form t)))) (defun erc-button--check-nicknames-entry () ;; This helper exists because the module is defined after its options. @@ -412,22 +411,22 @@ erc-button-add-nickname-buttons (defun erc-button-add-buttons-1 (regexp entry) "Search through the buffer for matches to ENTRY and add buttons." (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (let ((start (match-beginning (nth 1 entry))) - (end (match-end (nth 1 entry))) - (form (nth 2 entry)) - (fun (nth 3 entry)) - (data (mapcar #'match-string-no-properties (nthcdr 4 entry)))) - (when (or (eq t form) - (and (functionp form) - (let* ((erc-button-face erc-button-face) - (erc-button-mouse-face erc-button-mouse-face) - (erc-button-nickname-face erc-button-nickname-face) - (rv (funcall form start end))) - (when rv - (setq end (cdr rv) start (car rv))))) - (erc-button--maybe-warn-arbitrary-sexp form)) - (erc-button-add-button start end fun nil data regexp))))) + (let (buttonizer) + (while + (and (re-search-forward regexp nil t) + (or buttonizer + (setq buttonizer + (and-let* + ((raw-form (nth 2 entry)) + (res (or (eq t raw-form) + (erc-button--maybe-warn-arbitrary-sexp + raw-form)))) + (if (functionp res) res #'erc-button-add-button))))) + (let ((start (match-beginning (nth 1 entry))) + (end (match-end (nth 1 entry))) + (fun (nth 3 entry)) + (data (mapcar #'match-string-no-properties (nthcdr 4 entry)))) + (funcall buttonizer start end fun nil data regexp))))) (defun erc-button-remove-old-buttons () "Remove all existing buttons. @@ -682,15 +681,15 @@ erc-button-beats-to-time (message "@%s is %d:%02d local time" beats hours minutes))) -(defun erc-button--substitute-command-keys-in-region (beg end) +(defun erc-button--display-error-with-buttons + (from to fun nick-p &optional data regexp) "Replace command in region with keys and return new bounds" - (let* ((o (buffer-substring beg end)) - (s (substitute-command-keys o))) - (unless (equal o s) - (setq erc-button-face nil)) - (delete-region beg end) - (insert s)) - (cons beg (point))) + (let* ((o (buffer-substring from to)) + (s (substitute-command-keys o)) + (erc-button-face (and (equal o s) erc-button-face))) + (delete-region from to) + (insert s) + (erc-button-add-button from (point) fun nick-p data regexp))) ;;;###autoload (defun erc-button--display-error-notice-with-keys (&optional parsed buffer @@ -727,7 +726,7 @@ erc-button--display-error-notice-with-keys erc-insert-post-hook)) (erc-button-alist `((,(rx "\\[" (group (+ (not "]"))) "]") 0 - erc-button--substitute-command-keys-in-region + erc-button--display-error-with-buttons erc-button-describe-symbol 1) ,@erc-button-alist))) (erc-display-message parsed '(notice error) (or buffer 'active) string) diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el index ced08d117bc..6a6f6934389 100644 --- a/test/lisp/erc/erc-button-tests.el +++ b/test/lisp/erc/erc-button-tests.el @@ -23,6 +23,112 @@ (require 'erc-button) +(ert-deftest erc-button-alist--url () + (setq erc-server-process + (start-process "sleep" (current-buffer) "sleep" "1")) + (set-process-query-on-exit-flag erc-server-process nil) + (with-current-buffer (erc--open-target "#chan") + (let ((verify + (lambda (p url) + (should (equal (get-text-property p 'erc-data) (list url))) + (should (equal (get-text-property p 'mouse-face) 'highlight)) + (should (eq (get-text-property p 'font-lock-face) 'erc-button)) + (should (eq (get-text-property p 'erc-callback) + 'browse-url-button-open-url))))) + (goto-char (point-min)) + + ;; Most common (unbracketed) + (erc-display-message nil nil (current-buffer) + "Foo https://example.com bar.") + (search-forward "https") + (funcall verify (point) "https://example.com") + + ;; The still works despite being removed in ERC 5.6. + (erc-display-message nil nil (current-buffer) + "Foo bar.") + (search-forward "https") + (funcall verify (point) "https://gnu.org") + + ;; Bracketed + (erc-display-message nil nil (current-buffer) "Foo bar.") + (search-forward "ftp") + (funcall verify (point) "ftp://gnu.org")) + + (when noninteractive + (kill-buffer)))) + +(defvar erc-button-tests--form nil) +(defvar erc-button-tests--some-var nil) + +(defun erc-button-tests--form (&rest rest) + (push rest erc-button-tests--form) + (apply #'erc-button-add-button rest)) + +(defun erc-button-tests--erc-button-alist--function-as-form (func) + (setq erc-server-process + (start-process "sleep" (current-buffer) "sleep" "1")) + (set-process-query-on-exit-flag erc-server-process nil) + + (with-current-buffer (erc--open-target "#chan") + (let* ((erc-button-tests--form nil) + (entry (list (rx "+1") 0 func #'ignore 0)) + (erc-button-alist (cons entry erc-button-alist))) + + (erc-display-message nil 'notice (current-buffer) "Foo bar baz") + (erc-display-message nil nil (current-buffer) "+1") + (erc-display-message nil 'notice (current-buffer) "Spam") + (should (equal (pop erc-button-tests--form) + '(53 55 ignore nil ("+1") "\\+1"))) + (should-not erc-button-tests--form) + (goto-char (point-min)) + (search-forward "+") + (should (equal (get-text-property (point) 'erc-data) '("+1"))) + (should (equal (get-text-property (point) 'mouse-face) 'highlight)) + (should (eq (get-text-property (point) 'font-lock-face) 'erc-button)) + (should (eq (get-text-property (point) 'erc-callback) 'ignore))) + + (when noninteractive + (kill-buffer)))) + +(ert-deftest erc-button-alist--function-as-form () + (erc-button-tests--erc-button-alist--function-as-form + #'erc-button-tests--form) + + (erc-button-tests--erc-button-alist--function-as-form + (symbol-function #'erc-button-tests--form)) + + (erc-button-tests--erc-button-alist--function-as-form + (lambda (&rest r) (push r erc-button-tests--form) + (apply #'erc-button-add-button r)))) + +(defun erc-button-tests--erc-button-alist--nil-form (form) + (setq erc-server-process + (start-process "sleep" (current-buffer) "sleep" "1")) + (set-process-query-on-exit-flag erc-server-process nil) + + (with-current-buffer (erc--open-target "#chan") + (let* ((erc-button-tests--form nil) + (entry (list (rx "+1") 0 form #'ignore 0)) + (erc-button-alist (cons entry erc-button-alist))) + + (erc-display-message nil 'notice (current-buffer) "Foo bar baz") + (erc-display-message nil nil (current-buffer) "+1") + (erc-display-message nil 'notice (current-buffer) "Spam") + (should-not erc-button-tests--form) + (goto-char (point-min)) + (search-forward "+") + (should-not (get-text-property (point) 'erc-data)) + (should-not (get-text-property (point) 'mouse-face)) + (should-not (get-text-property (point) 'font-lock-face)) + (should-not (get-text-property (point) 'erc-callback))) + + (when noninteractive + (kill-buffer)))) + +(ert-deftest erc-button-alist--nil-form () + (erc-button-tests--erc-button-alist--nil-form nil) + (erc-button-tests--erc-button-alist--nil-form 'erc-button-tests--some-var)) + (defun erc-button-tests--insert-privmsg (speaker &rest msg-parts) (declare (indent 1)) (let ((msg (erc-format-privmessage speaker commit 35dd1ade7f1e583f736e6f707343402fe868daec Author: F. Jason Park Date: Sun Apr 30 07:12:56 2023 -0700 Preprocess prompt input linewise in ERC * etc/ERC-NEWS: Mention revised role of `erc-pre-send-functions' relative to line splitting. * lisp/erc/erc-common.el (erc-input): Add new slot `refoldp' to allow `erc-pre-send-functions' members to indicate that splitting should occur a second time after all members have had their say. (erc--input-split): Specify some defaults for overridden slots and explicitly declare some types for good measure. * lisp/erc/erc-goodies.el (erc-noncommands-mode, erc-noncommands-enable, erc-noncommands-disable): Replace `erc-pre-send-functions' with `erc--input-review-functions'. * lisp/erc/erc-ring.el (erc-ring-enable, erc-ring-disable, erc-ring-mode): Subscribe to `erc--input-review-functions' instead of `erc-pre-send-functions' for `erc--add-to-input-ring'. * lisp/erc/erc.el (erc-pre-send-functions): Note some nuances regarding line splitting in doc string and note that a new slot is available. (erc--pre-send-split-functions, erc--input-review-functions): Rename former to latter, while also obsoleting. Remove large comment. Add new default member `erc--run-input-validation-checks'. (erc-send-modify-hook): Replace the obsolete `erc-send-pre-hook' and `erc-send-this' with `erc-pre-send-functions' in doc string. (erc--check-prompt-input-for-excess-lines): Don't trim trailing blanks. Rework to also report overages in characters as well as lines. (erc--run-input-validation-hooks): New function to adapt an `erc--input-split' object to `erc--check-prompt-input-functions'. (erc-send-current-line): Run `erc--input-review-functions' in place of the validation hooks they've subsumed. Call `erc--send-input-lines' instead of the now retired but not deprecated `erc-send-input'. (erc--run-send-hooks, erc--send-input-lines): New functions that together form an alternate version of `erc-send-input'. They operate on input linewise but make accommodations for older interfaces. * test/lisp/erc/erc-tests.el (erc-ring-previous-command): Replace `erc-pre-send-functions' with `erc--input-review-functions'. (erc-tests--with-process-input-spy): Shadow `erc--input-review-functions'. (erc-check-prompt-input-for-excess-lines): Don't expect trailing blanks to be trimmed. (erc--run-send-hooks): New test. (Bug#62947) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 2cf2743701a..3907b7bc5f2 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -187,6 +187,12 @@ The 'fill' module is now defined by 'define-erc-module'. The same goes for ERC's imenu integration, which has 'imenu' now appearing in the default value of 'erc-modules'. +*** Prompt input is split before 'erc-pre-send-functions' has a say. +Hook members are now treated to input whose lines have already been +adjusted to fall within the allowed length limit. For convenience, +third-party code can request that the final input be "re-filled" prior +to being sent. See doc string for details. + *** ERC's prompt survives the insertion of user input and messages. Previously, ERC's prompt and its input marker disappeared while running hooks during message insertion, and the position of its diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 708cdb0c422..86d78768374 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -30,8 +30,10 @@ erc--casemapping-rfc1459 (defvar erc--casemapping-rfc1459-strict) (defvar erc-channel-users) (defvar erc-dbuf) +(defvar erc-insert-this) (defvar erc-log-p) (defvar erc-modules) +(defvar erc-send-this) (defvar erc-server-process) (defvar erc-server-users) (defvar erc-session-server) @@ -49,10 +51,14 @@ erc-session-server (declare-function widget-type "wid-edit" (widget)) (cl-defstruct erc-input - string insertp sendp) - -(cl-defstruct (erc--input-split (:include erc-input)) - lines cmdp) + string insertp sendp refoldp) + +(cl-defstruct (erc--input-split (:include erc-input + (string :read-only) + (insertp erc-insert-this) + (sendp erc-send-this))) + (lines nil :type (list-of string)) + (cmdp nil :type boolean)) (cl-defstruct (erc-server-user (:type vector) :named) ;; User data diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 6235de5f1c0..cc60ba0018b 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -338,8 +338,9 @@ noncommands "This mode distinguishes non-commands. Commands listed in `erc-insert-this' know how to display themselves." - ((add-hook 'erc-pre-send-functions #'erc-send-distinguish-noncommands)) - ((remove-hook 'erc-pre-send-functions #'erc-send-distinguish-noncommands))) + ((add-hook 'erc--input-review-functions #'erc-send-distinguish-noncommands)) + ((remove-hook 'erc--input-review-functions + #'erc-send-distinguish-noncommands))) (defun erc-send-distinguish-noncommands (state) "If STR is an ERC non-command, set `insertp' in STATE to nil." diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el index 2451ac56f6f..4534e913204 100644 --- a/lisp/erc/erc-ring.el +++ b/lisp/erc/erc-ring.el @@ -46,10 +46,10 @@ erc-ring (define-erc-module ring nil "Stores input in a ring so that previous commands and messages can be recalled using M-p and M-n." - ((add-hook 'erc-pre-send-functions #'erc-add-to-input-ring) + ((add-hook 'erc--input-review-functions #'erc-add-to-input-ring 90) (define-key erc-mode-map "\M-p" #'erc-previous-command) (define-key erc-mode-map "\M-n" #'erc-next-command)) - ((remove-hook 'erc-pre-send-functions #'erc-add-to-input-ring) + ((remove-hook 'erc--input-review-functions #'erc-add-to-input-ring) (define-key erc-mode-map "\M-p" #'undefined) (define-key erc-mode-map "\M-n" #'undefined))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index bc2285a5560..72ec8134eab 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1094,34 +1094,40 @@ erc-pre-send-functions `string': The current input string. `insertp': Whether the string should be inserted into the erc buffer. - `sendp': Whether the string should be sent to the irc server." + `sendp': Whether the string should be sent to the irc server. + `refoldp': Whether the string should be re-split per protocol limits. + +This hook runs after protocol line splitting has taken place, so +the value of `string' is originally \"pre-filled\". If you need +ERC to refill the entire payload before sending it, set the +`refoldp' slot to a non-nil value. Preformatted text and encoded +subprotocols should probably be handled manually." :group 'erc :type 'hook :version "27.1") -;; This is being auditioned for possible exporting (as a custom hook -;; option). Likewise for (public versions of) `erc--input-split' and -;; `erc--discard-trailing-multiline-nulls'. If unneeded, we'll just -;; run the latter on the input after `erc-pre-send-functions', and -;; remove this hook and the struct completely. IOW, if you need this, -;; please say so. - -(defvar erc--pre-send-split-functions '(erc--discard-trailing-multiline-nulls - erc--split-lines) - "Special hook for modifying individual lines in multiline prompt input. -The functions are called with one argument, an `erc--input-split' -struct, which they can optionally modify. +(define-obsolete-variable-alias 'erc--pre-send-split-functions + 'erc--input-review-functions "30.1") +(defvar erc--input-review-functions '(erc--discard-trailing-multiline-nulls + erc--split-lines + erc--run-input-validation-checks) + "Special hook for reviewing and modifying prompt input. +ERC runs this before clearing the prompt and before running any +send-related hooks, such as `erc-pre-send-functions'. Thus, it's +quite \"safe\" to bail out of this hook with a `user-error', if +necessary. The hook's members are called with one argument, an +`erc--input-split' struct, which they can optionally modify. The struct has five slots: - `string': the input string delivered by `erc-pre-send-functions' - `insertp': whether to insert the lines into the buffer - `sendp': whether the lines should be sent to the IRC server + `string': the original input as a read-only reference + `insertp': same as in `erc-pre-send-functions' + `sendp': same as in `erc-pre-send-functions' + `refoldp': same as in `erc-pre-send-functions' `lines': a list of lines to be sent, each one a `string' `cmdp': whether to interpret input as a command, like /ignore -The `string' field is effectively read-only. When `cmdp' is -non-nil, all but the first line will be discarded.") +When `cmdp' is non-nil, all but the first line will be discarded.") (defvar erc-insert-this t "Insert the text into the target buffer or not. @@ -1163,8 +1169,8 @@ erc-insert-done-hook (defcustom erc-send-modify-hook nil "Sending hook for functions that will change the text's appearance. -This hook is called just after `erc-send-pre-hook' when the values -of `erc-send-this' and `erc-insert-this' are both t. +ERC runs this just after `erc-pre-send-functions' if its shared +`erc-input' object's `sendp' and `insertp' slots remain non-nil. While this hook is run, narrowing is in effect and `current-buffer' is the buffer where the text got inserted. @@ -6106,16 +6112,18 @@ erc--blank-in-multiline-input-p (defun erc--check-prompt-input-for-excess-lines (_ lines) "Return non-nil when trying to send too many LINES." (when erc-inhibit-multiline-input - ;; Assume `erc--discard-trailing-multiline-nulls' is set to run - (let ((reversed (seq-drop-while #'string-empty-p (reverse lines))) - (max (if (eq erc-inhibit-multiline-input t) + (let ((max (if (eq erc-inhibit-multiline-input t) 2 erc-inhibit-multiline-input)) (seen 0) - msg) - (while (and (pop reversed) (< (cl-incf seen) max))) + last msg) + (while (and lines (setq last (pop lines)) (< (cl-incf seen) max))) (when (= seen max) - (setq msg (format "(exceeded by %d)" (1+ (length reversed)))) + (push last lines) + (setq msg + (format "-- exceeded by %d (%d chars)" + (length lines) + (apply #'+ (mapcar #'length lines)))) (unless (and erc-ask-about-multiline-input (y-or-n-p (concat "Send input " msg "?"))) (concat "Too many lines " msg)))))) @@ -6155,7 +6163,17 @@ erc--check-prompt-input-functions Called with latest input string submitted by user and the list of lines produced by splitting it. If any member function returns non-nil, processing is abandoned and input is left untouched. -When the returned value is a string, pass it to `erc-error'.") +When the returned value is a string, ERC passes it to `erc-error'.") + +(defun erc--run-input-validation-checks (state) + "Run input checkers from STATE, an `erc--input-split' object." + (when-let ((msg (run-hook-with-args-until-success + 'erc--check-prompt-input-functions + (erc--input-split-string state) + (erc--input-split-lines state)))) + (unless (stringp msg) + (setq msg (format "Input error: %S" msg))) + (user-error msg))) (defun erc-send-current-line () "Parse current line and send it to IRC." @@ -6170,12 +6188,15 @@ erc-send-current-line (eolp)) (expand-abbrev)) (widen) - (if-let* ((str (erc-user-input)) - (msg (run-hook-with-args-until-success - 'erc--check-prompt-input-functions str - (split-string str erc--input-line-delim-regexp)))) - (when (stringp msg) - (erc-error msg)) + (let* ((str (erc-user-input)) + (state (make-erc--input-split + :string str + :insertp erc-insert-this + :sendp erc-send-this + :lines (split-string + str erc--input-line-delim-regexp) + :cmdp (string-match erc-command-regexp str)))) + (run-hook-with-args 'erc--input-review-functions state) (let ((inhibit-read-only t) (old-buf (current-buffer))) (progn ; unprogn this during next major surgery @@ -6183,7 +6204,7 @@ erc-send-current-line ;; Kill the input and the prompt (delete-region erc-input-marker (erc-end-of-input-line)) (unwind-protect - (erc-send-input str 'skip-ws-chk) + (erc--send-input-lines (erc--run-send-hooks state)) ;; Fix the buffer if the command didn't kill it (when (buffer-live-p old-buf) (with-current-buffer old-buf @@ -6223,6 +6244,52 @@ erc--split-lines (setf (erc--input-split-lines state) (mapcan #'erc--split-line (erc--input-split-lines state))))) +(defun erc--run-send-hooks (lines-obj) + "Run send-related hooks that operate on the entire prompt input. +Sequester some of the back and forth involved in honoring old +interfaces, such as the reconstituting and re-splitting of +multiline input. Optionally readjust lines to protocol length +limits and pad empty ones, knowing full well that additional +processing may still corrupt messages before they reach the send +queue. Expect LINES-OBJ to be an `erc--input-split' object." + (when (or erc-send-pre-hook erc-pre-send-functions) + (with-suppressed-warnings ((lexical str) (obsolete erc-send-this)) + (defvar str) ; see note in string `erc-send-input'. + (let* ((str (string-join (erc--input-split-lines lines-obj) "\n")) + (erc-send-this (erc--input-split-sendp lines-obj)) + (erc-insert-this (erc--input-split-insertp lines-obj)) + (state (progn + ;; This may change `str' and `erc-*-this'. + (run-hook-with-args 'erc-send-pre-hook str) + (make-erc-input :string str + :insertp erc-insert-this + :sendp erc-send-this)))) + (run-hook-with-args 'erc-pre-send-functions state) + (setf (erc--input-split-sendp lines-obj) (erc-input-sendp state) + (erc--input-split-insertp lines-obj) (erc-input-insertp state) + ;; See note in test of same name re trailing newlines. + (erc--input-split-lines lines-obj) + (cl-nsubst " " "" (split-string (erc-input-string state) + erc--input-line-delim-regexp) + :test #'equal)) + (when (erc-input-refoldp state) + (erc--split-lines lines-obj))))) + (when (and (erc--input-split-cmdp lines-obj) + (cdr (erc--input-split-lines lines-obj))) + (user-error "Multiline command detected" )) + lines-obj) + +(defun erc--send-input-lines (lines-obj) + "Send lines in `erc--input-split-lines' object LINES-OBJ." + (when (erc--input-split-sendp lines-obj) + (dolist (line (erc--input-split-lines lines-obj)) + (unless (erc--input-split-cmdp lines-obj) + (when (erc--input-split-insertp lines-obj) + (erc-display-msg line))) + (erc-process-input-line (concat line "\n") + (null erc-flood-protect) + (not (erc--input-split-cmdp lines-obj)))))) + (defun erc-send-input (input &optional skip-ws-chk) "Treat INPUT as typed in by the user. It is assumed that the input and the prompt is already deleted. diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b6702617aeb..be5a566a268 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -942,8 +942,8 @@ erc-ring-previous-command (should-not (local-variable-if-set-p 'erc-send-completed-hook)) (set (make-local-variable 'erc-send-completed-hook) nil) ; skip t (globals) ;; Just in case erc-ring-mode is already on - (setq-local erc-pre-send-functions nil) - (add-hook 'erc-pre-send-functions #'erc-add-to-input-ring) + (setq-local erc--input-review-functions nil) + (add-hook 'erc--input-review-functions #'erc-add-to-input-ring) ;; (cl-letf (((symbol-function 'erc-process-input-line) (lambda (&rest _) @@ -1156,7 +1156,9 @@ erc--blank-in-multiline-input-p (defun erc-tests--with-process-input-spy (test) (with-current-buffer (get-buffer-create "FakeNet") - (let* ((erc-pre-send-functions + (let* ((erc--input-review-functions + (remove #'erc-add-to-input-ring erc--input-review-functions)) + (erc-pre-send-functions (remove #'erc-add-to-input-ring erc-pre-send-functions)) ; for now (inhibit-message noninteractive) (erc-server-current-nick "tester") @@ -1314,13 +1316,14 @@ erc--check-prompt-input-for-excess-lines (ert-info ("With `erc-inhibit-multiline-input' as t (2)") (let ((erc-inhibit-multiline-input t)) (should-not (erc--check-prompt-input-for-excess-lines "" '("a"))) - (should-not (erc--check-prompt-input-for-excess-lines "" '("a" ""))) + ;; Does not trim trailing blanks. + (should (erc--check-prompt-input-for-excess-lines "" '("a" ""))) (should (erc--check-prompt-input-for-excess-lines "" '("a" "b"))))) (ert-info ("With `erc-inhibit-multiline-input' as 3") (let ((erc-inhibit-multiline-input 3)) (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b"))) - (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b" ""))) + (should (erc--check-prompt-input-for-excess-lines "" '("a" "b" ""))) (should (erc--check-prompt-input-for-excess-lines "" '("a" "b" "c"))))) (ert-info ("With `erc-ask-about-multiline-input'") @@ -1399,6 +1402,94 @@ erc-process-input-line (should-not calls)))))) + +;; The behavior of `erc-pre-send-functions' differs between versions +;; in how hook members see and influence a trailing newline that's +;; part of the original prompt submission: +;; +;; 5.4: both seen and sent +;; 5.5: seen but not sent* +;; 5.6: neither seen nor sent* +;; +;; * requires `erc-send-whitespace-lines' for hook to run +;; +;; Two aspects that have remained consistent are +;; +;; - a final nonempty line in any submission is always sent +;; - a trailing newline appended by a hook member is always sent +;; +;; The last bullet would seem to contradict the "not sent" behavior of +;; 5.5 and 5.6, but what's actually happening is that exactly one +;; trailing newline is culled, so anything added always goes through. +;; Also, in ERC 5.6, all empty lines are actually padded, but this is +;; merely incidental WRT the above. +;; +;; Note that this test doesn't run any input-prep hooks and thus can't +;; account for the "seen" dimension noted above. + +(ert-deftest erc--run-send-hooks () + (with-suppressed-warnings ((obsolete erc-send-this) + (obsolete erc-send-pre-hook)) + (should erc-insert-this) + (should erc-send-this) ; populates `erc--input-split-sendp' + + (let (erc-pre-send-functions erc-send-pre-hook) + + (ert-info ("String preserved, lines rewritten, empties padded") + (setq erc-pre-send-functions + (lambda (o) (setf (erc-input-string o) "bar\n\nbaz\n"))) + (should (pcase (erc--run-send-hooks (make-erc--input-split + :string "foo" :lines '("foo"))) + ((cl-struct erc--input-split + (string "foo") (sendp 't) (insertp 't) + (lines '("bar" " " "baz" " ")) (cmdp 'nil)) + t)))) + + (ert-info ("Multiline commands rejected") + (should-error (erc--run-send-hooks (make-erc--input-split + :string "/mycmd foo" + :lines '("/mycmd foo") + :cmdp t)))) + + (ert-info ("Single-line commands pass") + (setq erc-pre-send-functions + (lambda (o) (setf (erc-input-sendp o) nil + (erc-input-string o) "/mycmd bar"))) + (should (pcase (erc--run-send-hooks (make-erc--input-split + :string "/mycmd foo" + :lines '("/mycmd foo") + :cmdp t)) + ((cl-struct erc--input-split + (string "/mycmd foo") (sendp 'nil) (insertp 't) + (lines '("/mycmd bar")) (cmdp 't)) + t)))) + + (ert-info ("Legacy hook respected, special vars confined") + (setq erc-send-pre-hook (lambda (_) (setq erc-send-this nil)) + erc-pre-send-functions (lambda (o) ; propagates + (should-not (erc-input-sendp o)))) + (should (pcase (erc--run-send-hooks (make-erc--input-split + :string "foo" :lines '("foo"))) + ((cl-struct erc--input-split + (string "foo") (sendp 'nil) (insertp 't) + (lines '("foo")) (cmdp 'nil)) + t))) + (should erc-send-this)) + + (ert-info ("Request to resplit honored") + (setq erc-send-pre-hook nil + erc-pre-send-functions + (lambda (o) (setf (erc-input-string o) "foo bar baz" + (erc-input-refoldp o) t))) + (let ((erc-split-line-length 8)) + (should + (pcase (erc--run-send-hooks (make-erc--input-split + :string "foo" :lines '("foo"))) + ((cl-struct erc--input-split + (string "foo") (sendp 't) (insertp 't) + (lines '("foo bar " "baz")) (cmdp 'nil)) + t)))))))) + ;; Note: if adding an erc-backend-tests.el, please relocate this there. (ert-deftest erc-message () commit 3a5a6fce957468be5ef0a8ac76fec8507c3e4e99 Author: F. Jason Park Date: Mon Apr 17 00:01:15 2023 -0700 Redo line splitting for outgoing messages in ERC * lisp/erc/erc-backend.el (erc--reject-unbreakable-lines): New variable, an escape hatch for somewhat regaining pre-5.6 line-splitting behavior. (erc--split-line): New utility function that doesn't rely on column-oriented filling. * lisp/erc/erc.el (erc--pre-send-split-functions): Append `erc--split-lines' to value. (erc--split-lines): New function to re-split current selection of lines. (erc-send-input): Hard-code line preparation instead of calling `erc--pre-send-split-functions', in order to bake in traditional behavior before move to "pre-splitting". * test/lisp/erc/erc-scenarios-base-split-line.el: New file. * test/lisp/erc/erc-tests.el (erc--split-line): New test. (erc-send-current-line): Don't expect a flood argument when interpreting a command because it's not passed along to the command's handler. This was previously misleading because it assigned undue significance to something that had no bearing on the fate of a command. * test/lisp/erc/resources/base/flood/ascii.eld: New file. * test/lisp/erc/resources/base/flood/koi8-r.eld: New file. * test/lisp/erc/resources/base/flood/utf-8.eld: New file. * test/lisp/erc/resources/erc-d/erc-d.el: Don't decode input. (Bug#62947) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 0c970a9d586..bc8e603e10a 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -572,6 +572,47 @@ erc-server-ping-handler ;;;; Helper functions +(defvar erc--reject-unbreakable-lines nil + "Signal an error when a line exceeds `erc-split-line-length'. +Sending such lines and hoping for the best is no longer supported +in ERC 5.6. This internal var exists as a possibly temporary +escape hatch for inhibiting their transmission.") + +(defun erc--split-line (longline) + (let* ((coding (erc-coding-system-for-target nil)) + (original-window-buf (window-buffer (selected-window))) + out) + (when (consp coding) + (setq coding (car coding))) + (setq coding (coding-system-change-eol-conversion coding 'unix)) + (unwind-protect + (with-temp-buffer + (set-window-buffer (selected-window) (current-buffer)) + (insert longline) + (goto-char (point-min)) + (while (not (eobp)) + (let ((upper (filepos-to-bufferpos erc-split-line-length + 'exact coding))) + (goto-char (or upper (point-max))) + (unless (eobp) + (skip-chars-backward "^ \t")) + (when (bobp) + (when erc--reject-unbreakable-lines + (user-error + (substitute-command-keys + (concat "Unbreakable line encountered " + "(Recover input with \\[erc-previous-command])")))) + (goto-char upper)) + (when-let ((cmp (find-composition (point) (1+ (point))))) + (if (= (car cmp) (point-min)) + (goto-char (nth 1 cmp)) + (goto-char (car cmp))))) + (cl-assert (/= (point-min) (point))) + (push (buffer-substring-no-properties (point-min) (point)) out) + (delete-region (point-min) (point))) + (or (nreverse out) (list ""))) + (set-window-buffer (selected-window) original-window-buf)))) + ;; From Circe (defun erc-split-line (longline) "Return a list of lines which are not too long for IRC. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 8552023804a..bc2285a5560 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -909,6 +909,9 @@ erc-flood-protect short of an interval, which may cause the server to terminate the connection. +Note that older code conflated rate limiting and line splitting. +Starting in ERC 5.6, this option no longer influences the latter. + See `erc-server-flood-margin' for other flood-related parameters.") ;; Script parameters @@ -1103,7 +1106,8 @@ erc-pre-send-functions ;; remove this hook and the struct completely. IOW, if you need this, ;; please say so. -(defvar erc--pre-send-split-functions '(erc--discard-trailing-multiline-nulls) +(defvar erc--pre-send-split-functions '(erc--discard-trailing-multiline-nulls + erc--split-lines) "Special hook for modifying individual lines in multiline prompt input. The functions are called with one argument, an `erc--input-split' struct, which they can optionally modify. @@ -6211,6 +6215,14 @@ erc--discard-trailing-multiline-nulls (setq reversed (cdr reversed))) (setf (erc--input-split-lines state) (nreverse reversed))))) +(defun erc--split-lines (state) + "Partition non-command input into lines of protocol-compliant length." + ;; Prior to ERC 5.6, line splitting used to be predicated on + ;; `erc-flood-protect' being non-nil. + (unless (erc--input-split-cmdp state) + (setf (erc--input-split-lines state) + (mapcan #'erc--split-line (erc--input-split-lines state))))) + (defun erc-send-input (input &optional skip-ws-chk) "Treat INPUT as typed in by the user. It is assumed that the input and the prompt is already deleted. @@ -6241,23 +6253,22 @@ erc-send-input :insertp erc-insert-this :sendp erc-send-this)) (run-hook-with-args 'erc-pre-send-functions state) - (setq state (make-erc--input-split - :string (erc-input-string state) - :insertp (erc-input-insertp state) - :sendp (erc-input-sendp state) - :lines (split-string (erc-input-string state) - erc--input-line-delim-regexp) - :cmdp (string-match erc-command-regexp - (erc-input-string state)))) - (run-hook-with-args 'erc--pre-send-split-functions state) (when (and (erc-input-sendp state) erc-send-this) - (let ((lines (erc--input-split-lines state))) - (if (and (erc--input-split-cmdp state) (not (cdr lines))) - (erc-process-input-line (concat (car lines) "\n") t nil) + (if-let* ((first (split-string (erc-input-string state) + erc--input-line-delim-regexp)) + (split (mapcan #'erc--split-line first)) + (lines (nreverse (seq-drop-while #'string-empty-p + (nreverse split)))) + ((string-match erc-command-regexp (car lines)))) + (progn + ;; Asking users what to do here might make more sense. + (cl-assert (not (cdr lines))) + ;; The `force' arg (here t) is ignored for command lines. + (erc-process-input-line (concat (car lines) "\n") t nil)) + (progn ; temporarily preserve indentation (dolist (line lines) - (dolist (line (or (and erc-flood-protect (erc-split-line line)) - (list line))) + (progn ; temporarily preserve indentation (when (erc-input-insertp state) (erc-display-msg line)) (erc-process-input-line (concat line "\n") diff --git a/test/lisp/erc/erc-scenarios-base-split-line.el b/test/lisp/erc/erc-scenarios-base-split-line.el new file mode 100644 index 00000000000..f6d888c1f28 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-base-split-line.el @@ -0,0 +1,202 @@ +;;; erc-scenarios-base-split-line.el --- ERC line splitting -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(ert-deftest erc-scenarios-base-split-line--koi8-r () + :tags '(:expensive-test) + (should (equal erc-split-line-length 440)) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/flood") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'koi8-r)) + (erc-encoding-coding-alist '(("#koi8" . cyrillic-koi8))) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to server") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "tester") + (funcall expect 10 "debug mode") + (erc-cmd-JOIN "#koi8"))) + + (with-current-buffer (erc-d-t-wait-for 8 (get-buffer "#koi8")) + (funcall expect 10 "короче теперь") + (ert-info ("Message well within `erc-split-line-length'") + (erc-scenarios-common-say + (concat + "короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно")) + (funcall expect 1 "") + (funcall expect -0.1 "")) + + (ert-info ("Message over `erc-split-line-length'") + (erc-scenarios-common-say + (concat + "короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " будет разрыв строки непонятно где")) + (funcall expect 1 "") + (funcall expect 1 " разрыв"))) + + (with-current-buffer "foonet" + (erc-cmd-QUIT "") + (funcall expect 10 "finished")))) + +(ert-deftest erc-scenarios-base-split-line--ascii () + :tags '(:expensive-test) + (should (equal erc-split-line-length 440)) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/flood") + (msg-432 (string-join (make-list 18 "twenty-three characters") " ")) + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'ascii)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to server") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "tester") + (funcall expect 10 "debug mode") + (erc-cmd-JOIN "#ascii"))) + + (with-current-buffer (erc-d-t-wait-for 8 (get-buffer "#ascii")) + (ert-info ("Message with spaces fits exactly") + (funcall expect 10 "Welcome") + (should (= (length (concat msg-432 " 12345678")) 440)) + (erc-scenarios-common-say (concat msg-432 " 12345678")) + (funcall expect 1 "") + ;; Sent in a single go, hence no second . + (funcall expect -0.1 "") + (funcall expect 0.1 "12345678")) + + (ert-info ("Message with spaces too long.") + (erc-scenarios-common-say (concat msg-432 " 123456789")) + (funcall expect 1 "") + ;; Sent in two passes, split at last word. + (funcall expect 0.1 " 123456789")) + + (ert-info ("Message sans spaces fits exactly") + (erc-scenarios-common-say (make-string 440 ?x)) + (funcall expect 1 "") + ;; Sent in a single go, hence no second . + (funcall expect -0.1 "")) + + (ert-info ("Message sans spaces too long.") + (erc-scenarios-common-say (concat (make-string 440 ?y) "z")) + (funcall expect 1 "") + ;; Sent in two passes, split at last word. + (funcall expect 0.1 " z")) + + (ert-info ("Rejected when escape-hatch set") + (let ((erc--reject-unbreakable-lines t)) + (should-error + (erc-scenarios-common-say + (concat + "https://mail.example.org/verify?token=" + (string-join (make-list 18 "twenty-three_characters") "_"))))))) + + (with-current-buffer "foonet" + (erc-cmd-QUIT "") + (funcall expect 10 "finished")))) + +(ert-deftest erc-scenarios-base-split-line--utf-8 () + :tags '(:expensive-test) + (unless (> emacs-major-version 27) + (ert-skip "No emojis in Emacs 27")) + + (should (equal erc-split-line-length 440)) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/flood") + (msg-432 (string-join (make-list 18 "twenty-three characters") " ")) + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'utf-8)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to server") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "tester") + (funcall expect 10 "debug mode") + (erc-cmd-JOIN "#utf-8"))) + + (with-current-buffer (erc-d-t-wait-for 8 (get-buffer "#utf-8")) + (funcall expect 10 "Welcome") + + (ert-info ("Message with spaces over `erc-split-line-length'") + (erc-scenarios-common-say + (concat + "короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " будет разрыв строки непонятно где" + " будет разрыв строки непонятно где")) + (funcall expect 1 " короче") + (funcall expect 1 " все") + (funcall expect 1 " разрыв") + (funcall expect 1 "Entirely honour")) + + (ert-info ("Message sans spaces over `erc-split-line-length'") + (erc-scenarios-common-say + (concat "話說天下大勢,分久必合,合久必分:周末七國分爭,并入於秦。" + "及秦滅之後,楚、漢分爭,又并入於漢。漢朝自高祖斬白蛇而起義," + "一統天下。後來光武中興,傳至獻帝,遂分為三國。推其致亂之由," + "殆始於桓、靈二帝。桓帝禁錮善類,崇信宦官。及桓帝崩,靈帝即位," + "大將軍竇武、太傅陳蕃,共相輔佐。時有宦官曹節等弄權,竇武、陳蕃謀誅之," + "作事不密,反為所害。中涓自此愈橫")) + (funcall expect 1 "") + ;; Sent in two passes, split at last word. + (funcall expect 0.1 " 竇武") + (funcall expect 1 "this prey out")) + + ;; Combining emojis are respected. + (ert-info ("Message sans spaces over small `erc-split-line-length'") + (let ((erc-split-line-length 100)) + (erc-scenarios-common-say + "будет разрыв строки непонятно где🏁🚩🎌🏴🏳️🏳️‍🌈🏳️‍⚧️🏴‍☠️")) + (funcall expect 1 "") + (funcall expect 1 " 🏳️‍🌈"))) + + (with-current-buffer "foonet" + (erc-cmd-QUIT "") + (funcall expect 10 "finished")))) + +;;; erc-scenarios-base-split-line.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 4725d289e5b..b6702617aeb 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1044,6 +1044,48 @@ erc-log-irc-protocol (kill-buffer "*erc-protocol*") (should-not erc-debug-irc-protocol))) +(ert-deftest erc--split-line () + (let ((erc-default-recipients '("#chan")) + (erc-split-line-length 10)) + (should (equal (erc--split-line "") '(""))) + (should (equal (erc--split-line "0123456789") '("0123456789"))) + (should (equal (erc--split-line "0123456789a") '("0123456789" "a"))) + + (should (equal (erc--split-line "0123456789 ") '("0123456789" " "))) + (should (equal (erc--split-line "01234567 89") '("01234567 " "89"))) + (should (equal (erc--split-line "0123456 789") '("0123456 " "789"))) + (should (equal (erc--split-line "0 123456789") '("0 " "123456789"))) + (should (equal (erc--split-line " 0123456789") '(" " "0123456789"))) + (should (equal (erc--split-line "012345678 9a") '("012345678 " "9a"))) + (should (equal (erc--split-line "0123456789 a") '("0123456789" " a"))) + + ;; UTF-8 vs. KOI-8 + (should (= 10 (string-bytes "Русск"))) ; utf-8 + (should (equal (erc--split-line "Русск") '("Русск"))) + (should (equal (erc--split-line "РусскийТекст") '("Русск" "ийТек" "ст"))) + (should (equal (erc--split-line "Русский Текст") '("Русск" "ий " "Текст"))) + (let ((erc-encoding-coding-alist '(("#chan" . cyrillic-koi8)))) + (should (equal (erc--split-line "Русск") '("Русск"))) + (should (equal (erc--split-line "РусскийТекст") '("РусскийТек" "ст"))) + (should (equal (erc--split-line "Русский Текст") '("Русский " "Текст")))) + + ;; UTF-8 vs. Latin 1 + (should (= 17 (string-bytes "Hyvää päivää"))) + (should (equal (erc--split-line "Hyvää päivää") '("Hyvää " "päivää"))) + (should (equal (erc--split-line "HyvääPäivää") '("HyvääPä" "ivää"))) + (let ((erc-encoding-coding-alist '(("#chan" . latin-1)))) + (should (equal (erc--split-line "Hyvää päivää") '("Hyvää " "päivää"))) + (should (equal (erc--split-line "HyvääPäivää") '("HyvääPäivä" "ä")))) + + ;; Combining characters + (should (= 10 (string-bytes "Åström"))) + (should (equal (erc--split-line "_Åström") '("_Åströ" "m"))) + (should (equal (erc--split-line "__Åström") '("__Åstr" "öm"))) + (should (equal (erc--split-line "___Åström") '("___Åstr" "öm"))) + (when (> emacs-major-version 27) + (should (equal (erc--split-line "🏁🚩🎌🏴🏳️🏳️‍🌈🏳️‍⚧️🏴‍☠️") + '("🏁🚩" "🎌🏴" "🏳️" "🏳️‍🌈" "🏳️‍⚧️" "🏴‍☠️")))))) + (ert-deftest erc--input-line-delim-regexp () (let ((p erc--input-line-delim-regexp)) ;; none @@ -1181,8 +1223,9 @@ erc-send-current-line (ert-info ("Input cleared") (erc-bol) (should (eq (point) (point-max)))) - ;; Commands are forced (no flood protection) - (should (equal (funcall next) '("/msg #chan hi\n" t nil)))) + ;; The `force' argument is irrelevant here because it can't + ;; influence dispatched handlers, such as `erc-cmd-MSG'. + (should (pcase (funcall next) (`("/msg #chan hi\n" ,_ nil) t)))) (ert-info ("Simple non-command") (insert "hi") @@ -1190,7 +1233,8 @@ erc-send-current-line (should (eq (point) (point-max))) (should (save-excursion (forward-line -1) (search-forward " hi"))) - ;; Non-ommands are forced only when `erc-flood-protect' is nil + ;; Non-commands are forced only when `erc-flood-protect' is + ;; nil, which conflates two orthogonal concerns. (should (equal (funcall next) '("hi\n" nil t)))) (should (consp erc-last-input-time))))) diff --git a/test/lisp/erc/resources/base/flood/ascii.eld b/test/lisp/erc/resources/base/flood/ascii.eld new file mode 100644 index 00000000000..a3d127326c3 --- /dev/null +++ b/test/lisp/erc/resources/base/flood/ascii.eld @@ -0,0 +1,49 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 12 Mar 2023 02:30:29 UTC") + (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 375 tester :- irc.foonet.org Message of the day - ") + (0.00 ":irc.foonet.org 372 tester :- This is the default Ergo MOTD.") + (0.01 ":irc.foonet.org 372 tester :- ") + (0.02 ":irc.foonet.org 372 tester :- For more information on using these, see MOTDFORMATTING.md") + (0.00 ":irc.foonet.org 376 tester :End of MOTD command")) + +((mode-tester 10 "MODE tester +i") + (0.00 ":irc.foonet.org 221 tester +i") + (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.") + (0.05 ":irc.foonet.org 221 tester +i")) + +((join-spam 10 "JOIN #ascii") + (0 ":tester!~u@9g6b728983yd2.irc JOIN #ascii") + (0 ":irc.foonet.org 353 tester = #ascii :alice tester @bob") + (0 ":irc.foonet.org 366 tester #ascii :End of NAMES list")) + +((mode-spam 10 "MODE #ascii") + (0 ":irc.foonet.org 324 tester #ascii +nt") + (0 ":irc.foonet.org 329 tester #ascii 1620104779") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #ascii :tester, welcome!") + (0.0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #ascii :tester, welcome!")) + +((privmsg 10 "PRIVMSG #ascii :twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters 12345678")) +((privmsg 10 "PRIVMSG #ascii :twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters ")) +((privmsg 10 "PRIVMSG #ascii :123456789")) +((privmsg 10 "PRIVMSG #ascii :xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")) +((privmsg 10 "PRIVMSG #ascii :yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy")) +((privmsg 10 "PRIVMSG #ascii :z")) + +((quit 10 "QUIT :\2ERC\2") + (0.07 ":tester!~u@h3f95zveyc38a.irc QUIT :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)") + (0.01 "ERROR :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)")) diff --git a/test/lisp/erc/resources/base/flood/koi8-r.eld b/test/lisp/erc/resources/base/flood/koi8-r.eld new file mode 100644 index 00000000000..0f10717fc2c --- /dev/null +++ b/test/lisp/erc/resources/base/flood/koi8-r.eld @@ -0,0 +1,47 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 12 Mar 2023 02:30:29 UTC") + (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 375 tester :- irc.foonet.org Message of the day - ") + (0.00 ":irc.foonet.org 372 tester :- This is the default Ergo MOTD.") + (0.01 ":irc.foonet.org 372 tester :- ") + (0.02 ":irc.foonet.org 372 tester :- For more information on using these, see MOTDFORMATTING.md") + (0.00 ":irc.foonet.org 376 tester :End of MOTD command")) + +((mode-tester 10 "MODE tester +i") + (0.00 ":irc.foonet.org 221 tester +i") + (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.") + (0.05 ":irc.foonet.org 221 tester +i")) + +((join-chan 6 "JOIN #koi8") + (0 ":tester!~u@9g6b728983yd2.irc JOIN #koi8") + (0 ":irc.foonet.org 353 tester = #koi8 :alice tester @bob") + (0 ":irc.foonet.org 366 tester #koi8 :End of NAMES list")) + +((mode-chan 8 "MODE #koi8") + (0 ":irc.foonet.org 324 tester #koi8 +nt") + (0 ":irc.foonet.org 329 tester #koi8 1620104779") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #koi8 :tester, welcome!") + (0.0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #koi8 :tester, welcome!") + (0.0 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #koi8 :\313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317")) + +((privmsg 10 "PRIVMSG #koi8 :\313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317")) +((privmsg 10 "PRIVMSG #koi8 :\313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \302\325\304\305\324 ")) +((privmsg 10 "PRIVMSG #koi8 :\322\301\332\322\331\327 \323\324\322\317\313\311 \316\305\320\317\316\321\324\316\317 \307\304\305")) + +((quit 10 "QUIT :\2ERC\2") + (0.07 ":tester!~u@h3f95zveyc38a.irc QUIT :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)") + (0.01 "ERROR :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)")) diff --git a/test/lisp/erc/resources/base/flood/utf-8.eld b/test/lisp/erc/resources/base/flood/utf-8.eld new file mode 100644 index 00000000000..8e7f8f7eed2 --- /dev/null +++ b/test/lisp/erc/resources/base/flood/utf-8.eld @@ -0,0 +1,54 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 12 Mar 2023 02:30:29 UTC") + (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 375 tester :- irc.foonet.org Message of the day - ") + (0.00 ":irc.foonet.org 372 tester :- This is the default Ergo MOTD.") + (0.01 ":irc.foonet.org 372 tester :- ") + (0.02 ":irc.foonet.org 372 tester :- For more information on using these, see MOTDFORMATTING.md") + (0.00 ":irc.foonet.org 376 tester :End of MOTD command")) + +((mode-tester 10 "MODE tester +i") + (0.00 ":irc.foonet.org 221 tester +i") + (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.") + (0.05 ":irc.foonet.org 221 tester +i")) + +((join-spam 10 "JOIN #utf-8") + (0 ":tester!~u@9g6b728983yd2.irc JOIN #utf-8") + (0 ":irc.foonet.org 353 tester = #utf-8 :alice tester @bob") + (0 ":irc.foonet.org 366 tester #utf-8 :End of NAMES list")) + +((mode-spam 10 "MODE #utf-8") + (0 ":irc.foonet.org 324 tester #utf-8 +nt") + (0 ":irc.foonet.org 329 tester #utf-8 1620104779") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #utf-8 :tester, welcome!") + (0.0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #utf-8 :tester, welcome!")) + +((privmsg-a 10 "PRIVMSG #utf-8 :\320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 ")) +((privmsg-b 10 "PRIVMSG #utf-8 :\320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\261\321\203\320\264\320\265\321\202 \321\200\320\260\320\267\321\200\321\213\320\262 \321\201\321\202\321\200\320\276\320\272\320\270 \320\275\320\265\320\277\320\276\320\275\321\217\321\202\320\275\320\276 \320\263\320\264\320\265 \320\261\321\203\320\264\320\265\321\202 ")) +((privmsg-c 10 "PRIVMSG #utf-8 :\321\200\320\260\320\267\321\200\321\213\320\262 \321\201\321\202\321\200\320\276\320\272\320\270 \320\275\320\265\320\277\320\276\320\275\321\217\321\202\320\275\320\276 \320\263\320\264\320\265") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #utf-8 :alice: Entirely honour; I would not be delay'd.")) + +((privmsg-g 10 "PRIVMSG #utf-8 :\350\251\261\350\252\252\345\244\251\344\270\213\345\244\247\345\213\242\357\274\214\345\210\206\344\271\205\345\277\205\345\220\210\357\274\214\345\220\210\344\271\205\345\277\205\345\210\206\357\274\232\345\221\250\346\234\253\344\270\203\345\234\213\345\210\206\347\210\255\357\274\214\345\271\266\345\205\245\346\226\274\347\247\246\343\200\202\345\217\212\347\247\246\346\273\205\344\271\213\345\276\214\357\274\214\346\245\232\343\200\201\346\274\242\345\210\206\347\210\255\357\274\214\345\217\210\345\271\266\345\205\245\346\226\274\346\274\242\343\200\202\346\274\242\346\234\235\350\207\252\351\253\230\347\245\226\346\226\254\347\231\275\350\233\207\350\200\214\350\265\267\347\276\251\357\274\214\344\270\200\347\265\261\345\244\251\344\270\213\343\200\202\345\276\214\344\276\206\345\205\211\346\255\246\344\270\255\350\210\210\357\274\214\345\202\263\350\207\263\347\215\273\345\270\235\357\274\214\351\201\202\345\210\206\347\202\272\344\270\211\345\234\213\343\200\202\346\216\250\345\205\266\350\207\264\344\272\202\344\271\213\347\224\261\357\274\214\346\256\206\345\247\213\346\226\274\346\241\223\343\200\201\351\235\210\344\272\214\345\270\235\343\200\202\346\241\223\345\270\235\347\246\201\351\214\256\345\226\204\351\241\236\357\274\214\345\264\207\344\277\241\345\256\246\345\256\230\343\200\202\345\217\212\346\241\223\345\270\235\345\264\251\357\274\214\351\235\210\345\270\235\345\215\263\344\275\215\357\274\214\345\244\247\345\260\207\350\273\215\347\253\207\346\255\246\343\200\201\345\244\252\345\202\205\351\231\263\350\225\203\357\274\214\345\205\261\347\233\270\350\274\224\344\275\220\343\200\202\346\231\202\346\234\211\345\256\246\345\256\230\346\233\271\347\257\200\347\255\211\345\274\204\346\254\212\357\274\214")) +((privmsg-h 10 "PRIVMSG #utf-8 :\347\253\207\346\255\246\343\200\201\351\231\263\350\225\203\350\254\200\350\252\205\344\271\213\357\274\214\344\275\234\344\272\213\344\270\215\345\257\206\357\274\214\345\217\215\347\202\272\346\211\200\345\256\263\343\200\202\344\270\255\346\266\223\350\207\252\346\255\244\346\204\210\346\251\253") + (0.0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #utf-8 :Shall seize this prey out of his father's hands.")) + +((privmsg-d 10 "PRIVMSG #utf-8 :\320\261\321\203\320\264\320\265\321\202\302\240\321\200\320\260\320\267\321\200\321\213\320\262\302\240\321\201\321\202\321\200\320\276\320\272\320\270\302\240\320\275\320\265\320\277\320\276\320\275\321\217\321\202\320\275\320\276\302\240\320\263\320\264\320\265\360\237\217\201\360\237\232\251\360\237\216\214\360\237\217\264\360\237\217\263\357\270\217")) +((privmsg-e 10 "PRIVMSG #utf-8 :\360\237\217\263\357\270\217\342\200\215\360\237\214\210\360\237\217\263\357\270\217\342\200\215\342\232\247\357\270\217\360\237\217\264\342\200\215\342\230\240\357\270\217")) + +((quit 10 "QUIT :\2ERC\2") + (0.07 ":tester!~u@h3f95zveyc38a.irc QUIT :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)") + (0.01 "ERROR :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)")) diff --git a/test/lisp/erc/resources/erc-d/erc-d.el b/test/lisp/erc/resources/erc-d/erc-d.el index 43f6552f0f3..e9d880644d4 100644 --- a/test/lisp/erc/resources/erc-d/erc-d.el +++ b/test/lisp/erc/resources/erc-d/erc-d.el @@ -456,7 +456,7 @@ erc-d--filter (setq string (unless (= (match-end 0) (length string)) (substring string (match-end 0)))) (erc-d--log process line nil) - (ring-insert queue (erc-d-i--parse-message line 'decode)))) + (ring-insert queue (erc-d-i--parse-message line nil)))) (when string (setf (process-get process :stashed-input) string)))) commit 16306567706c9621cef169d0e992b9b3b08a9d7e Author: F. Jason Park Date: Mon Apr 17 23:09:49 2023 -0700 Don't send multiline commands as messages in ERC * lisp/erc/erc.el (erc-command-regexp): Relocate from further down in same file. (erc--check-prompt-input-for-multiline-command): Reject slash commands containing multiple lines during input validation and before running additional hooks. (erc--discard-trailing-multiline-nulls): Don't mark input that begins with a possible "slash command" as constituting a plain message just because it has a trailing newline. It's relatively easy to add a newline by accident, which can result in the unintended sharing of a command line. Also, ERC already has a /SAY command that allows a user to send a message starting a literal command. * test/lisp/erc/erc-tests.el (erc-send-whitespace-lines): Fix test to expect validation error when non-blank lines follow a slash command. (Bug#62947) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index a439e2438b0..8552023804a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6082,6 +6082,9 @@ erc-accidental-paste-threshold-seconds (defvar erc--input-line-delim-regexp (rx (| (: (? ?\r) ?\n) ?\r))) +(defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$" + "Regular expression used for matching commands in ERC.") + (defun erc--blank-in-multiline-input-p (lines) "Detect whether LINES contains a blank line. When `erc-send-whitespace-lines' is in effect, return nil if @@ -6131,11 +6134,19 @@ erc--check-prompt-input-for-running-process (erc-command-no-process-p string)) "ERC: No process running")) +(defun erc--check-prompt-input-for-multiline-command (line lines) + "Return non-nil when non-blank lines follow a command line." + (when (and (cdr lines) + (string-match erc-command-regexp line) + (seq-drop-while #'string-empty-p (reverse (cdr lines)))) + "Excess input after command line")) + (defvar erc--check-prompt-input-functions '(erc--check-prompt-input-for-point-in-bounds erc--check-prompt-input-for-multiline-blanks erc--check-prompt-input-for-running-process - erc--check-prompt-input-for-excess-lines) + erc--check-prompt-input-for-excess-lines + erc--check-prompt-input-for-multiline-command) "Validators for user input typed at prompt. Called with latest input string submitted by user and the list of lines produced by splitting it. If any member function returns @@ -6190,19 +6201,15 @@ erc-user-input erc-input-marker (erc-end-of-input-line))) -(defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$" - "Regular expression used for matching commands in ERC.") - (defun erc--discard-trailing-multiline-nulls (state) "Ensure last line of STATE's string is non-null. But only when `erc-send-whitespace-lines' is non-nil. STATE is an `erc--input-split' object." (when (and erc-send-whitespace-lines (erc--input-split-lines state)) (let ((reversed (nreverse (erc--input-split-lines state)))) - (when (string-empty-p (car reversed)) - (pop reversed) - (setf (erc--input-split-cmdp state) nil)) - (nreverse (seq-drop-while #'string-empty-p reversed))))) + (while (and reversed (string-empty-p (car reversed))) + (setq reversed (cdr reversed))) + (setf (erc--input-split-lines state) (nreverse reversed))))) (defun erc-send-input (input &optional skip-ws-chk) "Treat INPUT as typed in by the user. diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index bafe418f0cd..4725d289e5b 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1236,15 +1236,23 @@ erc-send-whitespace-lines (pcase-dolist (`(,p . ,q) '(("/a b\r" "/a b\n") ("/a b\n" "/a b\n") ("/a b\n\n" "/a b\n") ("/a b\r\n" "/a b\n") - ("a b\nc\n\n" "c\n" "a b\n") - ("/a b\nc\n\n" "c\n" "/a b\n") - ("/a b\n\nc\n\n" "c\n" "\n" "/a b\n"))) + ("/a b\n\n\n" "/a b\n"))) (insert p) (erc-send-current-line) (erc-bol) (should (eq (point) (point-max))) (while q - (should (equal (funcall next) (list (pop q) nil t)))) + (should (pcase (funcall next) + (`(,cmd ,_ nil) (equal cmd (pop q)))))) + (should-not (funcall next)))) + + (ert-info ("Multiline command with non-blanks errors") + (dolist (p '("/a b\nc\n\n" "/a b\n/c\n\n" "/a b\n\nc\n\n" + "/a\n c\n" "/a\nb\n" "/a\n/b\n" "/a \n \n")) + (insert p) + (should-error (erc-send-current-line)) + (goto-char erc-input-marker) + (delete-region (point) (point-max)) (should-not (funcall next)))) (ert-info ("Multiline hunk with trailing whitespace not filtered") commit b0d761be0f9b0180566d7cde1ef2eea33402dd4e Author: F. Jason Park Date: Fri Apr 14 00:07:31 2023 -0700 Restore module var toggles in ERC's Custom buffers * lisp/erc/erc-common.el (erc--neuter-custom-variable-state): Remove function. ERC famously toggles global minor-mode vars during normal operations, which adds noise to its customization buffers because `customize-variable-state' always sees an activated module's mode variable as having "CHANGED". To suppress this annoyance, a workaround was employed that used a dishonest `:get' function to simply return the "saved value," when present. While this improved the Customize experience, it also misled users, which likely wasn't justified. (erc--make-show-me-widget): Add helper to avoid forward declarations. (erc--prepare-custom-module-type): Don't deprive users of a working minor-mode toggle. (erc--find-feature): New function to guess the feature of a module's containing library. (define-erc-module): Remove `:get' keyword. Specify `:require' instead, whose value may be nil. Users who currently have mode vars in their `custom-file' won't be impacted by this addition because those `custom-set-variables' entries will still lack a REQUEST list and hence won't incur a startup penalty. And new users intent on using the toggle will hopefully do so with the knowledge they're opting in to requiring ERC on startup, which is not the case if they follow the recommended practice of using `erc-modules' instead. (erc-with-server-buffer): Inline `erc-server-buffer'. * test/lisp/erc/erc-tests.el (erc-process-input-line): Use helper. (define-erc-module--global): Change expected expansion. (Bug#60935) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 6c015c71ff9..708cdb0c422 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -32,6 +32,7 @@ erc-channel-users (defvar erc-dbuf) (defvar erc-log-p) (defvar erc-modules) +(defvar erc-server-process) (defvar erc-server-users) (defvar erc-session-server) @@ -40,6 +41,9 @@ erc-session-server (declare-function erc-server-buffer "erc" nil) (declare-function widget-apply-action "wid-edit" (widget &optional event)) (declare-function widget-at "wid-edit" (&optional pos)) +(declare-function widget-create-child-and-convert "wid-edit" + (parent type &rest args)) +(declare-function widget-default-format-handler "wid-edit" (widget escape)) (declare-function widget-get-sibling "wid-edit" (widget)) (declare-function widget-move "wid-edit" (arg &optional suppress-echo)) (declare-function widget-type "wid-edit" (widget)) @@ -195,16 +199,6 @@ erc--find-group (throw 'found found))) 'erc)) -(defun erc--neuter-custom-variable-state (variable) - "Lie to Customize about VARIABLE's true state. -Do so by always returning its standard value, namely nil." - ;; Make a module's global minor-mode toggle blind to Customize, so - ;; that `customize-variable-state' never sees it as "changed", - ;; regardless of its value. This snippet is - ;; `custom--standard-value' from Emacs 28+. - (cl-assert (null (eval (car (get variable 'standard-value)) t))) - nil) - ;; This exists as a separate, top-level function to prevent the byte ;; compiler from warning about widget-related dependencies not being ;; loaded at runtime. @@ -230,25 +224,42 @@ erc--tick-module-checkbox (substitute-command-keys "\\[Custom-set]") (substitute-command-keys "\\[Custom-save]")))) +;; This stands apart to avoid needing forward declarations for +;; `wid-edit' functions in every file requiring `erc-common'. +(defun erc--make-show-me-widget (widget escape &rest plist) + (if (eq escape ?i) + (apply #'widget-create-child-and-convert widget 'push-button plist) + (widget-default-format-handler widget escape))) + (defun erc--prepare-custom-module-type (name) `(let* ((name (erc--normalize-module-symbol ',name)) (fmtd (format " `%s' " name))) `(boolean - :button-face '(custom-variable-obsolete custom-button) - :format "%{%t%}: %[Deprecated Toggle%] \n%h\n" + :format "%{%t%}: %i %[Deprecated Toggle%] %v \n%h\n" + :format-handler + ,(lambda (widget escape) + (erc--make-show-me-widget + widget escape + :button-face '(custom-variable-obsolete custom-button) + :tag "Show Me" + :action (apply-partially #'erc--tick-module-checkbox name) + :help-echo (lambda (_) + (let ((hasp (memq name erc-modules))) + (concat (if hasp "Remove" "Add") fmtd + (if hasp "from" "to") + " `erc-modules'."))))) + :action widget-toggle-action :documentation-property ,(lambda (_) (let ((hasp (memq name erc-modules))) - (concat "Setting a module's minor-mode variable is " - (propertize "ineffective" 'face 'error) - ".\nPlease " (if hasp "remove" "add") fmtd - (if hasp "from" "to") " `erc-modules' directly instead.\n" - "You can do so now by clicking the scary button above."))) - :help-echo ,(lambda (_) - (let ((hasp (memq name erc-modules))) - (concat (if hasp "Remove" "Add") fmtd - (if hasp "from" "to") " `erc-modules'."))) - :action ,(apply-partially #'erc--tick-module-checkbox name)))) + (concat + "Setting a module's minor-mode variable is " + (propertize "ineffective" 'face 'error) + ".\nPlease " (if hasp "remove" "add") fmtd + (if hasp "from" "to") " `erc-modules' directly instead.\n" + "You can do so now by clicking " + (propertize "Show Me" 'face 'custom-variable-obsolete) + " above.")))))) (defun erc--fill-module-docstring (&rest strings) (with-temp-buffer @@ -264,6 +275,12 @@ erc--fill-module-docstring (goto-char (point-min)) (nth 3 (read (current-buffer))))) +(defmacro erc--find-feature (name alias) + `(pcase (erc--find-group ',name ,(and alias (list 'quote alias))) + ('erc (and-let* ((file (or (macroexp-file-name) buffer-file-name))) + (intern (file-name-base file)))) + (v v))) + (defmacro define-erc-module (name alias doc enable-body disable-body &optional local-p) "Define a new minor mode using ERC conventions. @@ -310,7 +327,7 @@ define-erc-module \n%s" name name doc)) :global ,(not local-p) :group (erc--find-group ',name ,(and alias (list 'quote alias))) - ,@(unless local-p '(:get #'erc--neuter-custom-variable-state)) + ,@(unless local-p `(:require ',(erc--find-feature name alias))) ,@(unless local-p `(:type ,(erc--prepare-custom-module-type name))) (if ,mode (,enable) @@ -371,12 +388,13 @@ erc-with-server-buffer (not (cdr body)) (special-variable-p (car body)))) (buffer (make-symbol "buffer"))) - `(let ((,buffer (erc-server-buffer))) - (when (buffer-live-p ,buffer) - ,(if varp - `(buffer-local-value ',(car body) ,buffer) - `(with-current-buffer ,buffer - ,@body)))))) + `(when-let* (((processp erc-server-process)) + (,buffer (process-buffer erc-server-process)) + ((buffer-live-p ,buffer))) + ,(if varp + `(buffer-local-value ',(car body) ,buffer) + `(with-current-buffer ,buffer + ,@body))))) (defmacro erc-with-all-buffers-of-server (process pred &rest forms) "Execute FORMS in all buffers which have same process as this server. diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 5aaf7e499e3..bafe418f0cd 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1289,15 +1289,12 @@ erc-process-input-line (erc-default-recipients '("#chan")) calls) (with-temp-buffer + (erc-tests--set-fake-server-process "sleep" "1") (cl-letf (((symbol-function 'erc-cmd-MSG) (lambda (line) (push line calls) (should erc--called-as-input-p) (funcall orig-erc-cmd-MSG line))) - ((symbol-function 'erc-server-buffer) - (lambda () (current-buffer))) - ((symbol-function 'erc-server-process-alive) - (lambda () t)) ((symbol-function 'erc-server-send-queue) #'ignore)) @@ -2018,7 +2015,7 @@ define-erc-module--global Some docstring." :global t :group (erc--find-group 'mname 'malias) - :get #'erc--neuter-custom-variable-state + :require 'nil :type "mname" (if erc-mname-mode (erc-mname-enable) commit 2e18ba6302f3e4aa5485eeaca39c747beb55ca8f Author: F. Jason Park Date: Mon Apr 10 17:58:05 2023 -0700 Simplify erc-button movement commands * etc/ERC-NEWS: Mention TAB being bound to new command `erc-tab' and `erc-previous-button' now stopping at the start of buttons. * lisp/erc/erc-button.el (erc-button-mode, erc-button-enable, erc-button-disable): Add and remove `erc-button-next' to `erc--tab-functions' hook, which is tantamount to binding the command in the read-only area of an ERC buffer. (erc-button-next-function): Deprecate and remove from client code path because this module doesn't concern itself with prompt input and thus no longer needs to conform to the `completion-at-point-functions' interface. (erc-button--prev-next-predicate-functions): New variable, a hook to determine whether to continue searching for a button. Other modules should utilize this as needed. (erc-button--end-of-button-p): Add function to serve as default value for `erc-button--continue-predicate'. (erc--button-next): Add generalized button-movement function. (erc-button-next, erc-button-previous): Make `erc-button-previous' behave more predictably by having it land at the beginning of buttons. And remove roundabout appeal to HOF in `erc-button-next'. (erc-button-previous-of-nick): New command to jump to previous appearance of nick at point. * lisp/erc/erc-fill.el (erc-fill-wrap, erc-fill-wrap-enable, erc-fill-wrap-disable): Add and remove merge-related hookee from `erc-button--prev-next-predicate-functions'. (erc-fill--wrap-merged-button-p): New function to detect redundant speakers. * lisp/erc/erc.el (erc-complete-functions): Quote TAB in doc string. (erc-mode-map): Bind `erc-tab' to TAB. (erc--tab-functions, erc-tab): Add new command and hook to serve as unified dispatch for TAB-related operations. It calls `c-a-p' in the input area and defers to module code in the read-only message area. * test/lisp/erc/erc-button-tests.el: New file. * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--wrap-populate): Run finalizer for transient keymap timer. * test/lisp/erc/erc-tests.el (erc-button--display-error-notice-with-keys): Move to new dedicated test file for erc-button and fix expected behavior of `erc-button-previous'. (Bug#62834) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 57dce501760..2cf2743701a 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -128,9 +128,10 @@ renamed 'erc-ensure-target-buffer-on-privmsg'. Some minor quality-of-life niceties have finally made their way to ERC. For example, the function 'erc-echo-timestamp' is now interactive and can be invoked on any message to view its timestamp in -the echo area. Also, the 'irccontrols' module now supports additional -colors and special handling for "spoilers" (hidden text). And issuing -an "/MOTD" now dispatches a purpose-built command handler. +the echo area. The command 'erc-button-previous' now moves to the +beginning instead of the end of buttons. And the 'irccontrols' module +now supports additional colors and special handling for "spoilers" +(hidden text). ** Changes in the library API. @@ -199,10 +200,13 @@ example, requiring the use of 'insert-before-markers' instead of changes are encouraged to voice their concerns on the bug list. *** Miscellaneous changes -For autoloading purposes, 'Info-goto-node' has been supplanted by -plain old 'info' in 'erc-button-alist', and two helper macros from GNU -ELPA's Compat library are now available to third-party modules as -'erc-compat-call' and 'erc-compat-function'. +Two helper macros from GNU ELPA's Compat library are now available to +third-party modules as 'erc-compat-call' and 'erc-compat-function'. +In the area of buttons, 'Info-goto-node' has been supplanted by plain +old 'info' in 'erc-button-alist', primarily for autoloading purposes. +And the "TAB" key is now bound to a new command, 'erc-tab', that only +calls 'completion-at-point' when point is in the input area and +module-specific commands, like 'erc-button-next', otherwise. * Changes in ERC 5.5 diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 33e69f3b0b8..e2447deecde 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -55,11 +55,11 @@ button ((erc-button--check-nicknames-entry) (add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append) (add-hook 'erc-send-modify-hook #'erc-button-add-buttons 'append) - (add-hook 'erc-complete-functions #'erc-button-next-function) + (add-hook 'erc--tab-functions #'erc-button-next) (erc--modify-local-map t "" #'erc-button-previous)) ((remove-hook 'erc-insert-modify-hook #'erc-button-add-buttons) (remove-hook 'erc-send-modify-hook #'erc-button-add-buttons) - (remove-hook 'erc-complete-functions #'erc-button-next-function) + (remove-hook 'erc--tab-functions #'erc-button-next) (erc--modify-local-map nil "" #'erc-button-previous))) ;;; Variables @@ -529,6 +529,7 @@ erc-button-press-button (defun erc-button-next-function () "Pseudo completion function that actually jumps to the next button. For use on `completion-at-point-functions'." + (declare (obsolete erc-nickserv-identify "30.1")) ;; FIXME: This is an abuse of completion-at-point-functions. (when (< (point) (erc-beg-of-input-line)) (let ((start (point))) @@ -546,27 +547,73 @@ erc-button-next-function (error "No next button")) t))))) -(defun erc-button-next () - "Go to the next button in this buffer." - (interactive) - (let ((f (erc-button-next-function))) - (if f (funcall f)))) - -(defun erc-button-previous () - "Go to the previous button in this buffer." - (interactive) - (let ((here (point))) - (when (< here (erc-beg-of-input-line)) - (while (and (get-text-property here 'erc-callback) - (not (= here (point-min)))) - (setq here (1- here))) - (while (and (not (get-text-property here 'erc-callback)) - (not (= here (point-min)))) - (setq here (1- here))) - (if (> here (point-min)) - (goto-char here) - (error "No previous button")) - t))) +(defvar erc-button--prev-next-predicate-functions + '(erc-button--end-of-button-p) + "Abnormal hook whose members can return non-nil to continue searching. +Otherwise, if all members return nil, point will stay at the +current button. Called with a single arg, a buffer position +greater than `point-min' with a text property of `erc-callback'.") + +(defun erc-button--end-of-button-p (point) + (get-text-property (1- point) 'erc-callback)) + +(defun erc--button-next (arg) + (let* ((nextp (prog1 (>= arg 1) (setq arg (max 1 (abs arg))))) + (search-fn (if nextp + #'next-single-char-property-change + #'previous-single-char-property-change)) + (start (point)) + (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))) + (setq p q)) + ;; Assume that buttons occur frequently enough that + ;; omitting LIMIT is acceptable. + (while + (and (setq p (funcall search-fn p 'erc-callback)) + (if nextp (< p erc-insert-marker) (/= p (point-min))) + (run-hook-with-args-until-success + 'erc-button--prev-next-predicate-functions p))) + (and arg + (< (point-min) p erc-insert-marker) + (goto-char p) + (not (zerop (cl-decf arg)))))) + (when (= (point) start) + (user-error (if nextp "No next button" "No previous button"))) + t)) + +(defun erc-button-next (&optional arg) + "Go to the ARGth next button." + (declare (advertised-calling-convention (arg) "30.1")) + (interactive "p") + (setq arg (pcase arg ((pred listp) (prefix-numeric-value arg)) (_ arg))) + (erc--button-next arg)) + +(defun erc-button-previous (&optional arg) + "Go to ARGth previous button." + (declare (advertised-calling-convention (arg) "30.1")) + (interactive "p") + (setq arg (pcase arg ((pred listp) (prefix-numeric-value arg)) (_ arg))) + (erc--button-next (- arg))) + +(defun erc-button-previous-of-nick (arg) + "Go to ARGth previous button for nick at point." + (interactive "p") + (if-let* ((prop (get-text-property (point) 'erc-data)) + (erc-button--prev-next-predicate-functions + (cons (lambda (p) + (not (equal (get-text-property p 'erc-data) prop))) + erc-button--prev-next-predicate-functions))) + (erc--button-next (- arg)) + (user-error "No nick at point"))) (defun erc-browse-emacswiki (thing) "Browse to THING in the emacs-wiki." diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index a56134d8188..bf995a5a5e6 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -300,7 +300,9 @@ fill-wrap (setq msg (concat msg (and msg " ") (erc-fill--make-module-dependency-msg "button")))) (erc-with-server-buffer - (erc-button-mode +1)))) + (erc-button-mode +1))) + (add-hook 'erc-button--prev-next-predicate-functions + #'erc-fill--wrap-merged-button-p nil t)) ;; Set local value of user option (can we avoid this somehow?) (unless (eq erc-fill-function #'erc-fill-wrap) (setq-local erc-fill-function #'erc-fill-wrap)) @@ -328,6 +330,8 @@ fill-wrap (kill-local-variable 'erc-fill--wrap-value) (kill-local-variable 'erc-fill-function) (kill-local-variable 'erc-fill--wrap-visual-keys) + (remove-hook 'erc-button--prev-next-predicate-functions + #'erc-fill--wrap-merged-button-p t) (remove-function (local 'erc-stamp--insert-date-function) #'erc-fill--wrap-stamp-insert-prefixed-date) (visual-line-mode -1)) @@ -414,6 +418,10 @@ erc-fill-wrap `((space :width (- erc-fill--wrap-value ,len)) (space :width erc-fill--wrap-value)))))) +;; FIXME use own text property to avoid false positives. +(defun erc-fill--wrap-merged-button-p (point) + (equal "" (get-text-property point 'display))) + ;; This is an experimental helper for third-party modules. You could, ;; for example, use this to automatically resize the prefix to a ;; fraction of the window's width on some event change. Another use diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 05b6b5bfd21..a439e2438b0 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -354,7 +354,7 @@ erc-disconnected-hook :type 'hook) (defcustom erc-complete-functions nil - "These functions get called when the user hits TAB in ERC. + "These functions get called when the user hits \\`TAB' in ERC. Each function in turn is called until one returns non-nil to indicate it has handled the input." :group 'erc-hooks @@ -1231,7 +1231,7 @@ erc-mode-map (define-key map "\C-c\C-u" #'erc-kill-input) (define-key map "\C-c\C-x" #'erc-quit-server) (define-key map "\M-\t" #'ispell-complete-word) - (define-key map "\t" #'completion-at-point) + (define-key map "\t" #'erc-tab) ;; Suppress `font-lock-fontify-block' key binding since it ;; destroys face properties. @@ -4675,6 +4675,19 @@ erc-kill-input (setq erc-input-ring-index nil)) (kill-line))) +(defvar erc--tab-functions nil + "Functions to try when user hits \\`TAB' outside of input area. +Called with a numeric prefix arg.") + +(defun erc-tab (&optional arg) + "Call `completion-at-point' when typing in the input area. +Otherwise call members of `erc--tab-functions' with raw prefix +ARG until one of them returns non-nil." + (interactive "P") + (if (>= (point) erc-input-marker) + (completion-at-point) + (run-hook-with-args-until-success 'erc--tab-functions arg))) + (defun erc-complete-word-at-point () (run-hook-with-args-until-success 'erc-complete-functions)) diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el new file mode 100644 index 00000000000..ced08d117bc --- /dev/null +++ b/test/lisp/erc/erc-button-tests.el @@ -0,0 +1,177 @@ +;;; erc-button-tests.el --- Tests for erc-button -*- lexical-binding:t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'erc-button) + +(defun erc-button-tests--insert-privmsg (speaker &rest msg-parts) + (declare (indent 1)) + (let ((msg (erc-format-privmessage speaker + (apply #'concat msg-parts) nil t))) + (erc-display-message nil nil (current-buffer) msg))) + +(defun erc-button-tests--populate (test) + (let ((inhibit-message noninteractive) + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + + (with-current-buffer + (cl-letf + (((symbol-function 'erc-server-connect) + (lambda (&rest _) + (setq erc-server-process + (start-process "sleep" (current-buffer) "sleep" "1")) + (set-process-query-on-exit-flag erc-server-process nil)))) + + (erc-open "localhost" 6667 "tester" "Tester" 'connect + nil nil nil nil nil "tester" 'foonet)) + + (with-current-buffer (erc--open-target "#chan") + (erc-update-channel-member + "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t) + + (erc-update-channel-member + "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t) + + (erc-display-message + nil 'notice (current-buffer) + (concat "This server is in debug mode and is logging all user I/O. " + "Blah alice (1) bob (2) blah.")) + + (funcall test)) + + (when noninteractive + (kill-buffer "#chan") + (kill-buffer))))) + +(ert-deftest erc-button-next () + (erc-button-tests--populate + (lambda () + (erc-button-tests--insert-privmsg "alice" + "(3) bob (4) come, you are a tedious fool: to the purpose.") + + (erc-button-tests--insert-privmsg "bob" + "(5) alice (6) Come me to what was done to her.") + + (should (= erc-input-marker (point))) + + ;; Break out of input area + (erc-button-previous 1) + (should (looking-at (rx "alice (6)"))) + + ;; No next button + (should-error (erc-button-next 1) :type 'user-error) + (should (looking-at (rx "alice (6)"))) + + ;; Next with negative arg is equivalent to previous + (erc-button-next -1) + (should (looking-at (rx "bob> (5)"))) + + ;; One past end of button + (forward-char 3) + (should (looking-at (rx "> (5)"))) + (should-not (get-text-property (point) 'erc-callback)) + (erc-button-previous 1) + (should (looking-at (rx "bob> (5)"))) + + ;; At end of button + (forward-char 2) + (should (looking-at (rx "b> (5)"))) + (erc-button-previous 1) + (should (looking-at (rx "bob (4)"))) + + ;; Skip multiple buttons back + (erc-button-previous 2) + (should (looking-at (rx "bob (2)"))) + + ;; Skip multiple buttons forward + (erc-button-next 2) + (should (looking-at (rx "bob (4)"))) + + ;; No error as long as some progress made + (erc-button-previous 100) + (should (looking-at (rx "alice (1)"))) + + ;; Error when no progress made + (should-error (erc-button-previous 1) :type 'user-error) + (should (looking-at (rx "alice (1)")))))) + +;; See also `erc-scenarios-networks-announced-missing' in +;; erc-scenarios-misc.el for a more realistic example. +(ert-deftest erc-button--display-error-notice-with-keys () + (with-current-buffer (get-buffer-create "*fake*") + (let ((mode erc-button-mode) + (inhibit-message noninteractive) + erc-modules + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (erc-mode) + (setq erc-server-process + (start-process "sleep" (current-buffer) "sleep" "1")) + (set-process-query-on-exit-flag erc-server-process nil) + (erc--initialize-markers (point) nil) + (erc-button-mode +1) + (should (equal (erc-button--display-error-notice-with-keys + "If \\[erc-bol] fails, " + "see \\[erc-bug] or `erc-mode-map'.") + "*** If C-a fails, see M-x erc-bug or `erc-mode-map'.")) + (goto-char (point-min)) + + (ert-info ("Keymap substitution succeeds") + (erc-button-next 1) + (should (looking-at "C-a")) + (should (eq (get-text-property (point) 'mouse-face) 'highlight)) + (erc-button-press-button) + (with-current-buffer "*Help*" + (goto-char (point-min)) + (should (search-forward "erc-bol" nil t))) + (erc-button-next 1) + ;; End of interval correct + (erc-button-previous 1) + (should (looking-at "C-a fails"))) + + (ert-info ("Extended command mapping succeeds") + (erc-button-next 1) + (should (looking-at "M-x erc-bug")) + (erc-button-press-button) + (should (eq (get-text-property (point) 'mouse-face) 'highlight)) + (with-current-buffer "*Help*" + (goto-char (point-min)) + (should (search-forward "erc-bug" nil t)))) + + (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k + (erc-button-next 1) + (should (equal (get-text-property (point) 'font-lock-face) + '(erc-button erc-error-face))) + (should (eq (get-text-property (point) 'mouse-face) 'highlight)) + (should (eq erc-button-face 'erc-button))) ; extent evaporates + + (ert-info ("Format when trailing args include non-strings") + (should (equal (erc-button--display-error-notice-with-keys + "abc" " %d def" " 45%s" 123 '\6) + "*** abc 123 def 456"))) + + (when noninteractive + (unless mode + (erc-button-mode -1)) + (kill-buffer "*Help*") + (kill-buffer))))) + +;;; erc-button-tests.el ends here diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index e8dd25e8ea1..170436ffbaa 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -94,6 +94,8 @@ erc-fill-tests--wrap-populate ;; Defend against non-local exits from `ert-skip' (unwind-protect (funcall test) + (when set-transient-map-timer + (timer-event-handler set-transient-map-timer)) (set-window-buffer (selected-window) original-window-buffer) (when noninteractive (while-let ((buf (pop erc-fill-tests--buffers))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 88b9babf206..5aaf7e499e3 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2110,65 +2110,4 @@ define-erc-module--local (put 'erc-mname-enable 'definition-name 'mname) (put 'erc-mname-disable 'definition-name 'mname)))))) - -;; XXX move erc-button tests to new file if more added. -(require 'erc-button) - -;; See also `erc-scenarios-networks-announced-missing' in -;; erc-scenarios-misc.el for a more realistic example. -(ert-deftest erc-button--display-error-notice-with-keys () - (with-current-buffer (get-buffer-create "*fake*") - (let ((mode erc-button-mode) - (inhibit-message noninteractive) - erc-modules - erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) - (erc-mode) - (erc-tests--set-fake-server-process "sleep" "1") - (erc--initialize-markers (point) nil) - (erc-button-mode +1) - (should (equal (erc-button--display-error-notice-with-keys - "If \\[erc-bol] fails, " - "see \\[erc-bug] or `erc-mode-map'.") - "*** If C-a fails, see M-x erc-bug or `erc-mode-map'.")) - (goto-char (point-min)) - - (ert-info ("Keymap substitution succeeds") - (erc-button-next) - (should (looking-at "C-a")) - (should (eq (get-text-property (point) 'mouse-face) 'highlight)) - (erc-button-press-button) - (with-current-buffer "*Help*" - (goto-char (point-min)) - (should (search-forward "erc-bol" nil t))) - (erc-button-next) - (erc-button-previous) ; end of interval correct - (should (looking-at "a fails"))) - - (ert-info ("Extended command mapping succeeds") - (erc-button-next) - (should (looking-at "M-x erc-bug")) - (erc-button-press-button) - (should (eq (get-text-property (point) 'mouse-face) 'highlight)) - (with-current-buffer "*Help*" - (goto-char (point-min)) - (should (search-forward "erc-bug" nil t)))) - - (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k - (erc-button-next) - (should (equal (get-text-property (point) 'font-lock-face) - '(erc-button erc-error-face))) - (should (eq (get-text-property (point) 'mouse-face) 'highlight)) - (should (eq erc-button-face 'erc-button))) ; extent evaporates - - (ert-info ("Format when trailing args include non-strings") - (should (equal (erc-button--display-error-notice-with-keys - "abc" " %d def" " 45%s" 123 '\6) - "*** abc 123 def 456"))) - - (when noninteractive - (unless mode - (erc-button-mode -1)) - (kill-buffer "*Help*") - (kill-buffer))))) - ;;; erc-tests.el ends here commit 2641dfd4b4334942282358b50d74f75424ebf4fa Author: F. Jason Park Date: Wed Apr 26 07:05:49 2023 -0700 Add erc-timestamp property to invisible messages * lisp/erc/erc-fill.el (erc-fill--wrap-beginning-of-line): Pretend nicks with an empty string as a `display' prop are `invisible-p' and break out of hidden "merged" nicks after moving. (Bug#60936.) * lisp/erc/erc-match.el (erc-hide-fools): Add comment. * lisp/erc/erc-stamp.el (erc-add-timestamp): Always add `erc-timestamp' and `cursor-sensor-functions' properties but respect tradition and don't actually stamp any invisible messages. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 7b6495f9f3f..a56134d8188 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -221,8 +221,13 @@ erc-fill--wrap-beginning-of-line (let ((inhibit-field-text-motion t)) (erc-fill--wrap-move #'move-beginning-of-line #'beginning-of-visual-line arg)) - (when (get-text-property (point) 'erc-prompt) - (goto-char erc-input-marker))) + (if (get-text-property (point) 'erc-prompt) + (goto-char erc-input-marker) + ;; Mimic what `move-beginning-of-line' does with invisible text. + (when-let ((erc-fill-wrap-merge) + (empty (get-text-property (point) 'display)) + ((string-empty-p empty))) + (goto-char (text-property-not-all (point) (pos-eol) 'display empty))))) (defun erc-fill--wrap-end-of-line (arg) "Defer to `move-end-of-line' or `end-of-visual-line'." @@ -389,6 +394,9 @@ erc-fill-wrap (progn (skip-syntax-forward "^-") (forward-char) + ;; Using the `invisible' property might make more + ;; sense, but that would require coordination + ;; with other modules, like `erc-match'. (cond ((and erc-fill-wrap-merge (erc-fill--wrap-continued-message-p)) (put-text-property (point-min) (point) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 82b821503a8..c08a640260c 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -654,6 +654,8 @@ erc-go-to-log-matches-buffer (defvar-local erc-match--hide-fools-offset-bounds nil) +;; FIXME this should merge with instead of overwrite existing +;; `invisible' values. (defun erc-hide-fools (match-type _nickuserhost _message) "Hide foolish comments. This function should be called from `erc-text-matched-hook'." diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 61f289a8753..f90a8fc50b1 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -198,13 +198,15 @@ erc-add-timestamp This function is meant to be called from `erc-insert-modify-hook' or `erc-send-modify-hook'." - (unless (get-text-property (point-min) 'invisible) + (progn ; remove this `progn' on next major refactor (let* ((ct (erc-stamp--current-time)) + (invisible (get-text-property (point-min) 'invisible)) (erc-stamp--current-time ct)) - (funcall erc-insert-timestamp-function - (erc-format-timestamp ct erc-timestamp-format)) + (unless invisible + (funcall erc-insert-timestamp-function + (erc-format-timestamp ct erc-timestamp-format))) ;; FIXME this will error when advice has been applied. - (when (and (fboundp erc-insert-away-timestamp-function) + (when (and (not invisible) (fboundp erc-insert-away-timestamp-function) erc-away-timestamp-format (erc-away-time) (not erc-timestamp-format)) commit 90a9c7b7b594dfcdc985541eb366e5684136c3ec Author: F. Jason Park Date: Fri Apr 21 07:30:18 2023 -0700 Actually define erc-default-server-functions * lisp/erc/erc-backend.el: Remove top-level `add-hook' for `erc-default-server-functions'. * lisp/erc/erc.el (erc-default-server-hook, erc-default-server-functions): Officially deprecate the former and rename it to the latter. (erc-default-server-handler): Mark obsolete because its replacement took over years ago. (erc-debug-missing-hooks): Append instead of mutate. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index d14640e798d..0c970a9d586 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1459,8 +1459,6 @@ erc-call-hooks (erc-with-server-buffer (run-hook-with-args 'erc-timer-hook (erc-current-time))))) -(add-hook 'erc-default-server-functions #'erc-handle-unknown-server-response) - (defun erc-handle-unknown-server-response (proc parsed) "Display unknown server response's message." (let ((line (concat (erc-response.sender parsed) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index fec1e1a4eb9..05b6b5bfd21 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4689,9 +4689,13 @@ erc-complete-word-at-point ; Stolen from ZenIRC. I just wanna test this code, so here is ; experiment area. -(defcustom erc-default-server-hook '(erc-debug-missing-hooks - erc-default-server-handler) - "Default for server messages which aren't covered by `erc-server-hooks'." +;; This shouldn't be a user option but remains so for compatibility. +(define-obsolete-variable-alias + 'erc-default-server-hook 'erc-default-server-functions "30.1") +(defcustom erc-default-server-functions '(erc-handle-unknown-server-response) + "Abnormal hook for incoming messages without their own handlers. +See `define-erc-response-handler' for more." + :package-version '(ERC . "5.6") :group 'erc-server-hooks :type 'hook) @@ -4699,6 +4703,7 @@ erc-default-server-handler "Default server handler. Displays PROC and PARSED appropriately using `erc-display-message'." + (declare (obsolete erc-handle-unknown-server-response "29.1")) (erc-display-message parsed 'notice proc (mapconcat @@ -4721,7 +4726,7 @@ erc-debug-missing-hooks "Add PARSED server message ERC does not yet handle to `erc-server-vectors'. These vectors can be helpful when adding new server message handlers to ERC. See `erc-default-server-hook'." - (nconc erc-server-vectors (list parsed)) + (setq erc-server-vectors `(,@erc-server-vectors ,parsed)) nil) (defun erc--open-target (target) @@ -4915,6 +4920,9 @@ erc-nickname-in-use ;;; Server messages +;; FIXME remove on next major version release. This group is all but +;; unused because most `erc-server-FOO-functions' are plain variables +;; and not user options as implied by this doc string. (defgroup erc-server-hooks nil "Server event callbacks. Every server event - like numeric replies - has its own hook. commit 9e1a5a389ed255c159e22d9d01b91631a114cd73 Author: F. Jason Park Date: Thu Apr 20 19:20:59 2023 -0700 Ignore erc-reconnect-display after a timeout * lisp/erc/erc-backend.el (erc--server-reconnect-display-timer): New variable to store active timer that, upon firing, zeroes out `erc--server-last-reconnect-count'. (erc--server-last-reconnect-on-disconnect): New function to run on `erc-disconnected-hook'. (erc--server-last-reconnect-display-reset): New function to ensure the reconnect-display period ends. * lisp/erc/erc.el (erc-reconnect-display-timeout): New option to control how long `erc-reconnect-display' affects the displaying of new buffers following an automatic reconnection. (erc-process-input-line): Ensure user input marks the end of the reconnect-display period. (erc-cmd-JOIN): Don't bother resetting `erc--server-last-reconnect-count' because it's now handled by its sometime caller, `erc-process-input-line'. (erc-connection-established): Schedule timer and register hook to reset last-reconnect count and terminate the reconnect-display period. * test/lisp/erc/erc-scenarios-base-buffer-display.el: (erc-scenarios-base-buffer-display--reconnect-common): Add new args to test fixture to allow for asserting display properties at various stages throughout a session. (erc-scenarios-base-reconnect-options--buffer, erc-scenarios-base-buffer-display--defwin-recbury-intbuf): Rename former to latter and rework to better reflect realistic settings for the relevant display options. (erc-scenarios-base-reconnect-options--default, erc-scenarios-base-buffer-display--defwino-recbury-intbuf): Rename former to latter and rework to be more realistic. (erc-scenarios-base-buffer-display--count-reset-timeout): New test for new option `erc-reconnect-display-timeout'. (Bug#62833) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 98a1c117cfa..d14640e798d 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -299,6 +299,12 @@ erc-server-connected (defvar-local erc-server-reconnect-count 0 "Number of times we have failed to reconnect to the current server.") +(defvar-local erc--server-reconnect-display-timer nil + "Timer that resets `erc--server-last-reconnect-count' to zero. +Becomes non-nil in all server buffers when an IRC connection is +first \"established\" and carries out its duties +`erc-reconnect-display-timeout' seconds later.") + (defvar-local erc--server-last-reconnect-count 0 "Snapshot of reconnect count when the connection was established.") @@ -903,6 +909,22 @@ erc-server-reconnect-p erc-server-reconnecting) (erc--server-reconnect-p event))) +(defun erc--server-last-reconnect-on-disconnect (&rest _) + (remove-hook 'erc-disconnected-hook + #'erc--server-last-reconnect-on-disconnect t) + (erc--server-last-reconnect-display-reset (current-buffer))) + +(defun erc--server-last-reconnect-display-reset (buffer) + "Deactivate `erc-reconnect-display'." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when erc--server-reconnect-display-timer + (cancel-timer erc--server-reconnect-display-timer) + (remove-hook 'erc-disconnected-hook + #'erc--server-last-reconnect-display-reset t) + (setq erc--server-reconnect-display-timer nil + erc--server-last-reconnect-count 0))))) + (defconst erc--mode-line-process-reconnecting '(:eval (erc-with-server-buffer (and erc--server-reconnect-timer diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 13f6da2d5be..fec1e1a4eb9 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1564,6 +1564,13 @@ erc-reconnect-display (const :tag "Bury in new buffer" bury) (const :tag "Use current buffer" buffer))) +(defcustom erc-reconnect-display-timeout 10 + "Duration `erc-reconnect-display' remains active. +The countdown starts on MOTD and is canceled early by any +\"slash\" command." + :type 'integer + :group 'erc-buffers) + (defcustom erc-frame-alist nil "Alist of frame parameters for creating erc frames. A value of nil means to use `default-frame-alist'." @@ -3127,6 +3134,7 @@ erc-process-input-line (let* ((cmd (nth 0 command-list)) (args (nth 1 command-list)) (erc--called-as-input-p t)) + (erc--server-last-reconnect-display-reset (erc-server-buffer)) (condition-case nil (if (listp args) (apply cmd args) @@ -3599,7 +3607,6 @@ erc-cmd-JOIN ((with-current-buffer existing (erc-get-channel-user (erc-current-nick))))) (switch-to-buffer existing) - (setq erc--server-last-reconnect-count 0) (when-let* ; bind `erc-join-buffer' when /JOIN issued ((erc--called-as-input-p) (fn (lambda (proc parsed) @@ -5204,6 +5211,12 @@ erc-connection-established (setq erc-server-connected t) (setq erc--server-last-reconnect-count erc-server-reconnect-count erc-server-reconnect-count 0) + (setq erc--server-reconnect-display-timer + (run-at-time erc-reconnect-display-timeout nil + #'erc--server-last-reconnect-display-reset + (current-buffer))) + (add-hook 'erc-disconnected-hook + #'erc--server-last-reconnect-on-disconnect nil t) (erc-update-mode-line) (erc-set-initial-user-mode nick buffer) (erc-server-setup-periodical-ping buffer) diff --git a/test/lisp/erc/erc-scenarios-base-buffer-display.el b/test/lisp/erc/erc-scenarios-base-buffer-display.el index 3ed7a83653e..548ad00e2d9 100644 --- a/test/lisp/erc/erc-scenarios-base-buffer-display.el +++ b/test/lisp/erc/erc-scenarios-base-buffer-display.el @@ -29,7 +29,8 @@ ;; These first couple `erc-reconnect-display' tests used to live in ;; erc-scenarios-base-reconnect but have since been renamed. -(defun erc-scenarios-base-buffer-display--reconnect-common (test) +(defun erc-scenarios-base-buffer-display--reconnect-common + (assert-server assert-chan assert-rest) (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "base/reconnect") (dumb-server (erc-d-run "localhost" t 'options 'options-again)) @@ -37,87 +38,163 @@ erc-scenarios-base-buffer-display--reconnect-common (expect (erc-d-t-make-expecter)) (erc-server-flood-penalty 0.1) (erc-server-auto-reconnect t) - erc-autojoin-channels-alist - erc-server-buffer) + erc-autojoin-channels-alist) (should (memq 'autojoin erc-modules)) (ert-info ("Connect to foonet") - (setq erc-server-buffer (erc :server "127.0.0.1" - :port port - :nick "tester" - :password "changeme" - :full-name "tester")) - (with-current-buffer erc-server-buffer + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "changeme" + :full-name "tester") + (funcall assert-server expect) (should (string= (buffer-name) (format "127.0.0.1:%d" port))) (funcall expect 10 "debug mode"))) (ert-info ("Wait for some output in channels") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall assert-chan expect) (funcall expect 10 "welcome"))) (ert-info ("Server buffer shows connection failed") - (with-current-buffer erc-server-buffer + (with-current-buffer "FooNet" (funcall expect 10 "Connection failed! Re-establishing"))) (should (equal erc-autojoin-channels-alist '((FooNet "#chan")))) - - (funcall test) - - ;; A manual /JOIN command tells ERC we're done auto-reconnecting - (with-current-buffer "FooNet" (erc-cmd-JOIN "#spam")) - - (erc-d-t-ensure-for 1 "Newly joined chan ignores `erc-reconnect-display'" - (not (eq (window-buffer) (get-buffer "#spam")))) + (delete-other-windows) + (pop-to-buffer-same-window "*Messages*") (ert-info ("Wait for auto reconnect") - (with-current-buffer erc-server-buffer - (funcall expect 10 "still in debug mode"))) + (with-current-buffer "FooNet" (funcall expect 10 "still in debug mode"))) - (ert-info ("Wait for activity to recommence in channels") + (funcall assert-rest expect) + + (ert-info ("Wait for activity to recommence in both channels") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) (funcall expect 10 "forest of Arden")) (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) (funcall expect 10 "her elves come here anon"))))) -(ert-deftest erc-scenarios-base-reconnect-options--buffer () +(ert-deftest erc-scenarios-base-buffer-display--defwin-recbury-intbuf () :tags '(:expensive-test) - (should (eq erc-join-buffer 'bury)) + (should (eq erc-buffer-display 'bury)) + (should (eq erc-interactive-display 'window)) (should-not erc-reconnect-display) - ;; FooNet (the server buffer) is not switched to because it's - ;; already current (but not shown) when `erc-open' is called. See - ;; related conditional guard towards the end of that function. + (let ((erc-buffer-display 'window) + (erc-interactive-display 'buffer) + (erc-reconnect-display 'bury)) - (let ((erc-reconnect-display 'buffer)) (erc-scenarios-base-buffer-display--reconnect-common - (lambda () - (pop-to-buffer-same-window "*Messages*") - (erc-d-t-ensure-for 1 "Server buffer not shown" - (not (eq (window-buffer) (get-buffer "FooNet")))) + (lambda (_) + (should (eq (window-buffer) (current-buffer))) + (should-not (frame-root-window-p (selected-window)))) - (erc-d-t-wait-for 5 "Channel #chan shown when autojoined" - (eq (window-buffer) (get-buffer "#chan"))))))) + (lambda (_) + (should (eq (window-buffer) (current-buffer))) + (should (equal (get-buffer "FooNet") (window-buffer (next-window))))) -(ert-deftest erc-scenarios-base-reconnect-options--default () - :tags '(:expensive-test) - (should (eq erc-join-buffer 'bury)) - (should-not erc-reconnect-display) + (lambda (_) + (with-current-buffer "FooNet" + (should (eq (window-buffer) (messages-buffer))) + (should (frame-root-window-p (selected-window)))) - (erc-scenarios-base-buffer-display--reconnect-common + ;; A manual /JOIN command tells ERC we're done auto-reconnecting + (with-current-buffer "FooNet" (erc-scenarios-common-say "/JOIN #spam")) - (lambda () - (pop-to-buffer-same-window "*Messages*") + (ert-info ("#spam ignores `erc-reconnect-display'") + ;; Uses `erc-interactive-display' instead. + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (should (eq (window-buffer) (get-buffer "#spam"))) + ;; Option `buffer' replaces entire window (no split) + (erc-d-t-wait-for 5 (frame-root-window-p (selected-window))))))))) - (erc-d-t-ensure-for 1 "Server buffer not shown" - (not (eq (window-buffer) (get-buffer "FooNet")))) +(ert-deftest erc-scenarios-base-buffer-display--defwino-recbury-intbuf () + :tags '(:expensive-test) + (should (eq erc-buffer-display 'bury)) + (should (eq erc-interactive-display 'window)) + (should-not erc-reconnect-display) - (erc-d-t-ensure-for 3 "Channel #chan not shown" - (not (eq (window-buffer) (get-buffer "#chan")))) + (let ((erc-buffer-display 'window-noselect) + (erc-reconnect-display 'bury) + (erc-interactive-display 'buffer)) + (erc-scenarios-base-buffer-display--reconnect-common - (should (eq (window-buffer) (messages-buffer)))))) + (lambda (_) + ;; Selected window shows some non-ERC buffer. New server + ;; buffer appears in another window (other side of split). + (should-not (frame-root-window-p (selected-window))) + (should-not (eq (window-buffer) (current-buffer))) + (with-current-buffer (window-buffer) + (should-not (derived-mode-p 'erc-mode))) + (should (eq (current-buffer) (window-buffer (next-window))))) + + (lambda (_) + (should-not (frame-root-window-p (selected-window))) + ;; Current split likely shows scratch. + (with-current-buffer (window-buffer) + (should-not (derived-mode-p 'erc-mode))) + (should (eq (current-buffer) (window-buffer (next-window))))) + + (lambda (_) + (with-current-buffer "FooNet" + (should (eq (window-buffer) (messages-buffer))) + (should (frame-root-window-p (selected-window)))) + + ;; A non-interactive JOIN command doesn't signal that we're + ;; done auto-reconnecting, and `erc-interactive-display' is + ;; ignored, so `erc-buffer-display' is again in charge (here, + ;; that means `window-noselect'). + (ert-info ("Join chan noninteractively and open a /QUERY") + (with-current-buffer "FooNet" + (erc-cmd-JOIN "#spam") + ;; However this will reset the option. + (erc-scenarios-common-say "/QUERY bob") + (should (eq (window-buffer) (get-buffer "bob"))) + (should (frame-root-window-p (selected-window))))) + + (ert-info ("Newly joined chan ignores `erc-reconnect-display'") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (should (eq (window-buffer) (get-buffer "bob"))) + (should-not (frame-root-window-p (selected-window))) + (should (eq (current-buffer) (window-buffer (next-window)))))))))) + +(ert-deftest erc-scenarios-base-buffer-display--count-reset-timeout () + :tags '(:expensive-test) + (should (eq erc-buffer-display 'bury)) + (should (eq erc-interactive-display 'window)) + (should (eq erc-reconnect-display-timeout 10)) + (should-not erc-reconnect-display) + (let ((erc-buffer-display 'window-noselect) + (erc-reconnect-display 'bury) + (erc-interactive-display 'buffer) + (erc-reconnect-display-timeout 0.5)) + (erc-scenarios-base-buffer-display--reconnect-common + #'ignore #'ignore ; These two are identical to the previous test. + + (lambda (_) + (with-current-buffer "FooNet" + (should erc--server-reconnect-display-timer) + (should (eq (window-buffer) (messages-buffer))) + (should (frame-root-window-p (selected-window)))) + + ;; A non-interactive JOIN command doesn't signal that we're + ;; done auto-reconnecting + (ert-info ("Join chan noninteractively") + (with-current-buffer "FooNet" + (erc-d-t-wait-for 1 (null erc--server-reconnect-display-timer)) + (erc-cmd-JOIN "#spam"))) + + (ert-info ("Newly joined chan ignores `erc-reconnect-display'") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (should (eq (window-buffer) (messages-buffer))) + ;; If `erc-reconnect-display-timeout' were left alone, this + ;; would be (frame-root-window-p #). + (should-not (frame-root-window-p (selected-window))) + (should (eq (current-buffer) (window-buffer (next-window)))))))))) ;; This shows that the option `erc-interactive-display' overrides ;; `erc-join-buffer' during cold opens and interactive /JOINs. commit 5de90fa9611ec796a0c459dbcd32a246ff76543c Author: F. Jason Park Date: Mon Apr 10 17:58:05 2023 -0700 Extend erc-interactive-display to cover /JOINs * lisp/erc/erc.el (erc-display): Mention that buffer-related display options live in the customization group `erc-buffers'. (erc-buffer-display, erc-join-buffer): Swap alias and aliased so that the favored name, `erc-buffer-display', appears in the definition and in the Customize menu. Also note related buffer-display options in the doc string. (erc-query-display, erc-interactive-display): Make the former an alias of the latter, new in ERC 5.6, because their roles were functionally redundant and thus confusing. Inherit the default value from `erc-query-display' because users are more familiar with the pop-up window behavior than a single-window replacement. (erc-reconnect-display): Use preferred name for cross-referencing fallback option `erc-buffer-display' in doc string, and explain how /reconnect handling differs. (erc--setup-buffer-hook): Add new internal hook for modules that operate on windows and frames, such as erc-speedbar and erc-status-sidebar. (erc-open): Run `erc--setup-buffer-hook' after `erc-setup-buffer' so hook members know their code isn't tied to `erc-setup-buffer' itself, which may be used in other contexts, but rather to a new ERC buffer on which some display-related action has just been performed. (erc--called-as-input-p): New variable for "slash" commands, like `erc-cmd-FOO', to detect whether they're being called "interactively" as a result of input given at ERC's prompt. (erc-process-input-line): Bind `erc--called-as-input-p' when running slash commands. (erc-cmd-JOIN): When called interactively, schedule a callback to wrap the response handler and control how new buffers are thus displayed. (erc-cmd-QUERY): Use preferred alias for `erc-query-display'. * test/lisp/erc/erc-scenarios-base-buffer-display.el: (erc-scenarios-base-buffer-display--interactive-default): New test. * test/lisp/erc/erc-tests.el (erc-process-input-line, erc-select-read-args, erc-tls, erc--interactive): Change expected default value of `erc-interactive-display' from `buffer' to `window'. (Bug#62833) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 6897993c628..57dce501760 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -37,15 +37,18 @@ decade overdue, this is no longer the case. Other UX improvements in this area aim to make the process of connecting interactively slightly more streamlined and less repetitive, even for veteran users. -** New buffer-display option 'erc-interactive-display'. +** Revised buffer-display handling for interactive commands. A point of friction for new users and one only just introduced with ERC 5.5 has been the lack of visual feedback when first connecting via -M-x erc. As explained below in the news for 5.5, the discovery of a -security issue led to new ERC buffers being "buried" on creation. On -further reflection, this was judged to have been an overcorrection in -the case of interactive invocations, hence the new option -'erc-interactive-display', which is set to 'buffer' (i.e., "take me -there") by default. +M-x erc or when issuing a "/JOIN" command at the prompt. As explained +below, in the news for 5.5, the discovery of a security issue led to +most new ERC buffers being "buried" on creation. On further +reflection, this was judged to have been an overcorrection in the case +of interactive invocations, hence the borrowing of an old option, +'erc-query-display', and the bestowing of a new alias, +'erc-interactive-display', which better describes its expanded role as +a more general buffer-display knob for interactive commands ("/QUERY" +still among them). Accompanying this addition are "display"-suffixed aliases for related options 'erc-join-buffer' and 'erc-auto-query', which users have diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 22b92a0d31b..13f6da2d5be 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -98,7 +98,9 @@ erc-buffers :group 'erc) (defgroup erc-display nil - "Settings for how various things are displayed." + "Settings controlling how various things are displayed. +See the customization group `erc-buffers' for display options +concerning buffers." :group 'erc) (defgroup erc-mode-line-and-header nil @@ -1507,9 +1509,9 @@ erc-default-port-tls "IRC port to use for encrypted connections if it cannot be \ detected otherwise.") -(defvaralias 'erc-buffer-display 'erc-join-buffer) -(defcustom erc-join-buffer 'bury - "Determines how to display a newly created IRC buffer. +(defvaralias 'erc-join-buffer 'erc-buffer-display) +(defcustom erc-buffer-display 'bury + "How to display a newly created ERC buffer. The available choices are: @@ -1518,7 +1520,9 @@ erc-join-buffer `frame' - in another frame, `bury' - bury it in a new buffer, `buffer' - in place of the current buffer, - any other value - in place of the current buffer." + +See related options `erc-interactive-display', +`erc-reconnect-display', and `erc-receive-query-display'." :package-version '(ERC . "5.5") :group 'erc-buffers :type '(choice (const :tag "Split window and select" window) @@ -1528,13 +1532,17 @@ erc-join-buffer (const :tag "Use current buffer" buffer) (const :tag "Use current buffer" t))) -(defcustom erc-interactive-display 'buffer - "How and whether to display server buffers for M-x erc. -See `erc-buffer-display' and friends for a description of -possible values." +(defvaralias 'erc-query-display 'erc-interactive-display) +(defcustom erc-interactive-display 'window + "How to display buffers as a result of user interaction. +This affects commands like /QUERY and /JOIN when issued +interactively at the prompt. It does not apply when calling a +handler for such a command, like `erc-cmd-JOIN', from lisp code. +See `erc-buffer-display' for a full description of available +values." :package-version '(ERC . "5.6") ; FIXME sync on release :group 'erc-buffers - :type '(choice (const :tag "Use value of `erc-join-buffer'" nil) + :type '(choice (const :tag "Use value of `erc-buffer-display'" nil) (const :tag "Split window and select" window) (const :tag "Split window, don't select" window-noselect) (const :tag "New frame" frame) @@ -1542,15 +1550,14 @@ erc-interactive-display (const :tag "Use current buffer" buffer))) (defcustom erc-reconnect-display nil - "How (and whether) to display a channel buffer upon reconnecting. - -This only affects automatic reconnections and is ignored when -issuing a /reconnect command or reinvoking `erc-tls' with the -same args (assuming success, of course). See `erc-join-buffer' -for a description of possible values." + "How and whether to display a channel buffer when auto-reconnecting. +This only affects automatic reconnections and is ignored, like +all other buffer-display options, when issuing a /RECONNECT or +successfully reinvoking `erc-tls' with similar arguments. See +`erc-buffer-display' for a description of possible values." :package-version '(ERC . "5.5") :group 'erc-buffers - :type '(choice (const :tag "Use value of `erc-join-buffer'" nil) + :type '(choice (const :tag "Use value of `erc-buffer-display'" nil) (const :tag "Split window and select" window) (const :tag "Split window, don't select" window-noselect) (const :tag "New frame" frame) @@ -2044,6 +2051,9 @@ erc--display-buffer-use-some-frame (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.") + (defun erc-setup-buffer (buffer) "Consults `erc-join-buffer' to find out how to display `BUFFER'." (pcase (if (zerop (erc-with-server-buffer @@ -2251,7 +2261,8 @@ erc-open ;; we can't log to debug buffer, it may not exist yet (message "erc: old buffer %s, switching to %s" old-buffer buffer)) - (erc-setup-buffer buffer)) + (erc-setup-buffer buffer) + (run-hooks 'erc--setup-buffer-hook)) buffer)) @@ -3057,6 +3068,10 @@ erc-message-type-member (let ((prop-val (erc-get-parsed-vector position))) (and prop-val (member (erc-response.command prop-val) list)))) +(defvar erc--called-as-input-p nil + "Non-nil when a user types a \"/slash\" command. +Remains bound until `erc-cmd-SLASH' returns.") + (defvar-local erc-send-input-line-function 'erc-send-input-line "Function for sending lines lacking a leading user command. When a line typed into a buffer contains an explicit command, like /msg, @@ -3110,7 +3125,8 @@ erc-process-input-line (if (and command-list (not no-command)) (let* ((cmd (nth 0 command-list)) - (args (nth 1 command-list))) + (args (nth 1 command-list)) + (erc--called-as-input-p t)) (condition-case nil (if (listp args) (apply cmd args) @@ -3584,6 +3600,21 @@ erc-cmd-JOIN (erc-get-channel-user (erc-current-nick))))) (switch-to-buffer existing) (setq erc--server-last-reconnect-count 0) + (when-let* ; bind `erc-join-buffer' when /JOIN issued + ((erc--called-as-input-p) + (fn (lambda (proc parsed) + (when-let* ; `fn' wrapper already removed from hook + (((equal (car (erc-response.command-args parsed)) + channel)) + (sn (erc-extract-nick (erc-response.sender parsed))) + ((erc-nick-equal-p sn (erc-current-nick))) + (erc-join-buffer (or erc-interactive-display + erc-join-buffer))) + (run-hook-with-args-until-success + 'erc-server-JOIN-functions proc parsed) + t)))) + (erc-with-server-buffer + (erc-once-with-server-event "JOIN" fn))) (erc-server-join-channel nil chnl key)))) t) @@ -3947,27 +3978,10 @@ erc-cmd-QUOTE (t nil))) (put 'erc-cmd-QUOTE 'do-not-parse-args t) -(defcustom erc-query-display 'window - "How to display query buffers when using the /QUERY command to talk to someone. - -The default behavior is to display the message in a new window -and bring it to the front. See the documentation for -`erc-join-buffer' for a description of the available choices. - -See also `erc-auto-query' to decide how private messages from -other people should be displayed." - :group 'erc-query - :type '(choice (const :tag "Split window and select" window) - (const :tag "Split window, don't select" window-noselect) - (const :tag "New frame" frame) - (const :tag "Bury in new buffer" bury) - (const :tag "Use current buffer" buffer) - (const :tag "Use current buffer" t))) - (defun erc-cmd-QUERY (&optional user) "Open a query with USER. How the query is displayed (in a new window, frame, etc.) depends -on the value of `erc-query-display'." +on the value of `erc-interactive-display'." ;; FIXME: The doc string used to say at the end: ;; "If USER is omitted, close the current query buffer if one exists ;; - except this is broken now ;-)" diff --git a/test/lisp/erc/erc-scenarios-base-buffer-display.el b/test/lisp/erc/erc-scenarios-base-buffer-display.el index d511c8ff738..3ed7a83653e 100644 --- a/test/lisp/erc/erc-scenarios-base-buffer-display.el +++ b/test/lisp/erc/erc-scenarios-base-buffer-display.el @@ -118,4 +118,41 @@ erc-scenarios-base-reconnect-options--default (should (eq (window-buffer) (messages-buffer)))))) + +;; This shows that the option `erc-interactive-display' overrides +;; `erc-join-buffer' during cold opens and interactive /JOINs. + +(ert-deftest erc-scenarios-base-buffer-display--interactive-default () + :tags '(:expensive-test) + (should (eq erc-join-buffer 'bury)) + (should (eq erc-interactive-display 'window)) + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "join/legacy") + (dumb-server (erc-d-run "localhost" t 'foonet)) + (port (process-contact dumb-server :service)) + (url (format "tester:changeme@127.0.0.1:%d\r\r" port)) + (expect (erc-d-t-make-expecter)) + (erc-server-flood-penalty 0.1) + (erc-server-auto-reconnect t) + (erc-user-full-name "tester")) + + (ert-info ("Connect to foonet") + (with-current-buffer (let (inhibit-interaction) + (ert-simulate-keys url + (call-interactively #'erc))) + (should (string= (buffer-name) (format "127.0.0.1:%d" port))) + + (erc-d-t-wait-for 10 "Server buffer shown" + (eq (window-buffer) (current-buffer))) + (funcall expect 10 "debug mode") + (erc-scenarios-common-say "/JOIN #chan"))) + + (ert-info ("Wait for output in #chan") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "welcome") + (erc-d-t-ensure-for 3 "Channel #chan shown" + (eq (window-buffer) (current-buffer))) + (funcall expect 10 "be prosperous"))))) + ;;; erc-scenarios-base-buffer-display.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 29bda7e742d..88b9babf206 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1292,6 +1292,7 @@ erc-process-input-line (cl-letf (((symbol-function 'erc-cmd-MSG) (lambda (line) (push line calls) + (should erc--called-as-input-p) (funcall orig-erc-cmd-MSG line))) ((symbol-function 'erc-server-buffer) (lambda () (current-buffer))) @@ -1469,7 +1470,7 @@ erc-select-read-args :nick (user-login-name) '&interactive-env '((erc-server-connect-function . erc-open-tls-stream) - (erc-join-buffer . buffer)))))) + (erc-join-buffer . window)))))) (ert-info ("Switches to TLS when port matches default TLS port") (should (equal (ert-simulate-keys "irc.gnu.org\r6697\r\r\r" @@ -1479,7 +1480,7 @@ erc-select-read-args :nick (user-login-name) '&interactive-env '((erc-server-connect-function . erc-open-tls-stream) - (erc-join-buffer . buffer)))))) + (erc-join-buffer . window)))))) (ert-info ("Switches to TLS when URL is ircs://") (should (equal (ert-simulate-keys "ircs://irc.gnu.org\r\r\r\r" @@ -1489,7 +1490,7 @@ erc-select-read-args :nick (user-login-name) '&interactive-env '((erc-server-connect-function . erc-open-tls-stream) - (erc-join-buffer . buffer)))))) + (erc-join-buffer . window)))))) (setq-local erc-interactive-display nil) ; cheat to save space @@ -1625,7 +1626,7 @@ erc-tls '("localhost" 6667 "nick" "unknown" t "sesame" nil nil nil nil "user" nil))) (should (equal (pop env) - '((erc-join-buffer buffer) + '((erc-join-buffer window) (erc-server-connect-function erc-open-tls-stream))))) (ert-info ("Custom connect function") @@ -1686,7 +1687,7 @@ erc--interactive '("irc.libera.chat" 6697 "tester" "unknown" t nil nil nil nil nil "user" nil))) (should (equal (pop env) - '((erc-join-buffer buffer) (erc-server-connect-function + '((erc-join-buffer window) (erc-server-connect-function erc-open-tls-stream))))) (ert-info ("Nick supplied, decline TLS upgrade") @@ -1696,7 +1697,7 @@ erc--interactive '("irc.libera.chat" 6667 "dummy" "unknown" t nil nil nil nil nil "user" nil))) (should (equal (pop env) - '((erc-join-buffer buffer) + '((erc-join-buffer window) (erc-server-connect-function erc-open-network-stream)))))))) commit 8654cea5843aa2fa2074f317d338451eadae092f Author: F. Jason Park Date: Thu Apr 20 19:23:54 2023 -0700 Move ERC's buffer-display tests to separate file * test/lisp/erc/erc-scenarios-base-buffer-display.el: New file. * test/lisp/erc/erc-scenarios-base-reconnect.el (erc-scenarios-common--base-reconnect-options, erc-scenarios-base-reconnect-options--buffer, erc-scenarios-base-reconnect-options--default): Move to new file and rename. (Bug#62833) * test/lisp/erc/resources/erc-d/erc-d-tests.el (erc-d-run-linger): Lengthen timeout. * test/lisp/erc/resources/erc-d/erc-d.el (erc-d--m): Ensure buffer is live before inserting. diff --git a/test/lisp/erc/erc-scenarios-base-buffer-display.el b/test/lisp/erc/erc-scenarios-base-buffer-display.el new file mode 100644 index 00000000000..d511c8ff738 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-base-buffer-display.el @@ -0,0 +1,121 @@ +;;; erc-scenarios-base-buffer-display.el --- Buffer display scenarios -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(eval-when-compile (require 'erc-join)) + +;; These first couple `erc-reconnect-display' tests used to live in +;; erc-scenarios-base-reconnect but have since been renamed. + +(defun erc-scenarios-base-buffer-display--reconnect-common (test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/reconnect") + (dumb-server (erc-d-run "localhost" t 'options 'options-again)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter)) + (erc-server-flood-penalty 0.1) + (erc-server-auto-reconnect t) + erc-autojoin-channels-alist + erc-server-buffer) + + (should (memq 'autojoin erc-modules)) + + (ert-info ("Connect to foonet") + (setq erc-server-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "changeme" + :full-name "tester")) + (with-current-buffer erc-server-buffer + (should (string= (buffer-name) (format "127.0.0.1:%d" port))) + (funcall expect 10 "debug mode"))) + + (ert-info ("Wait for some output in channels") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "welcome"))) + + (ert-info ("Server buffer shows connection failed") + (with-current-buffer erc-server-buffer + (funcall expect 10 "Connection failed! Re-establishing"))) + + (should (equal erc-autojoin-channels-alist '((FooNet "#chan")))) + + (funcall test) + + ;; A manual /JOIN command tells ERC we're done auto-reconnecting + (with-current-buffer "FooNet" (erc-cmd-JOIN "#spam")) + + (erc-d-t-ensure-for 1 "Newly joined chan ignores `erc-reconnect-display'" + (not (eq (window-buffer) (get-buffer "#spam")))) + + (ert-info ("Wait for auto reconnect") + (with-current-buffer erc-server-buffer + (funcall expect 10 "still in debug mode"))) + + (ert-info ("Wait for activity to recommence in channels") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "forest of Arden")) + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (funcall expect 10 "her elves come here anon"))))) + +(ert-deftest erc-scenarios-base-reconnect-options--buffer () + :tags '(:expensive-test) + (should (eq erc-join-buffer 'bury)) + (should-not erc-reconnect-display) + + ;; FooNet (the server buffer) is not switched to because it's + ;; already current (but not shown) when `erc-open' is called. See + ;; related conditional guard towards the end of that function. + + (let ((erc-reconnect-display 'buffer)) + (erc-scenarios-base-buffer-display--reconnect-common + (lambda () + (pop-to-buffer-same-window "*Messages*") + + (erc-d-t-ensure-for 1 "Server buffer not shown" + (not (eq (window-buffer) (get-buffer "FooNet")))) + + (erc-d-t-wait-for 5 "Channel #chan shown when autojoined" + (eq (window-buffer) (get-buffer "#chan"))))))) + +(ert-deftest erc-scenarios-base-reconnect-options--default () + :tags '(:expensive-test) + (should (eq erc-join-buffer 'bury)) + (should-not erc-reconnect-display) + + (erc-scenarios-base-buffer-display--reconnect-common + + (lambda () + (pop-to-buffer-same-window "*Messages*") + + (erc-d-t-ensure-for 1 "Server buffer not shown" + (not (eq (window-buffer) (get-buffer "FooNet")))) + + (erc-d-t-ensure-for 3 "Channel #chan not shown" + (not (eq (window-buffer) (get-buffer "#chan")))) + + (should (eq (window-buffer) (messages-buffer)))))) + +;;; erc-scenarios-base-buffer-display.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-reconnect.el b/test/lisp/erc/erc-scenarios-base-reconnect.el index 5b4dc549042..7bd16d1ed14 100644 --- a/test/lisp/erc/erc-scenarios-base-reconnect.el +++ b/test/lisp/erc/erc-scenarios-base-reconnect.el @@ -65,95 +65,6 @@ erc-scenarios-base-reconnect-timer (should (equal (list (get-buffer (format "127.0.0.1:%d" port))) (erc-scenarios-common-buflist "127.0.0.1")))))) -(defun erc-scenarios-common--base-reconnect-options (test) - (erc-scenarios-common-with-cleanup - ((erc-scenarios-common-dialog "base/reconnect") - (dumb-server (erc-d-run "localhost" t 'options 'options-again)) - (port (process-contact dumb-server :service)) - (expect (erc-d-t-make-expecter)) - (erc-server-flood-penalty 0.1) - (erc-server-auto-reconnect t) - erc-autojoin-channels-alist - erc-server-buffer) - - (should (memq 'autojoin erc-modules)) - - (ert-info ("Connect to foonet") - (setq erc-server-buffer (erc :server "127.0.0.1" - :port port - :nick "tester" - :password "changeme" - :full-name "tester")) - (with-current-buffer erc-server-buffer - (should (string= (buffer-name) (format "127.0.0.1:%d" port))) - (funcall expect 10 "debug mode"))) - - (ert-info ("Wait for some output in channels") - (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) - (funcall expect 10 "welcome"))) - - (ert-info ("Server buffer shows connection failed") - (with-current-buffer erc-server-buffer - (funcall expect 10 "Connection failed! Re-establishing"))) - - (should (equal erc-autojoin-channels-alist '((FooNet "#chan")))) - - (funcall test) - - ;; A manual /JOIN command tells ERC we're done auto-reconnecting - (with-current-buffer "FooNet" (erc-cmd-JOIN "#spam")) - - (erc-d-t-ensure-for 1 "Newly joined chan ignores `erc-reconnect-display'" - (not (eq (window-buffer) (get-buffer "#spam")))) - - (ert-info ("Wait for auto reconnect") - (with-current-buffer erc-server-buffer - (funcall expect 10 "still in debug mode"))) - - (ert-info ("Wait for activity to recommence in channels") - (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) - (funcall expect 10 "forest of Arden")) - (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) - (funcall expect 10 "her elves come here anon"))))) - -(ert-deftest erc-scenarios-base-reconnect-options--buffer () - :tags '(:expensive-test) - (should (eq erc-join-buffer 'bury)) - (should-not erc-reconnect-display) - - ;; FooNet (the server buffer) is not switched to because it's - ;; already current (but not shown) when `erc-open' is called. See - ;; related conditional guard towards the end of that function. - - (let ((erc-reconnect-display 'buffer)) - (erc-scenarios-common--base-reconnect-options - (lambda () - (pop-to-buffer-same-window "*Messages*") - - (erc-d-t-ensure-for 1 "Server buffer not shown" - (not (eq (window-buffer) (get-buffer "FooNet")))) - - (erc-d-t-wait-for 5 "Channel #chan shown when autojoined" - (eq (window-buffer) (get-buffer "#chan"))))))) - -(ert-deftest erc-scenarios-base-reconnect-options--default () - :tags '(:expensive-test) - (should (eq erc-join-buffer 'bury)) - (should-not erc-reconnect-display) - - (erc-scenarios-common--base-reconnect-options - - (lambda () - (pop-to-buffer-same-window "*Messages*") - - (erc-d-t-ensure-for 1 "Server buffer not shown" - (not (eq (window-buffer) (get-buffer "FooNet")))) - - (erc-d-t-ensure-for 3 "Channel #chan not shown" - (not (eq (window-buffer) (get-buffer "#chan")))) - - (eq (window-buffer) (messages-buffer))))) - ;; Upon reconnecting, playback for channel and target buffers is ;; routed correctly. Autojoin is irrelevant here, but for the ;; skeptical, see `erc-scenarios-common--join-network-id', which diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el b/test/lisp/erc/resources/erc-d/erc-d-tests.el index a501cd55494..0ae70087fd1 100644 --- a/test/lisp/erc/resources/erc-d/erc-d-tests.el +++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el @@ -674,7 +674,7 @@ erc-d-run-eof-fail (ert-deftest erc-d-run-linger () :tags '(:unstable :expensive-test) (erc-d-tests-with-server (dumb-s _) linger - (with-current-buffer (erc-d-t-wait-for 6 (get-buffer "#chan")) + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) (erc-d-t-search-for 2 "hey")) (with-current-buffer (process-buffer dumb-s) (erc-d-t-search-for 2 "Lingering for 1.00 seconds")) diff --git a/test/lisp/erc/resources/erc-d/erc-d.el b/test/lisp/erc/resources/erc-d/erc-d.el index f4491bbb834..43f6552f0f3 100644 --- a/test/lisp/erc/resources/erc-d/erc-d.el +++ b/test/lisp/erc/resources/erc-d/erc-d.el @@ -299,9 +299,10 @@ erc-d--m (concat (format-time-string "%s.%N: ") ,format-string) ,format-string)) - (want-insert (and ,process erc-d--in-process))) - (when want-insert - (with-current-buffer (process-buffer (process-get ,process :server)) + (want-insert (and ,process erc-d--in-process)) + (buffer (process-buffer (process-get ,process :server)))) + (when (and want-insert (buffer-live-p buffer)) + (with-current-buffer buffer (goto-char (point-max)) (insert (concat (format ,format-string ,@args) "\n")))) (when (or erc-d--m-debug (not want-insert)) commit c9f1ad2a87081fcc30d541554721806d89365af0 Author: F. Jason Park Date: Thu Apr 13 00:00:02 2023 -0700 Revive option erc-query-on-unjoined-chan-privmsg * etc/ERC-NEWS: Mention reinstated and renamed legacy option `erc-query-on-unjoined-chan-privmsg' as well as a change in behavior for `erc-auto-query', when nil. Also fix erroneous ChangeLog reference in 5.5 section. * lisp/erc/erc-backend.el (erc-server-PRIVMSG): Consider flag `erc-receive-query-display-defer' and revived option `erc-query-unjoined-chan-privmsg' when deciding whether to create a new query buffer. And only "open" a buffer for an unknown target when the latter option is non-nil. * lisp/erc/erc.el (erc-cmd-QUERY): Make error more informative. (erc-query): Revise deprecation message. (erc-auto-query, erc-receive-query-display): Swap alias and aliased and add option to `erc-buffers' group. Mention the nonstandard meaning of nil and update package-version to signify a behavioral change, even though the default value remains untouched. (erc-receive-query-display-defer): Add new variable, a compatibility switch to access legacy behavior for `erc-auto-query'. (erc-query-on-unjoined-chan-privmsg, erc-ensure-target-buffer-on-privmsg): Revise doc string and add alias. Change package-version to ERC 5.6 due to slightly refined meaning. * test/lisp/erc/erc-scenarios-base-attach.el: New file. * test/lisp/erc/resources/base/channel-buffer-revival/reattach.eld: New file. (Bug#62833) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 8f1b89f268b..6897993c628 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -45,9 +45,15 @@ security issue led to new ERC buffers being "buried" on creation. On further reflection, this was judged to have been an overcorrection in the case of interactive invocations, hence the new option 'erc-interactive-display', which is set to 'buffer' (i.e., "take me -there") by default. Accompanying this addition are "display"-suffixed -aliases for related options 'erc-join-buffer' and 'erc-auto-query', -which users have reported as being difficult to discover and remember. +there") by default. + +Accompanying this addition are "display"-suffixed aliases for related +options 'erc-join-buffer' and 'erc-auto-query', which users have +reported as being difficult to discover and remember. When the latter +option (now known as 'erc-receive-query-display') is nil, ERC uses +'erc-join-buffer' in its place, much like it does for +'erc-interactive-display'. The old nil behavior can still be gotten +via the new compatibility flag 'erc-receive-query-display-defer'. ** Setting a module's mode variable via Customize earns a warning. Trying and failing to activate a module via its minor mode's Custom @@ -108,6 +114,13 @@ other than the symbol 'erc-button-buttonize-nicks' appearing in the "FORM" field (third element) of this entry are considered deprecated and will incur a warning. +** Option 'erc-query-on-unjoined-chan-privmsg' restored and renamed. +This option was accidentally removed from the default client in ERC +5.5 and was thus prevented from influencing PRIVMSG routing. It's now +been restored with a slightly revised role contingent on a few +assumptions explained in its doc string. For clarity, it has been +renamed 'erc-ensure-target-buffer-on-privmsg'. + ** Miscellaneous UX changes. Some minor quality-of-life niceties have finally made their way to ERC. For example, the function 'erc-echo-timestamp' is now @@ -332,8 +345,8 @@ In an effort to help further tame ERC's complexity, the variable 'erc-default-recipients' is now expected to hold but a single target. As a consequence, functions like 'erc-add-default-channel' that imagine an alternate, aspirational model of buffer-target relations -have been deprecated. See Emacs change-log entries from around July -of 2022 for specifics. +have been deprecated. Grep for their names in ChangeLog.4 for +details. A number of less consequential deprecations also debut in this release. For example, the function 'erc-auto-query' was deemed too diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index bdf4e2ddca2..98a1c117cfa 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -102,11 +102,11 @@ (require 'erc-common) (defvar erc--target) -(defvar erc-auto-query) (defvar erc-channel-list) (defvar erc-channel-users) (defvar erc-default-nicks) (defvar erc-default-recipients) +(defvar erc-ensure-target-buffer-on-privmsg) (defvar erc-format-nick-function) (defvar erc-format-query-as-channel-p) (defvar erc-hide-prompt) @@ -123,6 +123,8 @@ erc-nick (defvar erc-nick-change-attempt-count) (defvar erc-prompt-for-channel-key) (defvar erc-prompt-hidden) +(defvar erc-receive-query-display) +(defvar erc-receive-query-display-defer) (defvar erc-reuse-buffers) (defvar erc-verbose-server-ping) (defvar erc-whowas-on-nosuchnick) @@ -1831,11 +1833,16 @@ define-erc-response-handler (unless (or buffer noticep (string-empty-p tgt) (eq ?$ (aref tgt 0)) (erc-is-message-ctcp-and-not-action-p msg)) (if privp - (when erc-auto-query - (let ((erc-join-buffer erc-auto-query)) - (setq buffer (erc--open-target nick)))) - ;; A channel buffer has been killed but is still joined - (setq buffer (erc--open-target tgt)))) + (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))))) + (setq buffer (erc--open-target nick))) + ;; A channel buffer has been killed but is still joined. + (when erc-ensure-target-buffer-on-privmsg + (setq buffer (erc--open-target tgt))))) (when buffer (with-current-buffer buffer (when privp (erc--unhide-prompt)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 284990e2d43..22b92a0d31b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3978,8 +3978,8 @@ erc-cmd-QUERY (unless user ;; currently broken, evil hack to display help anyway ;(erc-delete-query)))) - (signal 'wrong-number-of-arguments "")) - (let ((erc-join-buffer erc-query-display)) + (signal 'wrong-number-of-arguments '(erc-cmd-QUERY 0))) + (let ((erc-join-buffer erc-interactive-display)) (erc-with-server-buffer (erc--open-target user)))) @@ -4722,23 +4722,30 @@ erc-query "Open a query buffer on TARGET using SERVER-BUFFER. To change how this query window is displayed, use `let' to bind `erc-join-buffer' before calling this." - (declare (obsolete "bind `erc-cmd-query' and call `erc-cmd-QUERY'" "29.1")) + (declare (obsolete "call `erc-open' in a live server buffer" "29.1")) (unless (buffer-live-p server-buffer) (error "Couldn't switch to server buffer")) (with-current-buffer server-buffer (erc--open-target target))) -(defvaralias 'erc-receive-query-display 'erc-auto-query) -(defcustom erc-auto-query 'window-noselect +(defvaralias 'erc-auto-query 'erc-receive-query-display) +(defcustom erc-receive-query-display 'window-noselect "If non-nil, create a query buffer each time you receive a private message. If the buffer doesn't already exist, it is created. This can be set to a symbol, to control how the new query window should appear. The default behavior is to display the buffer in -a new window, but not to select it. See the documentation for -`erc-join-buffer' for a description of the available choices." +a new window but not to select it. See the documentation for +`erc-buffer-display' for a description of available values. + +Note that the legacy behavior of forgoing buffer creation +entirely when this option is nil requires setting the +compatibility flag `erc-receive-query-display-defer' to nil. Use +`erc-ensure-target-buffer-on-privmsg' to achieve the same effect." + :package-version '(ERC . "5.6") + :group 'erc-buffers :group 'erc-query - :type '(choice (const :tag "Don't create query window" nil) + :type '(choice (const :tag "Defer to value of `erc-buffer-display'" nil) (const :tag "Split window and select" window) (const :tag "Split window, don't select" window-noselect) (const :tag "New frame" frame) @@ -4746,15 +4753,37 @@ erc-auto-query (const :tag "Use current buffer" buffer) (const :tag "Use current buffer" t))) -;; FIXME either retire this or put it to use after determining how -;; it's meant to work. Clearly, the doc string does not describe -;; current behavior. It's currently only used by the obsolete -;; function `erc-auto-query'. -(defcustom erc-query-on-unjoined-chan-privmsg t - "If non-nil create query buffer on receiving any PRIVMSG at all. +(defvar erc-receive-query-display-defer t + "How to interpret a null `erc-receive-query-display'. +When this variable is non-nil, ERC defers to `erc-buffer-display' +upon seeing a nil value for `erc-receive-query-display', much +like it does with other buffer-display options, like +`erc-interactive-display'. Otherwise, when this option is nil, +ERC retains the legacy behavior of not creating a new query +buffer.") + +(defvaralias 'erc-query-on-unjoined-chan-privmsg + 'erc-ensure-target-buffer-on-privmsg) +(defcustom erc-ensure-target-buffer-on-privmsg t + "When non-nil, create a target buffer upon receiving a PRIVMSG. This includes PRIVMSGs directed to channels. If you are using an IRC bouncer, such as dircproxy, to keep a log of channels when you are -disconnected, you should set this option to t." +disconnected, you should set this option to t. + +For queries (direct messages), this option's non-nil meaning is +straightforward: if a buffer doesn't exist for the sender, create +one. For channels, the use case is more niche and usually +involves receiving playback (via commands like ZNC's +\"PLAYBUFFER\") for channels to which your bouncer is joined but +from which you've \"detached\". + +Note that this option was absent from ERC 5.5 because knowledge +of its intended role was \"unavailable\" during a major +refactoring involving buffer management. The option has since +been restored in ERC 5.6 but now also affects queries in the +manner implied above, which was lost sometime before ERC 5.4." + :package-version '(ERC . "5.6") ; revived + :group 'erc-buffers :group 'erc-query :type 'boolean) diff --git a/test/lisp/erc/erc-scenarios-base-attach.el b/test/lisp/erc/erc-scenarios-base-attach.el new file mode 100644 index 00000000000..ccf5d1f9582 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-base-attach.el @@ -0,0 +1,191 @@ +;;; erc-scenarios-base-attach.el --- Reattach scenarios -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; See also: `erc-scenarios-base-channel-buffer-revival'. +;; +;; ERC 5.5 silently dropped support for the ancient option +;; `erc-query-on-unjoined-chan-privmsg' because the tangled logic in +;; and around the function `erc-auto-query' made it difficult to +;; divine its purpose. +;; +;; Based on the name, it was thought this option likely involved +;; controlling the creation of query buffers for unsolicited messages +;; from users with whom you don't share a common channel. However, +;; additional spelunking has recently revealed that it was instead +;; meant to service a feature offered by most bouncers that sends +;; PRIVMSGs directed at a channel you're no longer in and that you +;; haven't received a(nother) JOIN message for. IOW, this is meant to +;; support the following sequence of events: +;; +;; 1. /detach #chan +;; 2. kill buffer #chan or reconnect in new Emacs session +;; 3. /playbuffer #chan +;; +;; Note that the above slash commands are bouncer-specific aliases. +;; +;; Interested users can find more info by looking at this change set +;; from the ancient CVS repo: +;; +;; Author: Mario Lang +;; AuthorDate: Mon Nov 26 18:33:19 2001 +0000 +;; +;; * new function erc-BBDB-NICK to handle nickname anotation ... +;; * Applied antifuchs/mhp patches, the latest on erc-help, unmodified +;; * New variable: erc-reuse-buffers default to t. +;; * Modified erc-generate-new-buffer-name to use it. it checks if +;; server and port are the same, then one can assume thats the same +;; channel/query target again. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(ert-deftest erc-scenarios-base-attach--ensure-target-buffer--enabled () + :tags '(:expensive-test) + (should erc-ensure-target-buffer-on-privmsg) + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/channel-buffer-revival") + (dumb-server (erc-d-run "localhost" t 'reattach)) + (port (process-contact dumb-server :service)) + (erc-server-flood-penalty 0.1) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "tester@vanilla/foonet:changeme" + :full-name "tester") + (should (string= (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet")) + (erc-cmd-MSG "*status playbuffer #chan")) + + (ert-info ("Playback appears in buffer #chan") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "Buffer Playback...") + (funcall expect 10 "Was I a child") + (funcall expect 10 "Thou counterfeit'st most lively") + (funcall expect 10 "Playback Complete"))) + + (with-current-buffer "foonet" + (erc-cmd-MSG "*status attach #chan")) + + (ert-info ("Live output from #chan after more playback") + (with-current-buffer "#chan" + (funcall expect 10 "Buffer Playback...") + (funcall expect 10 "With what it loathes") + (funcall expect 10 "Not by his breath") + (funcall expect 10 "Playback Complete") + (funcall expect 10 "Ay, and the captain") + (erc-scenarios-common-say "bob: hi") + (funcall expect 10 "Pawn me to this"))))) + +(ert-deftest erc-scenarios-base-attach--ensure-target-buffer--disabled () + :tags '(:expensive-test) + (should erc-ensure-target-buffer-on-privmsg) + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/channel-buffer-revival") + (dumb-server (erc-d-run "localhost" t 'reattach)) + (port (process-contact dumb-server :service)) + (erc-server-flood-penalty 0.1) + (erc-ensure-target-buffer-on-privmsg nil) ; off + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "tester@vanilla/foonet:changeme" + :full-name "tester") + (should (string= (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet")) + (erc-cmd-MSG "*status playbuffer #chan") + (ert-info ("Playback appears in buffer server buffer") + (erc-d-t-ensure-for -1 (not (get-buffer "#chan"))) + (funcall expect 10 "Buffer Playback...") + (funcall expect 10 "Was I a child") + (funcall expect 10 "Thou counterfeit'st most lively") + (funcall expect 10 "Playback Complete")) + (should-not (get-buffer "#chan")) + (erc-cmd-MSG "*status attach #chan")) + + (ert-info ("Buffer #chan joined") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "Buffer Playback...") + (funcall expect 10 "With what it loathes") + (funcall expect 10 "Not by his breath") + (funcall expect 10 "Playback Complete") + (funcall expect 10 "Ay, and the captain") + (erc-scenarios-common-say "bob: hi") + (funcall expect 10 "Pawn me to this"))))) + + +;; We omit the `enabled' case for queries because it's the default for +;; this option and already covered many times over by other tests in +;; this directory. + +(ert-deftest erc-scenarios-base-attach--ensure-target-buffer--disabled-query () + :tags '(:expensive-test) + (should erc-ensure-target-buffer-on-privmsg) + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/assoc/queries") + (dumb-server (erc-d-run "localhost" t 'non-erc)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter)) + (erc-ensure-target-buffer-on-privmsg nil) + (erc-server-flood-penalty 0.1)) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (erc-scenarios-common-assert-initial-buf-name nil port) + (erc-d-t-wait-for 5 (eq erc-network 'foonet)) + (funcall expect 15 "debug mode"))) + + (ert-info ("User dummy's greeting appears in server buffer") + (erc-d-t-wait-for -1 (get-buffer "dummy")) + (with-current-buffer "foonet" + (funcall expect 5 "hi") + + (ert-info ("Option being nil doesn't queries we create") + (with-current-buffer (erc-cmd-QUERY "nitwit") + (should (equal (buffer-name) "nitwit")) + (erc-scenarios-common-say "hola") + (funcall expect 5 "ciao"))) + + (erc-scenarios-common-say "howdy") + (funcall expect 5 "no target") + (erc-cmd-MSG "dummy howdy") + (funcall expect 5 "bye") + (erc-cmd-QUIT ""))))) + +;;; erc-scenarios-base-attach.el ends here diff --git a/test/lisp/erc/resources/base/channel-buffer-revival/reattach.eld b/test/lisp/erc/resources/base/channel-buffer-revival/reattach.eld new file mode 100644 index 00000000000..c3791ac3d49 --- /dev/null +++ b/test/lisp/erc/resources/base/channel-buffer-revival/reattach.eld @@ -0,0 +1,56 @@ +;; -*- mode: lisp-data; -*- +((pass 10 "PASS :tester@vanilla/foonet:changeme")) +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.00 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.00 ":irc.foonet.org 003 tester :This server was created Thu, 13 Apr 2023 05:55:22 UTC") + (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.00 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.00 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.01 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing")) + +((mode 10 "MODE tester +i") + (0.01 ":irc.foonet.org 221 tester +Zi")) + +((privmsg-play 10 "PRIVMSG *status :playbuffer #chan") + (0.05 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...") + (0.02 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:08:24] alice: Was I a child, to fear I know not what.") + (0.02 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:08:29] bob: My lord, I do confess the ring was hers.") + (0.01 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:08:40] alice: My sons would never so dishonour me.") + (0.01 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:09:54] bob: By the hand of a soldier, I will undertake it.") + (0.01 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:09:57] alice: Thou counterfeit'st most lively.") + (0.01 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.")) + +((privmsg-attach 10 "PRIVMSG *status :attach #chan") + (0.01 ":tester!~u@78a58pgahbr24.irc JOIN #chan")) + +((mode-chan 10 "MODE #chan") + (0.01 ":irc.foonet.org 353 tester = #chan :@alice bob tester") + (0.00 ":irc.foonet.org 366 tester #chan :End of /NAMES list.") + (0.00 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...") + (0.00 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:10:01] bob: With what it loathes for that which is away.") + (0.00 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:10:30] alice: Ties up my tongue, and will not let me speak.") + (0.00 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:11:26] bob: They say he is already in the forest of Arden, and a many merry men with him; and there they live like the old Robin Hood of England. They say many young gentlemen flock to him every day, and fleet the time carelessly, as they did in the golden world.") + (0.01 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:11:29] alice: Not by his breath that is more miserable.") + (0.00 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.") + (0.00 ":*status!znc@znc.in PRIVMSG tester :There was 1 channel matching [#chan]") + (0.03 ":*status!znc@znc.in PRIVMSG tester :Attached 1 channel") + (0.00 ":irc.foonet.org 324 tester #chan +Cnt") + (0.00 ":irc.foonet.org 329 tester #chan 1681365340") + (0.03 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :bob: Five or six thousand horse, I said,I will say true,or thereabouts, set down, for I'll speak truth.") + (0.02 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :alice: Riddling confession finds but riddling shrift.") + (0.04 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :bob: Ay, and the captain of his horse, Count Rousillon.")) + +((privmsg-bob 10 "PRIVMSG #chan :bob: hi") + (0.02 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :alice: But thankful even for hate, that is meant love.") + (0.02 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :tester: Come, come, elder brother, you are too young in this.") + (0.02 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :bob: Sir, we have known together in Orleans.") + (0.05 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :alice: Pawn me to this your honour, she is his.")) commit 1ef219e220c9645a5592eb73837aba8d50e4265c Author: Mattias Engdegård Date: Thu May 4 17:47:05 2023 +0200 Make old-struct test more robust * test/lisp/emacs-lisp/cl-lib-tests.el (old-struct): Use the `vector` constructor instead of vector literals to avoid failing because of `type-of` constant-folding. diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 4e1a0fd63a2..b14731c4d0a 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -530,7 +530,7 @@ cl-lib-defstruct-record (ert-deftest old-struct () (cl-defstruct foo x) - (let ((x [cl-struct-foo]) + (let ((x (vector 'cl-struct-foo)) (saved cl-old-struct-compat-mode)) (cl-old-struct-compat-mode -1) (should (eq (type-of x) 'vector)) @@ -540,7 +540,7 @@ old-struct (let ((cl-struct-foo (cl--struct-get-class 'foo))) (setf (symbol-function 'cl-struct-foo) :quick-object-witness-check) (should (eq (type-of x) 'foo)) - (should (eq (type-of [foo]) 'vector))) + (should (eq (type-of (vector 'foo)) 'vector))) (cl-old-struct-compat-mode (if saved 1 -1)))) commit 044392c5c563a0bb2c24b65e5222b8f9b3cbe0d8 Author: Mattias Engdegård Date: Thu May 4 17:37:17 2023 +0200 Constant-propagate cons and vector literals * lisp/emacs-lisp/byte-opt.el (byte-optimize--substitutable-p): Allow quoted lists and conses, and vector literals, to be substituted from lexical variables. This can eliminate variable bindings and create new constant folding opportunities. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index d046c4d401c..8fe5066c49e 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -221,21 +221,17 @@ byte-optimize--aliased-vars (defun byte-optimize--substitutable-p (expr) "Whether EXPR is a constant that can be propagated." - ;; Only consider numbers, symbols and strings to be values for substitution - ;; purposes. Numbers and symbols are immutable, and mutating string - ;; literals (or results from constant-evaluated string-returning functions) - ;; can be considered undefined. - ;; (What about other quoted values, like conses?) (or (booleanp expr) (numberp expr) - (stringp expr) - (and (consp expr) - (or (and (memq (car expr) '(quote function)) - (symbolp (cadr expr))) - ;; (internal-get-closed-var N) can be considered constant for - ;; const-prop purposes. - (and (eq (car expr) 'internal-get-closed-var) - (integerp (cadr expr))))) + (arrayp expr) + (let ((head (car-safe expr))) + (cond ((eq head 'quote) t) + ;; Don't substitute #'(lambda ...) since that would enable + ;; uncontrolled inlining. + ((eq head 'function) (symbolp (cadr expr))) + ;; (internal-get-closed-var N) can be considered constant for + ;; const-prop purposes. + ((eq head 'internal-get-closed-var) (integerp (cadr expr))))) (keywordp expr))) (defmacro byte-optimize--pcase (exp &rest cases) commit 3b038d46e24532bc4bca56f37d30afd70fae388d Author: Mattias Engdegård Date: Thu May 4 17:31:15 2023 +0200 Remove useless handling of erroneous code in Lisp optimiser * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): ((closure ...) ...) is a malformed function call; treat it as such. Better malformed function warning location. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index d859706c180..d046c4d401c 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -469,10 +469,6 @@ byte-optimize-form-code-walker form (byte-optimize-form newform for-effect)))) - ;; FIXME: Strictly speaking, I think this is a bug: (closure...) - ;; is a *value* and shouldn't appear in the car. - (`((closure . ,_) . ,_) form) - (`(setq ,var ,expr) (let ((lexvar (assq var byte-optimize--lexvars)) (value (byte-optimize-form expr nil))) @@ -500,7 +496,7 @@ byte-optimize-form-code-walker (cons fn (mapcar #'byte-optimize-form exps))) (`(,(pred (not symbolp)) . ,_) - (byte-compile-warn-x fn "`%s' is a malformed function" fn) + (byte-compile-warn-x form "`%s' is a malformed function" fn) form) ((guard (when for-effect commit 1438574dd73a097293f8cfe356c3459cec6ee005 Author: Mattias Engdegård Date: Thu May 4 17:28:08 2023 +0200 Don't inline funcall to literal lambda form * lisp/emacs-lisp/byte-opt.el (byte-optimize-funcall): Don't convert (funcall '(lambda ...) ...) -> ((lambda ...) ...) because that would inline what is essentially an `eval` of a function using dynamic binding rules into lexbound code. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 0f7a3cb2665..d859706c180 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1420,10 +1420,13 @@ byte-optimize-not (defun byte-optimize-funcall (form) - ;; (funcall (lambda ...) ...) ==> ((lambda ...) ...) - ;; (funcall foo ...) ==> (foo ...) - (let ((fn (nth 1 form))) - (if (memq (car-safe fn) '(quote function)) + ;; (funcall #'(lambda ...) ...) -> ((lambda ...) ...) + ;; (funcall #'SYM ...) -> (SYM ...) + ;; (funcall 'SYM ...) -> (SYM ...) + (let* ((fn (nth 1 form)) + (head (car-safe fn))) + (if (or (eq head 'function) + (and (eq head 'quote) (symbolp (nth 1 fn)))) (cons (nth 1 fn) (cdr (cdr form))) form))) commit 0e8d8a72284f6b3aaa1bbce73d41c7d84bbc4d3c Author: João Távora Date: Fri May 5 19:44:11 2023 +0100 Fido-mode: never shadow 'external' completion style As explained in the manual (20.7.2 Fast minibuffer selection) 'fido-mode' and 'fido-vertical-mode' give priority the "flex" completion style. In fact, bug#62015 was recently fixed in commit because that priority was not taking place correctly and some completions were missed. However, an exception must be made for the 'external' completion style. That style, made available by the lisp/external-completion.el library, is specifically designed to work with backends that provide only a partial view of all completions. If we allow 'flex' to step in front of 'external' it could mean that 'flex' matches something and 'external' isn't triggered as it probably should. To reproduce have the rust-mode ELPA package and the rust-analyzer LSP server handy. Then: emacs -Q -f package-initialize main.rs Where main.rs is this content: fn foo1() {} fn foo2() {} fn foo3() {} fn foobar1() {} fn foobar2() {} fn foobar3() {} The rust-analyzer server can be quickly configured to return only 3 workspace symbols max, so evaluate: (setq-default eglot-workspace-configuration '(:rust-analyzer (:workspace (:symbol (:search (:limit 3)))))) Now start M-x eglot and M-x fido-vertical-mode and type C-u M-. to find an arbitrary symbol in this one-file project. Type 'f'. You will see the three foo's are listed, correctly. Now type '3'. You will only see "foo3". But that's wrong because "foobar3" was available, if only the server had been asked for it. This commit fixes the situation and no completions are lost. As an unfortunate side-effect of this commit, the fontification of completions-common-part on the matches is lost, but that is not worse than missing out on completions and there are better ways to recover the fontification anyway (in external-completion.el). See also: https://github.com/joaotavora/eglot/discussions/1219#discussioncomment-5818336 * lisp/icomplete.el (icomplete--fido-ccd): Do not touch entries with 'external in them. diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 6ed2cbe395c..e6fdd1f1836 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -427,7 +427,10 @@ icomplete--fido-ccd for (cat . alist) in completion-category-defaults collect `(,cat . ,(cl-loop for entry in alist for (prop . val) = entry - if (eq prop 'styles) + if (and (eq prop 'styles) + ;; Never step in front of 'external', as that + ;; might lose us completions. + (not (memq 'external val))) collect `(,prop . (flex ,@(delq 'flex val))) else collect entry)))) commit f6476f8536853bd3e5577c76f619c7a9710cc46a Author: Michael Albinus Date: Fri May 5 19:39:22 2023 +0200 Improve ange-ftp-file-remote-p * lisp/net/ange-ftp.el (ange-ftp-file-remote-p): Handle hop identification. diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 1c20a27801d..16ec33f92dc 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -4242,6 +4242,7 @@ ange-ftp-file-remote-p ((eq identification 'user) user) ((eq identification 'host) host) ((eq identification 'localname) localname) + ((eq identification 'hop) nil) (t (ange-ftp-replace-name-component file "")))))) (defun ange-ftp-load (file &optional noerror nomessage nosuffix must-suffix) commit 778a1ee35b46017ab06c13c8a29f054533bc952b Author: Mattias Engdegård Date: Fri May 5 19:19:51 2023 +0200 Fix dired and tramp where `ls` does not have the `-N` option This includes BSD ls, also used by macOS (bug#63142). * lisp/dired.el (dired-insert-directory): * lisp/net/tramp-sh.el (tramp-sh-handle-insert-directory): Test whether -N is understood by ls since that option is used along with --dired. Remove -N when we remove --dired. diff --git a/lisp/dired.el b/lisp/dired.el index 1c8d011d765..e70467ca53b 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1647,9 +1647,9 @@ dired-insert-directory ;; save the answer in `dired-use-ls-dired'. (or (setq dired-use-ls-dired (eq 0 (call-process insert-directory-program - nil nil nil "--dired"))) + nil nil nil "--dired" "-N"))) (progn - (message "ls does not support --dired; \ + (message "ls does not support --dired -N; \ see `dired-use-ls-dired' for more details.") nil)) dired-use-ls-dired))) @@ -1665,7 +1665,7 @@ dired-insert-directory ;; "--dired", so we cannot add it to the `process-file' ;; call for wildcards. (when (file-remote-p dir) - (setq switches (string-replace "--dired" "" switches))) + (setq switches (string-replace "--dired -N" "" switches))) (let* ((default-directory (car dir-wildcard)) (script (format "ls %s %s" switches (cdr dir-wildcard))) (remotep (file-remote-p dir)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 94fbc588b5d..d020615af07 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2566,7 +2566,7 @@ tramp-sh-handle-insert-directory (setq switches (append switches (split-string (tramp-sh--quoting-style-options v)))) (unless (tramp-get-ls-command-with v "--dired") - (setq switches (delete "--dired" switches))) + (setq switches (delete "-N" (delete "--dired" switches)))) (when wildcard (setq wildcard (tramp-run-real-handler #'file-name-nondirectory (list localname))) commit c0ab4e9ca9326c472ff1d9d01a0e3966f20fda27 Author: João Távora Date: Fri May 5 14:51:09 2023 +0100 Eglot: re-rename eglot-upgrade to eglot-upgrade-eglot * doc/misc/eglot.texi (Getting the latest version): Mention eglot-upgrade-eglot. * etc/EGLOT-NEWS: Mention eglot-upgrade-eglot. * lisp/progmodes/eglot.el (eglot-upgrade-eglot): Rename from eglot-update. (eglot-update): New compatibility alias. diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index 8ac14372e36..962e6c914ce 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -1307,8 +1307,8 @@ Getting the latest version Often, a newer Eglot version exists that has fixed a longstanding bug, has more LSP features, or just better supports a particular language server. Recent Eglot versions can self-update via the command -@kbd{M-x eglot-upgrade}. This will replace any currently installed -version with the newest one available from the ELPA archives +@kbd{M-x eglot-upgrade-eglot}. This will replace any currently +installed version with the newest one available from the ELPA archives configured in @code{package-archives}. You can also update Eglot through other methods, such as diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index d2d84c5ff9e..fd0d9a24568 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -18,7 +18,14 @@ That is, to look up issue github#1234, go to https://github.com/joaotavora/eglot/issues/1234. -* Changes in Eglot bundled with Emacs 29 +* Changes in Eglot 1.12.29 (Eglot bundled with Emacs 29.1) + +** Eglot can upgrade itself to the latest version. + +The new command 'eglot-upgrade-eglot' works around behaviour in the +existing 'package-install' command and the new 'package-upgrade' +command which would prevent the user from easily grabbing the latest +version as usual. ** LSP inlay hints are now supported. Inlay hints are small text annotations not unlike diagnostics, but diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 6d1d010eb9a..df8f5f64829 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1967,7 +1967,7 @@ eglot-manual (interactive) (info "(eglot)")) ;;;###autoload -(defun eglot-upgrade (&rest _) "Update Eglot." +(defun eglot-upgrade-eglot (&rest _) "Update Eglot to latest version." (interactive) (with-no-warnings (require 'package) @@ -1976,6 +1976,9 @@ eglot-upgrade (package-delete existing t)) (package-install (cadr (assoc 'eglot package-archive-contents))))) +;;;###autoload +(define-obsolete-function-alias 'eglot-update 'eglot-upgrade-eglot "29.1") + (easy-menu-define eglot-menu nil "Eglot" `("Eglot" ;; Commands for getting information and customization. commit b4e90070f965316ba647dde7a5d37821e4f4c793 Author: Eli Zaretskii Date: Fri May 5 10:08:59 2023 +0300 Fix arguments of xml.c functions as displayed in Help buffers * lisp/subr.el (libxml-parse-xml-region) (libxml-parse-html-region): Adjust advertised-calling-convention to the changes in commit cc33c6cf3a. (Bug#63291) diff --git a/lisp/subr.el b/lisp/subr.el index d4428aef765..54b92fc8607 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1848,8 +1848,8 @@ log10 (set-advertised-calling-convention 'unintern '(name obarray) "23.3") (set-advertised-calling-convention 'indirect-function '(object) "25.1") (set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3") -(set-advertised-calling-convention 'libxml-parse-xml-region '(start end &optional base-url) "27.1") -(set-advertised-calling-convention 'libxml-parse-html-region '(start end &optional base-url) "27.1") +(set-advertised-calling-convention 'libxml-parse-xml-region '(&optional start end base-url) "27.1") +(set-advertised-calling-convention 'libxml-parse-html-region '(&optional start end base-url) "27.1") (set-advertised-calling-convention 'time-convert '(time form) "29.1") ;;;; Obsolescence declarations for variables, and aliases. commit b1bda8228e5788391cefbb4721af24f5713a0e37 Author: Po Lu Date: Fri May 5 14:13:37 2023 +0800 More fixes for NetBSD/vax * src/sysdep.c (init_signals) [__vax__]: Treat SIGILL as a floating point error on VAXen. Otherwise, (log 0.0) crashes Emacs. diff --git a/src/sysdep.c b/src/sysdep.c index ce6a20f5302..7bac3d8935a 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2005,7 +2005,9 @@ init_signals (void) signal (SIGPIPE, SIG_IGN); sigaction (SIGQUIT, &process_fatal_action, 0); +#ifndef __vax__ sigaction (SIGILL, &thread_fatal_action, 0); +#endif /* __vax__ */ sigaction (SIGTRAP, &thread_fatal_action, 0); /* Typically SIGFPE is thread-specific and is fatal, like SIGILL. @@ -2018,6 +2020,11 @@ init_signals (void) { emacs_sigaction_init (&action, deliver_arith_signal); sigaction (SIGFPE, &action, 0); +#ifdef __vax__ + /* NetBSD/vax generates SIGILL upon some floating point errors, + such as taking the log of 0.0. */ + sigaction (SIGILL, &action, 0); +#endif /* __vax__ */ } #ifdef SIGUSR1 commit a2d4cd06f455e815c0c01434458b810367a66c92 Author: Cyril Arnould Date: Wed May 3 19:40:18 2023 +0000 Improve VHDL mode highlighting * lisp/progmodes/vhdl-mode.el (vhdl-compiler-alist): Differentiate between ModelSim errors, warnings, and notes when highlighting them. Add a new entry for Xilinx Vivado. (Bug#63251) Copyright-paperwork-exempt: yes diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 45fd17f65c4..ee0ec63b6bc 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -286,7 +286,7 @@ vhdl-compiler-alist ;; counter_rtl.vhd(29):Conditional signal assignment line__29 ("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1" nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim" - ("^\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\\[[0-9]+]\\| ([^)]+)\\)? \\([^ \t\n]+\\)(\\([0-9]+\\)):" 3 4 nil) + ("^\\(?:\\(?1:ERROR\\|\\*\\* Error\\)\\|\\(?2:WARNING\\|\\*\\* Warning\\)\\|\\(?3:NOTE\\|\\*\\* Note\\)\\)[^:]*:\\( *\\[[0-9]+]\\| ([^)]+)\\)? \\(?4:[^ \t\n]+\\)(\\(?5:[0-9]+\\)):" 4 5 nil (2 . 3)) ("" 0) ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" "\\1/_primary.dat" "\\1/body.dat" downcase)) @@ -385,6 +385,13 @@ vhdl-compiler-alist nil "mkdir \\1" "./" "work/" "Makefile" "xilinx" ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \t\n]+\\)\" Line \\([0-9]+\\)\\." 1 2 nil) ("" 0) nil) + ;; Xilinx Vivado: + ;; ERROR: [VRFC 10-1412] syntax error near o_idle [test.vhd:23] + ("Xilinx Vivado" "xvhdl" "" "make" "-f \\1" + nil "mkdir \\1" "./" "work" "Makefile" "vivado" + ("^\\(?:\\(?1:ERROR\\)\\|\\(?2:WARNING\\)\\|\\(?3:INFO\\)\\): \\(.+\\) \\[\\(?4:[^ \t\n]+\\):\\(?5:[0-9]+\\)\\]" 4 5 nil (2 . 3)) ("" 0) + ("\\1/entity" "\\2/\\1" "\\1/configuration" + "\\1/package" "\\1/body" downcase)) ) "List of available VHDL compilers and their properties. Each list entry specifies the following items for a compiler: commit f204c4a6cfa77fdbb2573b728110576e206b0b20 Author: Jim Porter Date: Thu May 4 22:43:13 2023 -0700 ; Use a Bourne shell-compatible form for command substitution * build-aux/git-hooks/post-commit: * build-aux/git-hooks/pre-push: Use `` instead of $(). diff --git a/build-aux/git-hooks/post-commit b/build-aux/git-hooks/post-commit index 12cae09206a..e02fee48db4 100755 --- a/build-aux/git-hooks/post-commit +++ b/build-aux/git-hooks/post-commit @@ -34,7 +34,7 @@ ### Code: -HOOKS_DIR=$(dirname $0) +HOOKS_DIR=`dirname "$0"` # Prefer gawk if available, as it handles NUL bytes properly. if type gawk >/dev/null 2>&1; then diff --git a/build-aux/git-hooks/pre-push b/build-aux/git-hooks/pre-push index 420aae3492b..a342814c1e3 100755 --- a/build-aux/git-hooks/pre-push +++ b/build-aux/git-hooks/pre-push @@ -31,7 +31,7 @@ ### Code: -HOOKS_DIR=$(dirname $0) +HOOKS_DIR=`dirname "$0"` # Prefer gawk if available, as it handles NUL bytes properly. if type gawk >/dev/null 2>&1; then commit eb3a90619fed86298c96951af527a8483bdd1a3c Author: Jim Porter Date: Thu May 4 21:04:46 2023 -0700 ; Allow spaces in directory names for Git hooks * build-aux/git-hooks/post-commit: * build-aux/git-hooks/pre-push: Quote "$HOOKS_DIR" to allow spaces. diff --git a/build-aux/git-hooks/post-commit b/build-aux/git-hooks/post-commit index 10f43b539ac..12cae09206a 100755 --- a/build-aux/git-hooks/post-commit +++ b/build-aux/git-hooks/post-commit @@ -44,4 +44,4 @@ else fi git rev-parse HEAD | $awk -v reason=post-commit \ - -f $HOOKS_DIR/commit-msg-files.awk + -f "$HOOKS_DIR"/commit-msg-files.awk diff --git a/build-aux/git-hooks/pre-push b/build-aux/git-hooks/pre-push index 8d5dde2bbaf..420aae3492b 100755 --- a/build-aux/git-hooks/pre-push +++ b/build-aux/git-hooks/pre-push @@ -85,4 +85,4 @@ $awk -v origin_name="$1" ' # Print every SHA after oldref, up to (and including) newref. system("git rev-list --first-parent --reverse " oldref ".." newref) } -' | $awk -v reason=pre-push -f $HOOKS_DIR/commit-msg-files.awk +' | $awk -v reason=pre-push -f "$HOOKS_DIR"/commit-msg-files.awk commit 34ac7d908762663e4f91b678d3456286c494c237 Author: Spencer Baugh Date: Thu Apr 27 12:11:45 2023 -0400 Make vc-hg-annotate-command async There's no benefit in this running the process synchrounously, and it's annoying for it to block the Emacs UI. * lisp/vc/vc-hg.el (vc-hg-annotate-command): Run asynchronously (bug#63123). diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 5bab9aa529e..78480fd8062 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -578,7 +578,7 @@ vc-hg-revision-completion-table (defun vc-hg-annotate-command (file buffer &optional revision) "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER. Optional arg REVISION is a revision to annotate from." - (apply #'vc-hg-command buffer 0 file "annotate" "-dq" "-n" + (apply #'vc-hg-command buffer 'async file "annotate" "-dq" "-n" (append (vc-switches 'hg 'annotate) (if revision (list (concat "-r" revision)))))) commit 5f79d821a0651b74268cc1a27a8396a7e524a8c8 Author: Michael Albinus Date: Thu May 4 20:42:24 2023 +0200 Suspend timers when reading Tramp process output * lisp/net/tramp-compat.el (xdg): Require. (tramp-compat-temporary-file-directory): Set it to $XDG_CACHE_HOME/emacs if possible. * lisp/net/tramp.el (tramp-debug-to-file): Fix docstring. (tramp-wrong-passwd-regexp): Add "Authentication failed" string (from doas). (tramp-debug-message): Simplify backtrace check. (with-tramp-locked-connection): Suppress timers. (Bug#49954, Bug60534) * test/lisp/net/tramp-tests.el (tramp-test09-insert-file-contents): Adapt test. (tramp-test45-asynchronous-requests): Remove :unstable tag. Adapt test. diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index c5864e7fa5e..e0d38853956 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -496,12 +496,12 @@ with-tramp-saved-connection-properties (cons property (gethash property hash tramp-cache-undefined))) ,properties))) (unwind-protect (progn ,@body) - ;; Reset PROPERTIES. Recompute hash, it could have been flushed. - (setq hash (tramp-get-hash-table ,key)) - (dolist (value values) - (if (not (eq (cdr value) tramp-cache-undefined)) - (puthash (car value) (cdr value) hash) - (remhash (car value) hash))))))) + ;; Reset PROPERTIES. Recompute hash, it could have been flushed. + (setq hash (tramp-get-hash-table ,key)) + (dolist (value values) + (if (not (eq (cdr value) tramp-cache-undefined)) + (puthash (car value) (cdr value) hash) + (remhash (car value) hash))))))) ;;;###tramp-autoload (defun tramp-cache-print (table) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 150c3fbf187..43544ae327e 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -35,6 +35,7 @@ (require 'parse-time) (require 'shell) (require 'subr-x) +(require 'xdg) (declare-function tramp-error "tramp") (declare-function tramp-tramp-file-p "tramp") @@ -64,9 +65,16 @@ tramp-compat-funcall (with-no-warnings (funcall ,function ,@arguments)))) ;; We must use a local directory. If it is remote, we could run into -;; an infloop. +;; an infloop. We try to follow the XDG specification, for security reasons. (defconst tramp-compat-temporary-file-directory - (eval (car (get 'temporary-file-directory 'standard-value)) t) + (file-name-as-directory + (if-let ((xdg (xdg-cache-home)) + ((file-directory-p xdg)) + ((file-writable-p xdg))) + ;; We can use `file-name-concat' starting with Emacs 28.1. + (prog1 (setq xdg (concat (file-name-as-directory xdg) "emacs")) + (make-directory xdg t)) + (eval (car (get 'temporary-file-directory 'standard-value)) t))) "The default value of `temporary-file-directory'.") (defsubst tramp-compat-make-temp-name () diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7ce984d9144..3eb2dd13cbc 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -120,7 +120,7 @@ tramp-verbose (defcustom tramp-debug-to-file nil "Whether Tramp debug messages shall be saved to file. The debug file has the same name as the debug buffer, written to -`temporary-file-directory'." +`tramp-compat-temporary-file-directory'." :version "28.1" :type 'boolean) @@ -665,6 +665,7 @@ tramp-wrong-passwd-regexp "Sorry, try again." "Name or service not known" "Host key verification failed." + "Authentication failed" "No supported authentication methods left to try!" (: "Login " (| "Incorrect" "incorrect")) (: "Connection " (| "refused" "closed")) @@ -1970,7 +1971,7 @@ tramp-debug-outline-regexp (+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) blank ;; Thread. (? (group "#") blank) - ;; Function name, verbosity. + ;; Function name, verbosity. (+ (any "-" alnum)) " (" (group (+ digit)) ") #") "Used for highlighting Tramp debug buffers in `outline-mode'.") @@ -2109,18 +2110,23 @@ tramp-debug-message (insert "\n")) ;; Timestamp. (insert (format-time-string "%T.%6N ")) + ;; Threads. `current-thread' might not exist when Emacs is + ;; configured --without-threads. + ;; (unless (eq (tramp-compat-funcall 'current-thread) main-thread) + ;; (insert (format "%s " (tramp-compat-funcall 'current-thread)))) ;; Calling Tramp function. We suppress compat and trace ;; functions from being displayed. - (let ((btn 1) btf fn) + (let ((frames (backtrace-frames)) + btf fn) (while (not fn) - (setq btf (nth 1 (backtrace-frame btn))) + (setq btf (cadadr frames)) (if (not btf) (setq fn "") (and (symbolp btf) (setq fn (symbol-name btf)) (or (not (string-prefix-p "tramp" fn)) (get btf 'tramp-suppress-trace)) (setq fn nil)) - (setq btn (1+ btn)))) + (setq frames (cdr frames)))) ;; The following code inserts filename and line number. ;; Should be inactive by default, because it is time consuming. ;; (let ((ffn (find-function-noselect (intern fn)))) @@ -3790,14 +3796,14 @@ tramp-skeleton-write-region ;; VISIT, for example `jka-compr-handler'. We must respect this. ;; See Bug#55166. `(let* ((filename (expand-file-name ,filename)) - (lockname (file-truename (or ,lockname filename))) - (handler (and (stringp ,visit) - (let ((inhibit-file-name-handlers - `(tramp-file-name-handler - tramp-crypt-file-name-handler - . inhibit-file-name-handlers)) - (inhibit-file-name-operation 'write-region)) - (find-file-name-handler ,visit 'write-region))))) + (lockname (file-truename (or ,lockname filename))) + (handler (and (stringp ,visit) + (let ((inhibit-file-name-handlers + `(tramp-file-name-handler + tramp-crypt-file-name-handler + . inhibit-file-name-handlers)) + (inhibit-file-name-operation 'write-region)) + (find-file-name-handler ,visit 'write-region))))) (with-parsed-tramp-file-name filename nil (if handler (progn @@ -5821,11 +5827,14 @@ with-tramp-locked-connection (throw 'non-essential 'non-essential) (tramp-error ,proc 'remote-file-error "Forbidden reentrant call of Tramp")) - (unwind-protect - (progn - (tramp-set-connection-property ,proc "locked" t) - ,@body) - (tramp-flush-connection-property ,proc "locked")))) + (let ((stimers (with-timeout-suspend)) + timer-list timer-idle-list) + (unwind-protect + (progn + (tramp-set-connection-property ,proc "locked" t) + ,@body) + (tramp-flush-connection-property ,proc "locked") + (with-timeout-unsuspend stimers))))) (defun tramp-accept-process-output (proc &optional _timeout) "Like `accept-process-output' for Tramp processes. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 8e4e7122a27..840decbf5d5 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2440,15 +2440,19 @@ tramp-test09-insert-file-contents `(,(expand-file-name tmp-name) 0))) (should (string-equal (buffer-string) "foo")) (should (= point (point)))) - (let ((point (point))) - (replace-string-in-region "foo" "bar" (point-min) (point-max)) - (goto-char point) - (should - (equal - (insert-file-contents tmp-name nil nil nil 'replace) - `(,(expand-file-name tmp-name) 3))) - (should (string-equal (buffer-string) "foo")) - (should (= point (point)))) + ;; Insert another string. + ;; `replace-string-in-region' was introduced in Emacs 28.1. + (when (tramp--test-emacs28-p) + (let ((point (point))) + (with-no-warnings + (replace-string-in-region "foo" "bar" (point-min) (point-max))) + (goto-char point) + (should + (equal + (insert-file-contents tmp-name nil nil nil 'replace) + `(,(expand-file-name tmp-name) 3))) + (should (string-equal (buffer-string) "foo")) + (should (= point (point))))) ;; Error case. (delete-file tmp-name) (should-error @@ -7444,12 +7448,7 @@ tramp-test45-asynchronous-requests "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." - ;; :tags (append '(:expensive-test :tramp-asynchronous-processes) - ;; (and (or (getenv "EMACS_HYDRA_CI") - ;; (getenv "EMACS_EMBA_CI")) - ;; '(:unstable))) - ;; It doesn't work sufficiently. - :tags '(:expensive-test :tramp-asynchronous-processes :unstable) + :tags '(:expensive-test :tramp-asynchronous-processes) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-supports-processes-p)) (skip-unless (not (tramp--test-container-p))) @@ -7517,14 +7516,12 @@ tramp-test45-asynchronous-requests (when buffers (let ((time (float-time)) (default-directory tmp-name) - (file (buffer-name (seq-random-elt buffers))) - ;; A remote operation in a timer could - ;; confuse Tramp heavily. So we ignore this - ;; error here. - (debug-ignored-errors - (cons 'remote-file-error debug-ignored-errors))) + (file (buffer-name (seq-random-elt buffers)))) (tramp--test-message "Start timer %s %s" file (current-time-string)) + (dired-uncache file) + (tramp--test-message + "Continue timer %s %s" file (file-attributes file)) (vc-registered file) (tramp--test-message "Stop timer %s %s" file (current-time-string)) commit d3ec68f5e433e5792c1c63672c7b437bb29c5759 Author: Jim Porter Date: Thu May 4 09:22:40 2023 -0700 ; Fix post-commit and pre-push hooks in worktrees again * build-aux/git-hooks/post-commit: * build-aux/git-hooks/pre-push: Use "$(dirname $0)" to get the hooks directory. diff --git a/build-aux/git-hooks/post-commit b/build-aux/git-hooks/post-commit index 05f2d778b5c..10f43b539ac 100755 --- a/build-aux/git-hooks/post-commit +++ b/build-aux/git-hooks/post-commit @@ -34,6 +34,8 @@ ### Code: +HOOKS_DIR=$(dirname $0) + # Prefer gawk if available, as it handles NUL bytes properly. if type gawk >/dev/null 2>&1; then awk="gawk" @@ -42,4 +44,4 @@ else fi git rev-parse HEAD | $awk -v reason=post-commit \ - -f ${GIT_DIR:-.git}/hooks/commit-msg-files.awk + -f $HOOKS_DIR/commit-msg-files.awk diff --git a/build-aux/git-hooks/pre-push b/build-aux/git-hooks/pre-push index 6ff59102fd7..8d5dde2bbaf 100755 --- a/build-aux/git-hooks/pre-push +++ b/build-aux/git-hooks/pre-push @@ -31,6 +31,8 @@ ### Code: +HOOKS_DIR=$(dirname $0) + # Prefer gawk if available, as it handles NUL bytes properly. if type gawk >/dev/null 2>&1; then awk="gawk" @@ -83,4 +85,4 @@ $awk -v origin_name="$1" ' # Print every SHA after oldref, up to (and including) newref. system("git rev-list --first-parent --reverse " oldref ".." newref) } -' | $awk -v reason=pre-push -f ${GIT_DIR:-.git}/hooks/commit-msg-files.awk +' | $awk -v reason=pre-push -f $HOOKS_DIR/commit-msg-files.awk commit 2f3a514b6db5e0d0453c56a4f201088ea99d5139 Author: Po Lu Date: Thu May 4 22:08:44 2023 +0800 Clarify documentation wrt floating point division by zero and NaN * doc/lispref/numbers.texi (Float Basics) (Arithmetic Operations): Document what happens on a VAX. Tested on NetBSD 9.3. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 9bfb771fc07..3e45aa90fda 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -219,17 +219,25 @@ Float Basics @cindex @acronym{IEEE} floating point Floating-point numbers are useful for representing numbers that are -not integral. The range of floating-point numbers is -the same as the range of the C data type @code{double} on the machine -you are using. On all computers supported by Emacs, this is -@acronym{IEEE} binary64 floating point format, which is standardized by -@url{https://standards.ieee.org/standard/754-2019.html,,IEEE Std 754-2019} -and is discussed further in David Goldberg's paper +not integral. The range of floating-point numbers is the same as the +range of the C data type @code{double} on the machine you are using. +On almost all computers supported by Emacs, this is @acronym{IEEE} +binary64 floating point format, which is standardized by +@url{https://standards.ieee.org/standard/754-2019.html,,IEEE Std +754-2019} and is discussed further in David Goldberg's paper ``@url{https://docs.oracle.com/cd/E19957-01/806-3568/ncg_goldberg.html, -What Every Computer Scientist Should Know About Floating-Point Arithmetic}''. -On modern platforms, floating-point operations follow the IEEE-754 -standard closely; however, results are not always rounded correctly on -some obsolescent platforms, notably 32-bit x86. +What Every Computer Scientist Should Know About Floating-Point +Arithmetic}''. On modern platforms, floating-point operations follow +the IEEE-754 standard closely; however, results are not always rounded +correctly on some systems, notably 32-bit x86. + + On some old computer systems, Emacs may not use IEEE floating-point. +We know of one such system on which Emacs runs correctly, but does not +follow IEEE-754: the VAX running NetBSD using GCC 10.4.0, where the +VAX @samp{D_Floating} format is used instead. IBM System/370-derived +mainframes and their XL/C compiler are also capable of utilizing a +hexadecimal floating point format, but Emacs has not yet been built in +such a configuration. The read syntax for floating-point numbers requires either a decimal point, an exponent, or both. Optional signs (@samp{+} or @samp{-}) @@ -262,6 +270,10 @@ Float Basics signs and significands agree. Significands of NaNs are machine-dependent, as are the digits in their string representation. + NaNs are not available on systems which do not use IEEE +floating-point arithmetic; if the read syntax for a NaN is used on a +VAX, for example, the reader signals an error. + When NaNs and signed zeros are involved, non-numeric functions like @code{eql}, @code{equal}, @code{sxhash-eql}, @code{sxhash-equal} and @code{gethash} determine whether values are indistinguishable, not @@ -742,9 +754,10 @@ Arithmetic Operations @cindex @code{arith-error} in division If you divide an integer by the integer 0, Emacs signals an -@code{arith-error} error (@pxref{Errors}). Floating-point division of -a nonzero number by zero yields either positive or negative infinity -(@pxref{Float Basics}). +@code{arith-error} error (@pxref{Errors}). On systems using IEEE-754 +floating-point, floating-point division of a nonzero number by zero +yields either positive or negative infinity (@pxref{Float Basics}); +otherwise, an @code{arith-error} is signaled as usual. @end defun @defun % dividend divisor commit 94e984e6700c805c3aaac6f8d9c56381a8d0673a Author: Robert Pluim Date: Thu May 4 14:07:08 2023 +0200 Make loaddefs-generate slightly more tolerant There are packages in the wild, such as vlf-20191126.2250, which have entries that are not terminated by three ';', but by two. Tolerate such entries. * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Search for two ';' as a delimiter, not three. (Bug#63236) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index a966b1e9f40..2a46fb7a022 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -635,9 +635,12 @@ loaddefs-generate (progn (goto-char (point-max)) (search-backward "\f\n" nil t)) - ;; Delete the old version of the section. + ;; Delete the old version of the section. Strictly + ;; speaking this should search for "\n\f\n;;;", but + ;; there are loaddefs files in the wild that only + ;; have two ';;'. (Bug#63236) (delete-region (match-beginning 0) - (and (search-forward "\n\f\n;;;") + (and (search-forward "\n\f\n;;") (match-beginning 0))) (forward-line -2))) (insert head) commit aba41d2c4bb4a47e2953231044f5a998ab37d82e Author: Eli Zaretskii Date: Thu May 4 16:37:39 2023 +0300 ; Minor doc cleanups in go-ts-mode.el * lisp/progmodes/go-ts-mode.el (go-ts-mode--iota-query-supported-p) (go-ts-mode--other-type-node-p, go-mod-ts-mode--in-directive-p): Doc fixes. diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index f32a2d75775..4233b115f19 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -106,8 +106,7 @@ go-ts-mode--operators "Go operators for tree-sitter font-locking.") (defun go-ts-mode--iota-query-supported-p () - "Returns t if the iota query is supported by the current version of -the tree-sitter-go grammar." + "Return t if the iota query is supported by the tree-sitter-go grammar." (ignore-errors (or (treesit-query-string "" '((iota) @font-lock-constant-face) 'go) t))) @@ -296,7 +295,7 @@ go-ts-mode--alias-node-p (treesit-search-subtree node "type_alias" nil nil 1))) (defun go-ts-mode--other-type-node-p (node) - "Return t if NODE is a type, other than interface, struct or alias." + "Return t if NODE is a type other than interface, struct, or alias." (and (string-equal "type_declaration" (treesit-node-type node)) (not (go-ts-mode--interface-node-p node)) @@ -325,7 +324,7 @@ go-mod-ts-mode--indent-rules "Tree-sitter indent rules for `go-mod-ts-mode'.") (defun go-mod-ts-mode--in-directive-p () - "Return non-nil if inside a directive. + "Return non-nil if point is inside a directive. When entering an empty directive or adding a new entry to one, no node will be present meaning none of the indentation rules will match, because there is no parent to match against. This function determines commit b42ccb2e5c133070c03ba8691ed8a0c6807b0da9 Author: Basil L. Contovounesios Date: Thu May 4 12:16:57 2023 +0200 ; Minor grammar fix in treesit manual. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index deaed31aed0..00298d88f43 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -4154,7 +4154,7 @@ Parser-based Font Lock @end multitable Lisp programs mark patterns in @var{query} with capture names (names -that starts with @code{@@}), and tree-sitter will return matched nodes +that start with @code{@@}), and tree-sitter will return matched nodes tagged with those same capture names. For the purpose of fontification, capture names in @var{query} should be face names like @code{font-lock-keyword-face}. The captured node will be fontified commit ab44c8a6f9d7926a00dd1dfe49fa8ae07b5e7030 Author: Philip Kaludercic Date: Mon May 1 13:53:52 2023 +0200 Fix order of rcirc-connect arguments * lisp/net/rcirc.el (rcirc): Pass SERVER-ALIAS before CLIENT-CERT. (rcirc-connect): Take SERVER-ALIAS before CLIENT-CERT. This is necessary for the 'rcirc-reconnect' trick to work that applies the contents of 'rcirc-connection-info' to 'rcirc-connect', otherwise the server alias gets lost as certfp information. This addresses a change made in b79cb838a477ee5a5c3660e81264991ff833a82f. diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 937f4046adb..cf1b952086a 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -584,7 +584,7 @@ rcirc (condition-case nil (let ((process (rcirc-connect server port nick user-name full-name channels password encryption - client-cert server-alias))) + server-alias client-cert))) (when rcirc-display-server-buffer (pop-to-buffer-same-window (process-buffer process)))) (quit (message "Quit connecting to %s" @@ -680,7 +680,7 @@ rcirc-get-server-cert ;;;###autoload (defun rcirc-connect (server &optional port nick user-name full-name startup-channels password encryption - certfp server-alias) + server-alias certfp) "Connect to SERVER. The arguments PORT, NICK, USER-NAME, FULL-NAME, PASSWORD, ENCRYPTION, CERTFP, SERVER-ALIAS are interpreted as in commit 8eb6e33691d1c8e95e25e086e1b04669ea4fffdb Author: Thuna Date: Wed Nov 23 04:14:36 2022 +0100 Fix rcirc messages printing in the wrong place * lisp/net/rcirc.el (rcirc-send-message): Print the message before sending it to the server. (rcirc-print): Get the time with subsecond precision. * lisp/calendar/parse-time.el (parse-time-string parse-iso8601-time-string): Accept optional second FORM arguments, with the same meaning as in `decode-time'. Mention as such in the docstring. (Bug#59501) Copyright-paperwork-exempt: yes diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index 1b667a6852e..a62361121fc 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -147,7 +147,7 @@ parse-time-rules ;;;###autoload(put 'parse-time-rules 'risky-local-variable t) ;;;###autoload -(defun parse-time-string (string) +(defun parse-time-string (string &optional form) "Parse the time in STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). STRING should be an ISO 8601 time string, e.g., \"2020-01-15T16:12:21-08:00\", or something resembling an RFC 822 (or later) date-time, e.g., @@ -156,9 +156,11 @@ parse-time-string return a \"likely\" value even for somewhat malformed strings. The values returned are identical to those of `decode-time', but any unknown values other than DST are returned as nil, and an -unknown DST value is returned as -1." +unknown DST value is returned as -1. + +See `decode-time' for the meaning of FORM." (condition-case () - (iso8601-parse string) + (iso8601-parse string form) (wrong-type-argument (let ((time (list nil nil nil nil nil nil nil -1 nil)) (temp (parse-time-tokenize (downcase string)))) @@ -199,12 +201,14 @@ parse-time-string (setf (nth (pop slots) time) new-val)))))))) time)))) -(defun parse-iso8601-time-string (date-string) +(defun parse-iso8601-time-string (date-string &optional form) "Parse an ISO 8601 time string, such as \"2020-01-15T16:12:21-08:00\". Fall back on parsing something resembling an RFC 822 (or later) date-time. This function is like `parse-time-string' except that it returns -a Lisp timestamp when successful." - (when-let ((time (parse-time-string date-string))) +a Lisp timestamp when successful. + +See `decode-time' for the meaning of FORM." + (when-let ((time (parse-time-string date-string form))) (encode-time time))) (provide 'parse-time) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 97a314eb8ab..937f4046adb 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1233,9 +1233,9 @@ rcirc-send-message (let ((response (if noticep "NOTICE" "PRIVMSG"))) (rcirc-get-buffer-create process target) (dolist (msg (rcirc-split-message message)) - (rcirc-send-string process response target : msg) (unless silent - (rcirc-print process (rcirc-nick process) response target msg))))) + (rcirc-print process (rcirc-nick process) response target msg)) + (rcirc-send-string process response target : msg)))) (defvar-local rcirc-input-ring nil "Ring object for input.") @@ -2034,7 +2034,7 @@ rcirc-print (not (string= sender (rcirc-nick process)))) (let* ((buffer (rcirc-target-buffer process sender response target text)) (time (if-let ((time (rcirc-get-tag "time"))) - (parse-iso8601-time-string time) + (parse-iso8601-time-string time t) (current-time))) (inhibit-read-only t)) (with-current-buffer buffer @@ -2204,7 +2204,7 @@ rcirc-log disk. PROCESS is the process object for the current connection." (let ((filename (funcall rcirc-log-filename-function process target)) (time (and-let* ((time (rcirc-get-tag "time"))) - (parse-iso8601-time-string time)))) + (parse-iso8601-time-string time t)))) (unless (null filename) (let ((cell (assoc-string filename rcirc-log-alist)) (line (concat (format-time-string rcirc-time-format time) @@ -2996,7 +2996,7 @@ rcirc-markup-timestamp "Insert a timestamp." (goto-char (point-min)) (let ((time (and-let* ((time (rcirc-get-tag "time"))) - (parse-iso8601-time-string time)))) + (parse-iso8601-time-string time t)))) (insert (rcirc-facify (format-time-string rcirc-time-format time) 'rcirc-timestamp)))) commit 2901a3443c7daa15cbe01947ace3e0980e419028 Author: Philip Kaludercic Date: Sun Apr 30 20:21:04 2023 +0200 Prevent unnecessary modifications of 'package-vc-selected-packages' * lisp/emacs-lisp/package-vc.el (package-vc--unpack): Handle the structure of correctly, not as an alist but a list of alists. (package-vc--archive-spec-alist, package-vc--archive-spec-alists, package-vc--desc->spec, package-vc--read-archive-data, package-vc--download-and-read-archives, package-vc--unpack): Rename 'package-vc--archive-spec-alist' to 'package-vc--archive-spec-alists'. diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index fa9fce24acc..8f62e7d65f3 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -162,7 +162,7 @@ package-vc-selected-packages (:vc-backend symbol))))) :version "29.1") -(defvar package-vc--archive-spec-alist nil +(defvar package-vc--archive-spec-alists nil "List of package specifications for each archive. The list maps each package name, as a string, to a plist as specified in `package-vc-selected-packages'.") @@ -194,15 +194,15 @@ package-vc--desc->spec (not (alist-get name package-vc-selected-packages nil nil #'string=))) (alist-get (intern (package-desc-archive pkg-desc)) - package-vc--archive-spec-alist) + package-vc--archive-spec-alists) ;; Consult both our local list of package specifications, as well ;; as the lists provided by the archives. (apply #'append (cons package-vc-selected-packages - (mapcar #'cdr package-vc--archive-spec-alist)))) + (mapcar #'cdr package-vc--archive-spec-alists)))) '() nil #'string=)) (defun package-vc--read-archive-data (archive) - "Update `package-vc--archive-spec-alist' for ARCHIVE. + "Update `package-vc--archive-spec-alists' for ARCHIVE. This function is meant to be used as a hook for `package-read-archive-hook'." (let ((contents-file (expand-file-name (format "archives/%s/elpa-packages.eld" archive) @@ -219,7 +219,7 @@ package-vc--read-archive-data (let ((spec (read (current-buffer)))) (when (eq package-vc--elpa-packages-version (plist-get (cdr spec) :version)) - (setf (alist-get (intern archive) package-vc--archive-spec-alist) + (setf (alist-get (intern archive) package-vc--archive-spec-alists) (car spec))) (setf (alist-get (intern archive) package-vc--archive-data-alist) (cdr spec)) @@ -230,7 +230,7 @@ package-vc--read-archive-data (defun package-vc--download-and-read-archives (&optional async) "Download specifications of all `package-archives' and read them. -Populate `package-vc--archive-spec-alist' with the result. +Populate `package-vc--archive-spec-alists' with the result. If optional argument ASYNC is non-nil, perform the downloads asynchronously." @@ -571,7 +571,7 @@ package-vc-non-code-file-names (defun package-vc--unpack (pkg-desc pkg-spec &optional rev) "Install the package described by PKG-DESC. PKG-SPEC is a package specification, a property list describing -how to fetch and build the package. See `package-vc--archive-spec-alist' +how to fetch and build the package. See `package-vc--archive-spec-alists' for details. The optional argument REV specifies a specific revision to checkout. This overrides the `:branch' attribute in PKG-SPEC." (unless (eq (package-desc-kind pkg-desc) 'vc) @@ -620,7 +620,8 @@ package-vc--unpack (throw 'done (setq lisp-dir name))))) ;; Ensure we have a copy of the package specification - (unless (equal (alist-get name (mapcar #'cdr package-vc--archive-spec-alist)) pkg-spec) + (unless (seq-some (lambda (alist) (equal (alist-get name (cdr alist)) pkg-spec)) + package-vc--archive-spec-alists) (customize-save-variable 'package-vc-selected-packages (cons (cons name pkg-spec) commit eaad302bd6f1d30bed1fbdd02e5091d13ce0c7ba Author: Dmitry Gutov Date: Thu May 4 01:39:15 2023 +0300 Rename eglot-update to eglot-upgrade * doc/misc/eglot.texi (Getting the latest version): Update the reference. * lisp/progmodes/eglot.el (eglot-upgrade): Rename from 'eglot-update', as discussed on emacs-devel, in line with 'package-upgrade'. diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index 542a4259d66..8ac14372e36 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -1307,7 +1307,7 @@ Getting the latest version Often, a newer Eglot version exists that has fixed a longstanding bug, has more LSP features, or just better supports a particular language server. Recent Eglot versions can self-update via the command -@kbd{M-x eglot-update}. This will replace any currently installed +@kbd{M-x eglot-upgrade}. This will replace any currently installed version with the newest one available from the ELPA archives configured in @code{package-archives}. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index f005c4858e7..6d1d010eb9a 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1967,7 +1967,7 @@ eglot-manual (interactive) (info "(eglot)")) ;;;###autoload -(defun eglot-update (&rest _) "Update Eglot." +(defun eglot-upgrade (&rest _) "Update Eglot." (interactive) (with-no-warnings (require 'package) commit eaf25b9c6ae4020f76a810b6920b65613ca50e5d Author: Randy Taylor Date: Wed Apr 26 11:15:45 2023 -0400 go-ts-mode: Use iota query only if supported (Bug#63086) iota query support was added on January 5, 2022. To support older versions of the tree-sitter-go grammar (like the latest tagged version, v0.19.1, which was released on March 3, 2021), check if the query is supported before trying to use it. * lisp/progmodes/go-ts-mode.el (go-ts-mode--iota-query-supported-p): New function. (go-ts-mode--font-lock-settings): Use it. diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 77c97ffac11..f32a2d75775 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -105,6 +105,12 @@ go-ts-mode--operators ">>" "%=" ">>=" "--" "!" "..." "&^" "&^=" "~") "Go operators for tree-sitter font-locking.") +(defun go-ts-mode--iota-query-supported-p () + "Returns t if the iota query is supported by the current version of +the tree-sitter-go grammar." + (ignore-errors + (or (treesit-query-string "" '((iota) @font-lock-constant-face) 'go) t))) + (defvar go-ts-mode--font-lock-settings (treesit-font-lock-rules :language 'go @@ -117,7 +123,9 @@ go-ts-mode--font-lock-settings :language 'go :feature 'constant - '([(false) (iota) (nil) (true)] @font-lock-constant-face + `([(false) (nil) (true)] @font-lock-constant-face + ,@(when (go-ts-mode--iota-query-supported-p) + '((iota) @font-lock-constant-face)) (const_declaration (const_spec name: (identifier) @font-lock-constant-face))) commit cc090294d77c5d4047607d3234c304aaa1b0489c Author: Dmitry Gutov Date: Wed May 3 23:58:27 2023 +0300 (rng-complete-tag): Add the (ignored) argument to the :company-kind function * lisp/nxml/rng-nxml.el (rng-complete-tag): Add the (ignored) argument to the :company-kind function. Fixes the "Wrong number of arguments" error reported at https://github.com/company-mode/company-mode/issues/1386. diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el index 568cf24451b..fd1f4fb904e 100644 --- a/lisp/nxml/rng-nxml.el +++ b/lisp/nxml/rng-nxml.el @@ -180,7 +180,7 @@ rng-complete-tag (insert " ")))) ((member completion extra-strings) (insert ">")))) - :company-kind ,(lambda () 'property)))))) + :company-kind ,(lambda (_) 'property)))))) (defconst rng-in-end-tag-name-regex (replace-regexp-in-string commit b28d44d4226497c4b2582bc15a59fc817eb3ce0a Author: Stefan Monnier Date: Wed May 3 13:18:08 2023 -0400 * lisp/emacs-lisp/package.el (package-buffer-info): Fix thinko diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 16b2218da26..0f68f0e8041 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1196,7 +1196,7 @@ package-buffer-info ;; the earliest in version 31.1. The idea is to phase out the ;; requirement for a "footer line" without unduly impacting users ;; on earlier Emacs versions. See Bug#26490 for more details. - (unless (search-forward (concat ";;; " file-name ".el ends here")) + (unless (search-forward (concat ";;; " file-name ".el ends here") nil t) (lwarn '(package package-format) :warning "Package lacks a terminating comment")) ;; Try to include a trailing newline. commit 21ec6c1d5cc7b6e1858f21de62a593e25d205383 Author: Jonas Bernoulli Date: Wed May 3 15:02:31 2023 +0200 Update to Transient v0.3.7-219-g3ded15b diff --git a/lisp/transient.el b/lisp/transient.el index 4affc414fa6..9785e218b19 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -1071,7 +1071,8 @@ transient--parse-suffix (if (and desc (or (stringp desc) (symbolp desc))) desc (plist-get args :key))))))) - (setq args (plist-put args :command `(defalias ',sym ,cmd))))) + (setq args (plist-put args :command + `(defalias ',sym ,(macroexp-quote cmd)))))) ((or (stringp car) (and car (listp car))) (let ((arg pop)) commit 8d5aa8df4ad268c253712efe9ca3b3b158d19433 Author: Po Lu Date: Wed May 3 20:02:01 2023 +0800 Fix inserting selection data into Mozilla programs * lisp/select.el (xselect-convert-to-text-uri-list): Don't return any value when converting non-DND selections to this drag-and-drop target. Reported by Tobias Bading . diff --git a/lisp/select.el b/lisp/select.el index 7f089c62dd5..09c678867d0 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -807,19 +807,24 @@ xselect-convert-to-save-targets (defun xselect-convert-to-username (_selection _type _value) (user-real-login-name)) -(defun xselect-convert-to-text-uri-list (_selection _type value) - (let ((string - (if (stringp value) - (xselect--encode-string 'TEXT - (concat (url-encode-url value) "\n")) - (when (vectorp value) - (with-temp-buffer - (cl-loop for tem across value - do (progn - (insert (url-encode-url tem)) - (insert "\n"))) - (xselect--encode-string 'TEXT (buffer-string))))))) - (cons 'text/uri-list (cdr string)))) +(defun xselect-convert-to-text-uri-list (selection _type value) + ;; While `xselect-uri-list-available-p' ensures that this target + ;; will not be reported in the TARGETS of non-drag-and-drop + ;; selections, Firefox stupidly converts to it anyway. Check that + ;; the conversion request is being made for the correct selection. + (and (eq selection 'XdndSelection) + (let ((string + (if (stringp value) + (xselect--encode-string 'TEXT + (concat (url-encode-url value) "\n")) + (when (vectorp value) + (with-temp-buffer + (cl-loop for tem across value + do (progn + (insert (url-encode-url tem)) + (insert "\n"))) + (xselect--encode-string 'TEXT (buffer-string))))))) + (cons 'text/uri-list (cdr string))))) (defun xselect-convert-to-xm-file (selection _type value) (when (and (stringp value) commit 57562c3fd0a5a7b640cc42c6daaad6842cd5b311 Author: Thuna Date: Wed Apr 19 23:43:22 2023 +0200 Recognize defstruct slot names in various eieio functions * lisp/emacs-lisp/cl-preloaded.el (cl-struct-define): Set each slot's name's 'slot-name' property so that 'eieio--known-slot-name-p' can recognize them. (Bug#62959) Copyright-paperwork-exempt: yes diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 9445093f143..5235be52996 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -176,6 +176,7 @@ cl-struct-define (i 0) (offset (if type 0 1))) (dolist (slot slots) + (put (car slot) 'slot-name t) (let* ((props (cl--plist-to-alist (cddr slot))) (typep (assq :type props)) (type (if (null typep) t commit 5eaa7ec09860c779ca7c9af4fbda673a1046c362 Author: Michael Albinus Date: Wed May 3 13:26:35 2023 +0200 Tramp code cleanup * doc/lispref/files.texi (Magic File Names): Order alphabetically. * lisp/net/tramp.el (tramp-file-name-for-operation): * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): * lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist): * lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist): * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): * lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist): * lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist): * lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist): * lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist): Order alphabetically. * lisp/net/tramp.el (tramp-handle-file-user-uid) (tramp-handle-file-group-gid, tramp-read-id-output): * lisp/net/tramp-archive.el (tramp-archive-handle-file-group-gid): (tramp-archive-handle-file-user-uid): Fix docstring. * test/lisp/net/tramp-archive-tests.el (tramp-archive-test44-user-group-ids): Fix docstring. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 6e1aae5d63b..3982eb14f2b 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -3390,7 +3390,7 @@ Magic File Names @code{file-directory-p}, @code{file-equal-p}, @code{file-executable-p}, @code{file-exists-p}, -@code{file-in-directory-p}, +@code{file-group-gid}, @code{file-in-directory-p}, @code{file-local-copy}, @code{file-locked-p}, @code{file-modes}, @code{file-name-all-completions}, @code{file-name-as-directory}, @@ -3405,7 +3405,7 @@ Magic File Names @code{file-readable-p}, @code{file-regular-p}, @code{file-remote-p}, @code{file-selinux-context}, @code{file-symlink-p}, @code{file-system-info}, -@code{file-truename}, @code{file-user-uid}, @code{file-group-gid}, +@code{file-truename}, @code{file-user-uid}, @code{file-writable-p}, @code{find-backup-file-name},@* @code{get-file-buffer}, @@ -3452,7 +3452,7 @@ Magic File Names @code{file-direc@discretionary{}{}{}tory-p}, @code{file-equal-p}, @code{file-executable-p}, @code{file-exists-p}, -@code{file-in-directory-p}, +@code{file-group-gid}, @code{file-in-directory-p}, @code{file-local-copy}, @code{file-locked-p}, @code{file-modes}, @code{file-name-all-completions}, @code{file-name-as-directory}, @@ -3467,7 +3467,7 @@ Magic File Names @code{file-readable-p}, @code{file-regular-p}, @code{file-remote-p}, @code{file-selinux-context}, @code{file-symlink-p}, @code{file-system-info}, -@code{file-truename}, @code{file-user-uid}, @code{file-group-gid}, +@code{file-truename}, @code{file-user-uid}, @code{file-writable-p}, @code{find-backup-file-name}, @code{get-file-buffer}, diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 6c668640ba4..2b5369ea3b5 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -130,6 +130,7 @@ tramp-adb-file-name-handler-alist (file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-adb-handle-file-executable-p) (file-exists-p . tramp-adb-handle-file-exists-p) + (file-group-gid . tramp-handle-file-group-gid) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-adb-handle-file-local-copy) (file-locked-p . tramp-handle-file-locked-p) @@ -154,7 +155,6 @@ tramp-adb-file-name-handler-alist (file-system-info . tramp-adb-handle-file-system-info) (file-truename . tramp-handle-file-truename) (file-user-uid . tramp-handle-file-user-uid) - (file-group-gid . tramp-handle-file-group-gid) (file-writable-p . tramp-adb-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 8de6d406817..6fcb0ae5e69 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -242,6 +242,7 @@ tramp-archive-file-name-handler-alist (file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-archive-handle-file-executable-p) (file-exists-p . tramp-archive-handle-file-exists-p) + (file-group-gid . tramp-archive-handle-file-group-gid) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-archive-handle-file-local-copy) (file-locked-p . ignore) @@ -266,7 +267,6 @@ tramp-archive-file-name-handler-alist (file-system-info . tramp-archive-handle-file-system-info) (file-truename . tramp-archive-handle-file-truename) (file-user-uid . tramp-archive-handle-file-user-uid) - (file-group-gid . tramp-archive-handle-file-group-gid) (file-writable-p . ignore) (find-backup-file-name . ignore) ;; `get-file-buffer' performed by default handler. @@ -645,6 +645,13 @@ tramp-archive-handle-file-exists-p "Like `file-exists-p' for file archives." (file-exists-p (tramp-archive-gvfs-file-name filename))) +(defun tramp-archive-handle-file-group-gid () + "Like `file-group-gid' for file archives." + (with-parsed-tramp-archive-file-name default-directory nil + (let ((default-directory (file-name-directory archive))) + ;; `file-group-gid' exists since Emacs 30.1. + (tramp-compat-funcall 'file-group-gid)))) + (defun tramp-archive-handle-file-local-copy (filename) "Like `file-local-copy' for file archives." (file-local-copy (tramp-archive-gvfs-file-name filename))) @@ -673,19 +680,12 @@ tramp-archive-handle-file-truename (concat (file-truename archive) local)))) (defun tramp-archive-handle-file-user-uid () - "Like `user-uid' for file archives." + "Like `file-user-uid' for file archives." (with-parsed-tramp-archive-file-name default-directory nil (let ((default-directory (file-name-directory archive))) ;; `file-user-uid' exists since Emacs 30.1. (tramp-compat-funcall 'file-user-uid)))) -(defun tramp-archive-handle-file-group-gid () - "Like `group-gid' for file archives." - (with-parsed-tramp-archive-file-name default-directory nil - (let ((default-directory (file-name-directory archive))) - ;; `file-group-gid' exists since Emacs 30.1. - (tramp-compat-funcall 'file-group-gid)))) - (defun tramp-archive-handle-insert-directory (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for file archives." diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 4acf6938b84..276b65fcfb3 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -181,6 +181,7 @@ tramp-crypt-file-name-handler-alist (file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-crypt-handle-file-executable-p) (file-exists-p . tramp-handle-file-exists-p) + ;; `file-group-gid' performed by default-handler. (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-handle-file-local-copy) (file-locked-p . tramp-crypt-handle-file-locked-p) @@ -205,7 +206,6 @@ tramp-crypt-file-name-handler-alist (file-system-info . tramp-crypt-handle-file-system-info) ;; `file-truename' performed by default handler. ;; `file-user-uid' performed by default-handler. - ;; `file-group-gid' performed by default-handler. (file-writable-p . tramp-crypt-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index cce34889000..e3b42acfed5 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -807,6 +807,7 @@ tramp-gvfs-file-name-handler-alist (file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-gvfs-handle-file-executable-p) (file-exists-p . tramp-handle-file-exists-p) + (file-group-gid . tramp-handle-file-group-gid) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-handle-file-local-copy) (file-locked-p . tramp-handle-file-locked-p) @@ -831,7 +832,6 @@ tramp-gvfs-file-name-handler-alist (file-system-info . tramp-gvfs-handle-file-system-info) (file-truename . tramp-handle-file-truename) (file-user-uid . tramp-handle-file-user-uid) - (file-group-gid . tramp-handle-file-group-gid) (file-writable-p . tramp-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index aa869460589..02e96e10438 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -95,6 +95,7 @@ tramp-rclone-file-name-handler-alist (file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-fuse-handle-file-executable-p) (file-exists-p . tramp-handle-file-exists-p) + (file-group-gid . tramp-handle-file-group-gid) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-handle-file-local-copy) (file-locked-p . tramp-handle-file-locked-p) @@ -119,7 +120,6 @@ tramp-rclone-file-name-handler-alist (file-system-info . tramp-rclone-handle-file-system-info) (file-truename . tramp-handle-file-truename) (file-user-uid . tramp-handle-file-user-uid) - (file-group-gid . tramp-handle-file-group-gid) (file-writable-p . tramp-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index eacf7084fd1..94fbc588b5d 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1073,6 +1073,7 @@ tramp-sh-file-name-handler-alist (file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-sh-handle-file-executable-p) (file-exists-p . tramp-sh-handle-file-exists-p) + (file-group-gid . tramp-handle-file-group-gid) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-sh-handle-file-local-copy) (file-locked-p . tramp-handle-file-locked-p) @@ -1097,7 +1098,6 @@ tramp-sh-file-name-handler-alist (file-system-info . tramp-sh-handle-file-system-info) (file-truename . tramp-sh-handle-file-truename) (file-user-uid . tramp-handle-file-user-uid) - (file-group-gid . tramp-handle-file-group-gid) (file-writable-p . tramp-sh-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 93e6266313d..1182501e820 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -246,6 +246,7 @@ tramp-smb-file-name-handler-alist (file-file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-handle-file-exists-p) (file-exists-p . tramp-handle-file-exists-p) + (file-group-gid . tramp-handle-file-group-gid) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-smb-handle-file-local-copy) (file-locked-p . tramp-handle-file-locked-p) @@ -270,7 +271,6 @@ tramp-smb-file-name-handler-alist (file-system-info . tramp-smb-handle-file-system-info) (file-truename . tramp-handle-file-truename) (file-user-uid . tramp-handle-file-user-uid) - (file-group-gid . tramp-handle-file-group-gid) (file-writable-p . tramp-smb-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index d552f6c83fa..9d871276f7a 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -101,6 +101,7 @@ tramp-sshfs-file-name-handler-alist (file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-fuse-handle-file-executable-p) (file-exists-p . tramp-handle-file-exists-p) + (file-group-gid . tramp-handle-file-group-gid) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-handle-file-local-copy) (file-locked-p . tramp-handle-file-locked-p) @@ -125,7 +126,6 @@ tramp-sshfs-file-name-handler-alist (file-system-info . tramp-sshfs-handle-file-system-info) (file-truename . tramp-handle-file-truename) (file-user-uid . tramp-handle-file-user-uid) - (file-group-gid . tramp-handle-file-group-gid) (file-writable-p . tramp-sshfs-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 531a1591a16..e41a4a590e2 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -90,6 +90,7 @@ tramp-sudoedit-file-name-handler-alist (file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-sudoedit-handle-file-executable-p) (file-exists-p . tramp-sudoedit-handle-file-exists-p) + (file-group-gid . tramp-handle-file-group-gid) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-handle-file-local-copy) (file-locked-p . tramp-handle-file-locked-p) @@ -115,7 +116,6 @@ tramp-sudoedit-file-name-handler-alist (file-system-info . tramp-sudoedit-handle-file-system-info) (file-truename . tramp-sudoedit-handle-file-truename) (file-user-uid . tramp-handle-file-user-uid) - (file-group-gid . tramp-handle-file-group-gid) (file-writable-p . tramp-sudoedit-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9729baeb0d4..7ce984d9144 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2650,7 +2650,7 @@ tramp-file-name-for-operation ;; Emacs 29+ only. list-system-processes memory-info process-attributes ;; Emacs 30+ only. - file-user-uid file-group-gid)) + file-group-gid file-user-uid)) default-directory) ;; PROC. ((member operation '(file-notify-rm-watch file-notify-valid-p)) @@ -3931,7 +3931,7 @@ tramp-handle-abbreviate-file-name (tramp-make-tramp-file-name (tramp-dissect-file-name filename))))) (defun tramp-handle-file-user-uid () - "Like `user-uid' for Tramp files." + "Like `file-user-uid' for Tramp files." (let ((v (tramp-dissect-file-name default-directory))) (or (tramp-get-remote-uid v 'integer) ;; Some handlers for `tramp-get-remote-uid' return nil if they @@ -3940,7 +3940,7 @@ tramp-handle-file-user-uid tramp-unknown-id-integer))) (defun tramp-handle-file-group-gid () - "Like `group-gid' for Tramp files." + "Like `file-group-gid' for Tramp files." (let ((v (tramp-dissect-file-name default-directory))) (or (tramp-get-remote-gid v 'integer) ;; Some handlers for `tramp-get-remote-gid' return nil if they @@ -6399,7 +6399,7 @@ tramp-get-remote-groups (defun tramp-read-id-output (vec) "Read in connection buffer the output of the `id' command. -Set connection properties \"{uid,gid.groups}-{integer,string}\"." +Set connection properties \"{uid,gid,groups}-{integer,string}\"." (with-current-buffer (tramp-get-connection-buffer vec) (let (uid-integer uid-string gid-integer gid-string diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 5fa727a13e5..2e2e313f35c 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -883,7 +883,8 @@ tramp-archive-test43-file-system-info ;; `file-user-uid' and `file-group-gid' were introduced in Emacs 30.1. (ert-deftest tramp-archive-test44-user-group-ids () - "Check that `file-user-uid' returns proper values." + "Check results of user/group functions. +`file-user-uid' and `file-group-gid' should return proper values." (skip-unless tramp-archive-enabled) (skip-unless (and (fboundp 'file-user-uid) (fboundp 'file-group-gid))) commit 3f66b26d64ec25922ff0b17027b0c5a6ed5e9aeb Author: Eli Zaretskii Date: Wed May 3 14:15:42 2023 +0300 ; * lisp/dired.el (dired-insert-directory): Fix a typo in a comment. diff --git a/lisp/dired.el b/lisp/dired.el index e3a9d7bc428..1c8d011d765 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1655,7 +1655,7 @@ dired-insert-directory dired-use-ls-dired))) ;; Use -N with --dired, to countermand possible non-default ;; quoting style, in particular via the environment variable - ;; QUOTINTG_STYLE. + ;; QUOTING_STYLE. (setq switches (concat "--dired -N " switches))) ;; Expand directory wildcards and fill file-list. (let ((dir-wildcard (insert-directory-wildcard-in-dir-p dir))) commit 4707f6adf6a2e4f40692fa149023552f5a4f7866 Author: Alan Mackenzie Date: Wed May 3 10:01:14 2023 +0000 Fontify "extern foo ();" correctly inside a function This fixes bug#63224. * lisp/progmodes/cc-engine.el (c-forward-type): Handle the "(" as a special case by trying to parse it with c-forward-declarator and accepting it as a typeless function when that fails. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index f7320da5629..8b34daf03c2 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -9279,7 +9279,11 @@ c-forward-type (setq pos (point)) (c-forward-syntactic-ws) (and (not (looking-at c-symbol-start)) - (not (looking-at c-type-decl-prefix-key))))) + (or + (not (looking-at c-type-decl-prefix-key)) + (and (eq (char-after) ?\() + (not (save-excursion + (c-forward-declarator)))))))) ;; A C specifier followed by an implicit int, e.g. ;; "register count;" (goto-char prefix-end-pos) commit 5315f4f518d792399ea05bef7b3998e445de2d7c Author: Mattias Engdegård Date: Wed May 3 11:09:37 2023 +0200 ; * lisp/simple.el (blink-matching-open): retain props in bootstrap diff --git a/lisp/simple.el b/lisp/simple.el index c9960ed5e13..58517dd81f9 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9339,9 +9339,8 @@ blink-matching-open (delete-overlay blink-matching--overlay))))) ((not show-paren-context-when-offscreen) (minibuffer-message - #("Matches %s" - ;; Make the following text (i.e., %s) prominent. - 0 7 (face shadow)) + "%s%s" + (propertize "Matches " 'face 'shadow) (blink-paren-open-paren-line-string blinkpos))))))) (defun blink-paren-open-paren-line-string (pos) commit 40d66095635ead025b33dc693a19b463f70eb9ce Author: Jim Porter Date: Mon May 1 09:49:00 2023 -0700 Use connection-aware functions when getting the UID/GID in Eshell This means, for example, that when using Tramp to sudo in Eshell, "rm" queries the user before deleting anything (bug#63221). * lisp/eshell/esh-util.el (eshell-user-login-name): New function... * lisp/eshell/em-unix.el (eshell/whoami): ... use it. * lisp/eshell/em-ls.el (eshell-ls-applicable): Use 'file-user-uid' and 'eshell-user-login-name'. (eshell-ls-decorated-name): Use 'file-user-uid'. * lisp/eshell/em-pred.el (eshell-predicate-alist): Use 'file-user-uid' and 'file-group-gid'. * lisp/eshell/em-unix.el (eshell-interactive-query): New widget... (eshell-rm-interactive-query, eshell-mv-interactive-query) (eshell-cp-interactive-query, eshell-ln-interactive-query): ... use it. (eshell-interactive-query-p): New function... (eshell/rm, eshell/mv, eshell/cp, eshell/ln): ... use it. * lisp/simple.el (file-group-gid): New function. * lisp/net/ange-ftp.el (ange-ftp-file-group-gid): New function... (file-group-gid): ... use it. * lisp/net/tramp.el (tramp-handle-file-group-gid): * lisp/net/tramp-archive.el (tramp-archive-handle-file-group-gid): New functions. * lisp/net/tramp.el (tramp-file-name-for-operation): Add 'file-group-gid'. * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): * lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist): * lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist): * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): * lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist): * lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist): * lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist): * lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist): Add 'file-group-gid' mapping. * test/lisp/net/tramp-tests.el (tramp-test44-file-user-group-ids): * test/lisp/net/tramp-archive-tests.el (tramp-archive-test44-file-user-group-ids): Add tests for 'file-group-gid'. * doc/lispref/files.texi (Magic File Names): Mention 'file-group-gid'. * doc/lispref/os.texi (User Identification): Document 'file-group-gid', and move 'group-real-gid' to match the order of 'user-real-uid'. * etc/NEWS: Announce 'file-group-gid'. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index b15f2ab4d29..6e1aae5d63b 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -3405,7 +3405,7 @@ Magic File Names @code{file-readable-p}, @code{file-regular-p}, @code{file-remote-p}, @code{file-selinux-context}, @code{file-symlink-p}, @code{file-system-info}, -@code{file-truename}, @code{file-user-uid}, +@code{file-truename}, @code{file-user-uid}, @code{file-group-gid}, @code{file-writable-p}, @code{find-backup-file-name},@* @code{get-file-buffer}, @@ -3467,7 +3467,7 @@ Magic File Names @code{file-readable-p}, @code{file-regular-p}, @code{file-remote-p}, @code{file-selinux-context}, @code{file-symlink-p}, @code{file-system-info}, -@code{file-truename}, @code{file-user-uid}, +@code{file-truename}, @code{file-user-uid}, @code{file-group-gid}, @code{file-writable-p}, @code{find-backup-file-name}, @code{get-file-buffer}, diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 91143f77551..4bcc9d5fea6 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1290,12 +1290,22 @@ User Identification @end defun @cindex GID +@defun group-real-gid +This function returns the real @acronym{GID} of the Emacs process. +@end defun + @defun group-gid This function returns the effective @acronym{GID} of the Emacs process. @end defun -@defun group-real-gid -This function returns the real @acronym{GID} of the Emacs process. +@defun file-group-gid +This function returns the connection-local value for the user's +effective @acronym{GID}. Similar to @code{file-user-uid}, if +@code{default-directory} is local, this is equivalent to +@code{group-gid}, but for remote files (@pxref{Remote Files, , , +emacs, The GNU Emacs Manual}), it will return the @acronym{GID} for +the user associated with that remote connection; if the remote +connection has no associated user, it will instead return -1. @end defun @defun system-users diff --git a/etc/NEWS b/etc/NEWS index b989f80f3c3..3c71e52fff4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -529,10 +529,10 @@ The declaration '(important-return-value t)' sets the return value should probably not be thrown away implicitly. +++ -** New function 'file-user-uid'. -This function is like 'user-uid', but is aware of file name handlers, -so it will return the remote UID for remote files (or -1 if the -connection has no associated user). +** New functions 'file-user-uid' and 'file-group-gid'. +These functions are like 'user-uid' and 'group-gid', respectively, but +are aware of file name handlers, so they will return the remote UID or +GID for remote files (or -1 if the connection has no associated user). +++ ** 'fset', 'defalias' and 'defvaralias' now signal an error for cyclic aliases. diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 56c5f262789..9b53bf29559 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -199,9 +199,9 @@ eshell-ls-applicable `(let ((owner (file-attribute-user-id ,attrs)) (modes (file-attribute-modes ,attrs))) (cond ((cond ((numberp owner) - (= owner (user-uid))) + (= owner (file-user-uid))) ((stringp owner) - (or (string-equal owner (user-login-name)) + (or (string-equal owner (eshell-user-login-name)) (member owner (eshell-current-ange-uids))))) ;; The user owns this file. (not (eq (aref modes ,index) ?-))) @@ -919,7 +919,7 @@ eshell-ls-decorated-name ((not (eshell-ls-filetype-p (cdr file) ?-)) 'eshell-ls-special) - ((and (/= (user-uid) 0) ; root can execute anything + ((and (/= (file-user-uid) 0) ; root can execute anything (eshell-ls-applicable (cdr file) 3 'file-executable-p (car file))) 'eshell-ls-executable) diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index 2ccca092b86..bfb0dad60ef 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -87,11 +87,11 @@ eshell-predicate-alist (?U . (lambda (file) ; owned by effective uid (if (file-exists-p file) (= (file-attribute-user-id (file-attributes file)) - (user-uid))))) + (file-user-uid))))) (?G . (lambda (file) ; owned by effective gid (if (file-exists-p file) (= (file-attribute-group-id (file-attributes file)) - (group-gid))))) + (file-group-gid))))) (?* . (lambda (file) (and (file-regular-p file) (not (file-symlink-p file)) diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index a792493e071..b7ef0f0c40c 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -91,14 +91,29 @@ eshell-rm-removes-directories :type 'boolean :group 'eshell-unix) -(defcustom eshell-rm-interactive-query (= (user-uid) 0) - "If non-nil, `rm' will query before removing anything." - :type 'boolean +(define-widget 'eshell-interactive-query 'radio + "When to interatively query the user about a particular operation. +If t, always query. If nil, never query. If `root', query when +the user is logged in as root (including when `default-directory' +is remote with a root user)." + :args '((const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "When root" root))) + +(defcustom eshell-rm-interactive-query 'root + "When `rm' should query before removing anything. +If t, always query. If nil, never query. If `root', query when +the user is logged in as root (including when `default-directory' +is remote with a root user)." + :type 'eshell-interactive-query :group 'eshell-unix) -(defcustom eshell-mv-interactive-query (= (user-uid) 0) - "If non-nil, `mv' will query before overwriting anything." - :type 'boolean +(defcustom eshell-mv-interactive-query 'root + "When `mv' should query before overwriting anything. +If t, always query. If nil, never query. If `root', query when +the user is logged in as root (including when `default-directory' +is remote with a root user)." + :type 'eshell-interactive-query :group 'eshell-unix) (defcustom eshell-mv-overwrite-files t @@ -106,9 +121,12 @@ eshell-mv-overwrite-files :type 'boolean :group 'eshell-unix) -(defcustom eshell-cp-interactive-query (= (user-uid) 0) - "If non-nil, `cp' will query before overwriting anything." - :type 'boolean +(defcustom eshell-cp-interactive-query 'root + "When `cp' should query before overwriting anything. +If t, always query. If nil, never query. If `root', query when +the user is logged in as root (including when `default-directory' +is remote with a root user)." + :type 'eshell-interactive-query :group 'eshell-unix) (defcustom eshell-cp-overwrite-files t @@ -116,9 +134,12 @@ eshell-cp-overwrite-files :type 'boolean :group 'eshell-unix) -(defcustom eshell-ln-interactive-query (= (user-uid) 0) - "If non-nil, `ln' will query before overwriting anything." - :type 'boolean +(defcustom eshell-ln-interactive-query 'root + "When `ln' should query before overwriting anything. +If t, always query. If nil, never query. If `root', query when +the user is logged in as root (including when `default-directory' +is remote with a root user)." + :type 'eshell-interactive-query :group 'eshell-unix) (defcustom eshell-ln-overwrite-files nil @@ -159,6 +180,17 @@ em-preview (defvar em-recursive) (defvar em-verbose) +(defun eshell-interactive-query-p (value) + "Return non-nil if a command should query the user according to VALUE. +If VALUE is nil, return nil (never query). If `root', return +non-nil if the user is logged in as root (including when +`default-directory' is remote with a root user; see +`file-user-uid'). If VALUE is any other non-nil value, return +non-nil (always query)." + (if (eq value 'root) + (= (file-user-uid) 0) + value)) + (defun eshell/man (&rest args) "Invoke man, flattening the arguments appropriately." (funcall 'man (apply 'eshell-flatten-and-stringify args))) @@ -249,7 +281,8 @@ eshell/rm :usage "[OPTION]... FILE... Remove (unlink) the FILE(s).") (unless em-interactive - (setq em-interactive eshell-rm-interactive-query)) + (setq em-interactive (eshell-interactive-query-p + eshell-rm-interactive-query))) (if (and force-removal em-interactive) (setq em-interactive nil)) (while args @@ -523,7 +556,8 @@ eshell/mv [OPTION] DIRECTORY...") (let ((no-dereference t)) (eshell-mvcpln-template "mv" "moving" 'rename-file - eshell-mv-interactive-query + (eshell-interactive-query-p + eshell-mv-interactive-query) eshell-mv-overwrite-files)))) (put 'eshell/mv 'eshell-no-numeric-conversions t) @@ -561,7 +595,8 @@ eshell/cp (if archive (setq preserve t no-dereference t em-recursive t)) (eshell-mvcpln-template "cp" "copying" 'copy-file - eshell-cp-interactive-query + (eshell-interactive-query-p + eshell-cp-interactive-query) eshell-cp-overwrite-files preserve))) (put 'eshell/cp 'eshell-no-numeric-conversions t) @@ -594,7 +629,8 @@ eshell/ln (if symbolic 'make-symbolic-link 'add-name-to-file) - eshell-ln-interactive-query + (eshell-interactive-query-p + eshell-ln-interactive-query) eshell-ln-overwrite-files)))) (put 'eshell/ln 'eshell-no-numeric-conversions t) @@ -960,7 +996,7 @@ eshell/time (defun eshell/whoami (&rest _args) "Make \"whoami\" Tramp aware." - (or (file-remote-p default-directory 'user) (user-login-name))) + (eshell-user-login-name)) (defvar eshell-diff-window-config nil) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index c0685757789..3608c78ba2b 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -502,6 +502,11 @@ eshell-redisplay (sit-for 0) (error nil))) +(defun eshell-user-login-name () + "Return the connection-aware value of the user's login name. +See also `user-login-name'." + (or (file-remote-p default-directory 'user) (user-login-name))) + (defun eshell-read-passwd-file (file) "Return an alist correlating gids to group names in FILE." (let (names) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index e21367135d3..1c20a27801d 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -4381,7 +4381,11 @@ ange-ftp-find-backup-file-name (ange-ftp-real-find-backup-file-name fn))) (defun ange-ftp-file-user-uid () - ;; Return "don't know" value. + ;; Return "don't know" value. + -1) + +(defun ange-ftp-file-group-gid () + ;; Return "don't know" value. -1) ;;; Define the handler for special file names @@ -4524,8 +4528,9 @@ ange-ftp-hook-function (put 'file-notify-rm-watch 'ange-ftp 'ignore) (put 'file-notify-valid-p 'ange-ftp 'ignore) -;; Return the "don't know' value for remote user uid. +;; Return the "don't know" value for remote user uid and group gid. (put 'file-user-uid 'ange-ftp 'ange-ftp-file-user-uid) +(put 'file-group-gid 'ange-ftp 'ange-ftp-file-group-gid) ;;; Define ways of getting at unmodified Emacs primitives, ;;; turning off our handler. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 5a8044f8a53..6c668640ba4 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -154,6 +154,7 @@ tramp-adb-file-name-handler-alist (file-system-info . tramp-adb-handle-file-system-info) (file-truename . tramp-handle-file-truename) (file-user-uid . tramp-handle-file-user-uid) + (file-group-gid . tramp-handle-file-group-gid) (file-writable-p . tramp-adb-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index c2175612fa8..8de6d406817 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -266,6 +266,7 @@ tramp-archive-file-name-handler-alist (file-system-info . tramp-archive-handle-file-system-info) (file-truename . tramp-archive-handle-file-truename) (file-user-uid . tramp-archive-handle-file-user-uid) + (file-group-gid . tramp-archive-handle-file-group-gid) (file-writable-p . ignore) (find-backup-file-name . ignore) ;; `get-file-buffer' performed by default handler. @@ -678,6 +679,13 @@ tramp-archive-handle-file-user-uid ;; `file-user-uid' exists since Emacs 30.1. (tramp-compat-funcall 'file-user-uid)))) +(defun tramp-archive-handle-file-group-gid () + "Like `group-gid' for file archives." + (with-parsed-tramp-archive-file-name default-directory nil + (let ((default-directory (file-name-directory archive))) + ;; `file-group-gid' exists since Emacs 30.1. + (tramp-compat-funcall 'file-group-gid)))) + (defun tramp-archive-handle-insert-directory (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for file archives." diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index ea27c704587..4acf6938b84 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -205,6 +205,7 @@ tramp-crypt-file-name-handler-alist (file-system-info . tramp-crypt-handle-file-system-info) ;; `file-truename' performed by default handler. ;; `file-user-uid' performed by default-handler. + ;; `file-group-gid' performed by default-handler. (file-writable-p . tramp-crypt-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 859f4870b80..cce34889000 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -831,6 +831,7 @@ tramp-gvfs-file-name-handler-alist (file-system-info . tramp-gvfs-handle-file-system-info) (file-truename . tramp-handle-file-truename) (file-user-uid . tramp-handle-file-user-uid) + (file-group-gid . tramp-handle-file-group-gid) (file-writable-p . tramp-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 74295de4c29..aa869460589 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -119,6 +119,7 @@ tramp-rclone-file-name-handler-alist (file-system-info . tramp-rclone-handle-file-system-info) (file-truename . tramp-handle-file-truename) (file-user-uid . tramp-handle-file-user-uid) + (file-group-gid . tramp-handle-file-group-gid) (file-writable-p . tramp-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 0369e19378c..eacf7084fd1 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1097,6 +1097,7 @@ tramp-sh-file-name-handler-alist (file-system-info . tramp-sh-handle-file-system-info) (file-truename . tramp-sh-handle-file-truename) (file-user-uid . tramp-handle-file-user-uid) + (file-group-gid . tramp-handle-file-group-gid) (file-writable-p . tramp-sh-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 9a24403bb18..93e6266313d 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -270,6 +270,7 @@ tramp-smb-file-name-handler-alist (file-system-info . tramp-smb-handle-file-system-info) (file-truename . tramp-handle-file-truename) (file-user-uid . tramp-handle-file-user-uid) + (file-group-gid . tramp-handle-file-group-gid) (file-writable-p . tramp-smb-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index fe126361ac3..d552f6c83fa 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -125,6 +125,7 @@ tramp-sshfs-file-name-handler-alist (file-system-info . tramp-sshfs-handle-file-system-info) (file-truename . tramp-handle-file-truename) (file-user-uid . tramp-handle-file-user-uid) + (file-group-gid . tramp-handle-file-group-gid) (file-writable-p . tramp-sshfs-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 941c1e8dd24..531a1591a16 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -115,6 +115,7 @@ tramp-sudoedit-file-name-handler-alist (file-system-info . tramp-sudoedit-handle-file-system-info) (file-truename . tramp-sudoedit-handle-file-truename) (file-user-uid . tramp-handle-file-user-uid) + (file-group-gid . tramp-handle-file-group-gid) (file-writable-p . tramp-sudoedit-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ca95b6b6971..9729baeb0d4 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2650,7 +2650,7 @@ tramp-file-name-for-operation ;; Emacs 29+ only. list-system-processes memory-info process-attributes ;; Emacs 30+ only. - file-user-uid)) + file-user-uid file-group-gid)) default-directory) ;; PROC. ((member operation '(file-notify-rm-watch file-notify-valid-p)) @@ -3939,6 +3939,15 @@ tramp-handle-file-user-uid ;; consistency. tramp-unknown-id-integer))) +(defun tramp-handle-file-group-gid () + "Like `group-gid' for Tramp files." + (let ((v (tramp-dissect-file-name default-directory))) + (or (tramp-get-remote-gid v 'integer) + ;; Some handlers for `tramp-get-remote-gid' return nil if they + ;; can't get the GID; always return -1 in this case for + ;; consistency. + tramp-unknown-id-integer))) + (defun tramp-handle-access-file (filename string) "Like `access-file' for Tramp files." (setq filename (file-truename filename)) diff --git a/lisp/simple.el b/lisp/simple.el index 8d772eee8a8..c9960ed5e13 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4753,6 +4753,18 @@ file-user-uid (funcall handler 'file-user-uid) (user-uid))) +(defun file-group-gid () + "Return the connection-local effective gid. +This is similar to `group-gid', but may invoke a file name handler +based on `default-directory'. See Info node `(elisp)Magic File +Names'. + +If a file name handler is unable to retrieve the effective gid, +this function will instead return -1." + (if-let ((handler (find-file-name-handler default-directory 'file-group-gid))) + (funcall handler 'file-group-gid) + (group-gid))) + (defun max-mini-window-lines (&optional frame) "Compute maximum number of lines for echo area in FRAME. As defined by `max-mini-window-height'. FRAME defaults to the diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 94ef40a1116..5fa727a13e5 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -881,16 +881,18 @@ tramp-archive-test43-file-system-info (zerop (nth 1 fsi)) (zerop (nth 2 fsi)))))) -;; `file-user-uid' was introduced in Emacs 30.1. -(ert-deftest tramp-archive-test44-file-user-uid () +;; `file-user-uid' and `file-group-gid' were introduced in Emacs 30.1. +(ert-deftest tramp-archive-test44-user-group-ids () "Check that `file-user-uid' returns proper values." (skip-unless tramp-archive-enabled) - (skip-unless (fboundp 'file-user-uid)) + (skip-unless (and (fboundp 'file-user-uid) + (fboundp 'file-group-gid))) (let ((default-directory tramp-archive-test-archive)) - ;; `file-user-uid' exists since Emacs 30.1. We don't want to see - ;; compiler warnings for older Emacsen. - (should (integerp (with-no-warnings (file-user-uid)))))) + ;; `file-user-uid' and `file-group-gid' exist since Emacs 30.1. + ;; We don't want to see compiler warnings for older Emacsen. + (should (integerp (with-no-warnings (file-user-uid)))) + (should (integerp (with-no-warnings (file-group-gid)))))) (ert-deftest tramp-archive-test48-auto-load () "Check that `tramp-archive' autoloads properly." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 5fde783087e..8e4e7122a27 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -7367,16 +7367,20 @@ tramp-test43-file-system-info (dotimes (i (length fsi)) (should (natnump (or (nth i fsi) 0)))))) -;; `file-user-uid' was introduced in Emacs 30.1. -(ert-deftest tramp-test44-file-user-uid () - "Check that `file-user-uid' and `tramp-get-remote-*' return proper values." +;; `file-user-uid' and `file-group-gid' were introduced in Emacs 30.1. +(ert-deftest tramp-test44-file-user-group-ids () + "Check results of user/group functions. +`file-user-uid', `file-group-gid', and `tramp-get-remote-*' +should all return proper values." (skip-unless (tramp--test-enabled)) (let ((default-directory ert-remote-temporary-file-directory)) - ;; `file-user-uid' exists since Emacs 30.1. We don't want to see - ;; compiler warnings for older Emacsen. + ;; `file-user-uid' and `file-group-gid' exist since Emacs 30.1. + ;; We don't want to see compiler warnings for older Emacsen. (when (fboundp 'file-user-uid) (should (integerp (with-no-warnings (file-user-uid))))) + (when (fboundp 'file-group-gid) + (should (integerp (with-no-warnings (file-group-gid))))) (with-parsed-tramp-file-name default-directory nil (should (or (integerp (tramp-get-remote-uid v 'integer)) commit fa33a14ebe56aa1726df9c8ad93106966c5b6eae Author: Eli Zaretskii Date: Tue May 2 21:36:26 2023 +0300 ; Fix last change * lisp/simple.el (blink-matching-paren-highlight-offscreen) (blink-matching-paren-offscreen) (blink-paren-open-paren-line-string): Doc fixes. (Bug#63089) diff --git a/lisp/simple.el b/lisp/simple.el index e4a0b9549e0..8d772eee8a8 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9216,8 +9216,8 @@ blink-matching-paren-dont-ignore-comments :group 'paren-blinking) (defcustom blink-matching-paren-highlight-offscreen nil - "If non-nil, highlight showing in the echo area matched off-screen open paren. -This highlighting uses face `blink-matching-paren-offscreen'." + "If non-nil, highlight matched off-screen open paren in the echo area. +This highlighting uses the `blink-matching-paren-offscreen' face." :type 'boolean :version "30.1" :group 'paren-blinking) @@ -9225,8 +9225,8 @@ blink-matching-paren-highlight-offscreen (defface blink-matching-paren-offscreen '((t :foreground "green")) "Face for showing in the echo area matched open paren that is off-screen. -This face will not be used when `blink-matching-paren-highlight-offscreen' -is nil." +This face is used only when `blink-matching-paren-highlight-offscreen' +is non-nil." :version "30.1" :group 'paren-blinking) @@ -9334,7 +9334,7 @@ blink-matching-open (defun blink-paren-open-paren-line-string (pos) "Return the line string that contains the openparen at POS. -Remove the line string's properties but give the openparen a +Remove the line string's properties but give the openparen a distinct face if `blink-matching-paren-highlight-offscreen' is non-nil." (save-excursion (goto-char pos) commit 299bd316cd172f3a71705ab33efbf23590241e15 Author: Shynur Date: Tue May 2 01:32:44 2023 +0800 Display matched offscreen open paren with a distinct face Propertize matched offscreen openparen that is showing in the echo area in order to make it prominent; use shadow face for non-context characters (i.e., 'Matches') for the same purpose. * lisp/simple.el (blink-matching-paren-offscreen): Add this face for highlighting. * lisp/simple.el (blink-matching-paren-highlight-offscreen): Add this option to toggle face `blink-matching-paren-offscreen'. * lisp/simple.el (blink-paren-open-paren-line-string): Propertize the matched offscreen openparen with a face conditionally. (Bug#63089) diff --git a/lisp/simple.el b/lisp/simple.el index b621e1603bd..e4a0b9549e0 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9215,6 +9215,21 @@ blink-matching-paren-dont-ignore-comments :type 'boolean :group 'paren-blinking) +(defcustom blink-matching-paren-highlight-offscreen nil + "If non-nil, highlight showing in the echo area matched off-screen open paren. +This highlighting uses face `blink-matching-paren-offscreen'." + :type 'boolean + :version "30.1" + :group 'paren-blinking) + +(defface blink-matching-paren-offscreen + '((t :foreground "green")) + "Face for showing in the echo area matched open paren that is off-screen. +This face will not be used when `blink-matching-paren-highlight-offscreen' +is nil." + :version "30.1" + :group 'paren-blinking) + (defun blink-matching-check-mismatch (start end) "Return whether or not START...END are matching parens. END is the current point and START is the blink position. @@ -9312,47 +9327,79 @@ blink-matching-open (delete-overlay blink-matching--overlay))))) ((not show-paren-context-when-offscreen) (minibuffer-message - "Matches %s" - (substring-no-properties - (blink-paren-open-paren-line-string blinkpos)))))))) + #("Matches %s" + ;; Make the following text (i.e., %s) prominent. + 0 7 (face shadow)) + (blink-paren-open-paren-line-string blinkpos))))))) (defun blink-paren-open-paren-line-string (pos) - "Return the line string that contains the openparen at POS." + "Return the line string that contains the openparen at POS. +Remove the line string's properties but give the openparen a +face if `blink-matching-paren-highlight-offscreen' is non-nil." (save-excursion (goto-char pos) ;; Capture the regions in terms of (beg . end) conses whose ;; buffer-substrings we want to show as a context string. Ensure ;; they are font-locked (bug#59527). - (let (regions) - ;; Show what precedes the open in its line, if anything. + (let (regions + openparen-idx) (cond + ;; Show what precedes the open in its line, if anything. ((save-excursion (skip-chars-backward " \t") (not (bolp))) - (setq regions (list (cons (line-beginning-position) - (1+ pos))))) + (let ((bol (line-beginning-position))) + (setq regions (list (cons bol (1+ pos))) + openparen-idx (- pos bol)))) ;; Show what follows the open in its line, if anything. ((save-excursion (forward-char 1) (skip-chars-forward " \t") (not (eolp))) - (setq regions (list (cons pos (line-end-position))))) + (setq regions (list (cons pos (line-end-position))) + openparen-idx 0)) ;; Otherwise show the previous nonblank line, ;; if there is one. ((save-excursion (skip-chars-backward "\n \t") (not (bobp))) - (setq regions (list (cons (progn - (skip-chars-backward "\n \t") - (line-beginning-position)) - (progn (end-of-line) - (skip-chars-backward " \t") - (point))) + (setq regions (list (cons + (let (bol) + (skip-chars-backward "\n \t") + (setq bol (line-beginning-position) + openparen-idx (- bol)) + bol) + (let (eol) + (end-of-line) + (skip-chars-backward " \t") + (setq eol (point) + openparen-idx (+ openparen-idx + eol + ;; (length "...") + 3)) + eol)) (cons pos (1+ pos))))) ;; There is nothing to show except the char itself. - (t (setq regions (list (cons pos (1+ pos)))))) + (t (setq regions (list (cons pos (1+ pos))) + openparen-idx 0))) ;; Ensure we've font-locked the context region. (font-lock-ensure (caar regions) (cdar (last regions))) - (mapconcat (lambda (region) - (buffer-substring (car region) (cdr region))) - regions - "...")))) + (let ((line-string + (mapconcat + (lambda (region) + (buffer-substring (car region) (cdr region))) + regions + "...")) + (openparen-next-char-idx (1+ openparen-idx))) + (setq line-string (substring-no-properties line-string)) + (concat + (substring line-string + 0 openparen-idx) + (let ((matched-offscreen-openparen + (substring line-string + openparen-idx openparen-next-char-idx))) + (if blink-matching-paren-highlight-offscreen + (propertize matched-offscreen-openparen + 'face 'blink-matching-paren-offscreen) + matched-offscreen-openparen)) + (substring line-string + openparen-next-char-idx)))))) (defvar blink-paren-function 'blink-matching-open "Function called, if non-nil, whenever a close parenthesis is inserted. commit b93eb68cc30241059a339fbc697677f8f1d400ab Author: Thuna Date: Tue Feb 14 19:52:37 2023 +0100 Use 'calendar-buffer' instead of fixed string * test/lisp/calendar/cal-julian-tests.el (with-cal-julian-test): Use 'calendar-buffer' instead of a literal fixed name. (Bug#61546) Copyright-paperwork-exempt: yes diff --git a/test/lisp/calendar/cal-julian-tests.el b/test/lisp/calendar/cal-julian-tests.el index e0d74e8a6cd..4207d1ee285 100644 --- a/test/lisp/calendar/cal-julian-tests.el +++ b/test/lisp/calendar/cal-julian-tests.el @@ -47,7 +47,7 @@ with-cal-julian-test (progn (calendar) ,@body) - (kill-buffer "*Calendar*")))) + (kill-buffer calendar-buffer)))) (ert-deftest cal-julian-test-goto-date () (with-cal-julian-test commit e338a8ac41d4a9fd798dda90275abe75ac071335 Author: Spencer Baugh Date: Fri Apr 21 14:55:00 2023 -0400 Handle point not at EOB in minibuffer-choose-completion Without this change, only the minibuffer contents before point are cleared when a completion is chosen, which results in stray text when point is in the middle of the minibuffer. After this change, we heuristically decide either to clear the whole buffer or only part of it, taking into account the location of point. This is a backport for the Emacs 29 release branch of a simpler fix in minibuffer-completion-help. * lisp/minibuffer.el (minibuffer-next-completion): (minibuffer-choose-completion): Recalculate completion-base-affixes with point. (Bug#62700) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index be91987d635..747c9443afa 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -4480,13 +4480,25 @@ minibuffer-next-completion When `minibuffer-completion-auto-choose' is non-nil, then also insert the selected completion to the minibuffer." (interactive "p") - (let ((auto-choose minibuffer-completion-auto-choose)) + (let ((auto-choose minibuffer-completion-auto-choose) + (buf (current-buffer))) (with-minibuffer-completions-window (when completions-highlight-face (setq-local cursor-face-highlight-nonselected-window t)) (next-completion (or n 1)) (when auto-choose - (let ((completion-use-base-affixes t)) + (let* ((completion-use-base-affixes t) + ;; Backported fix for bug#62700 + (md + (with-current-buffer buf + (completion--field-metadata (minibuffer--completion-prompt-end)))) + (base-suffix + (if (eq (alist-get 'category (cdr md)) 'file) + (with-current-buffer buf + (buffer-substring (save-excursion (search-forward "/" nil t) (point)) + (point-max))) + "")) + (completion-base-affixes (list (car completion-base-affixes) base-suffix))) (choose-completion nil t t)))))) (defun minibuffer-previous-completion (&optional n) @@ -4505,9 +4517,17 @@ minibuffer-choose-completion If NO-QUIT is non-nil, insert the completion at point to the minibuffer, but don't quit the completions window." (interactive "P") - (with-minibuffer-completions-window - (let ((completion-use-base-affixes t)) - (choose-completion nil no-exit no-quit)))) + ;; Backported fix for bug#62700 + (let* ((md (completion--field-metadata (minibuffer--completion-prompt-end))) + (base-suffix + (if (eq (alist-get 'category (cdr md)) 'file) + (buffer-substring (save-excursion (search-forward "/" nil t) (point)) + (point-max)) + ""))) + (with-minibuffer-completions-window + (let ((completion-use-base-affixes t) + (completion-base-affixes (list (car completion-base-affixes) base-suffix))) + (choose-completion nil no-exit no-quit))))) (defun minibuffer-complete-history () "Complete the minibuffer history as far as possible. commit fceaf230b063a0df9fb79cd5159cac4a761aba87 Author: Spencer Baugh Date: Tue May 2 11:37:48 2023 -0400 Note that Emacs pauses when handling sentinel errors Noting this behavior and variable here makes it easier to understand the behavior of Emacs when a sentinel has an error. * doc/lispref/processes.texi (Filter Functions): Note that Emacs pauses when handling sentinel errors. (Sentinels): Note that Emacs pauses when handling sentinel errors. (Bug#63096) diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 50e67475d8e..c901215d35d 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1755,7 +1755,9 @@ Filter Functions program was running when the filter function was started. However, if @code{debug-on-error} is non-@code{nil}, errors are not caught. This makes it possible to use the Lisp debugger to debug filter -functions. @xref{Debugger}. +functions. @xref{Debugger}. If an error is caught, Emacs pauses for +@code{process-error-pause-time} seconds so that the user sees the +error. @xref{Asynchronous Processes} Many filter functions sometimes (or always) insert the output in the process's buffer, mimicking the actions of the default filter. @@ -2159,7 +2161,9 @@ Sentinels programs was running when the sentinel was started. However, if @code{debug-on-error} is non-@code{nil}, errors are not caught. This makes it possible to use the Lisp debugger to debug the -sentinel. @xref{Debugger}. +sentinel. @xref{Debugger}. If an error is caught, Emacs pauses for +@code{process-error-pause-time} seconds so that the user sees the +error. @xref{Asynchronous Processes} While a sentinel is running, the process sentinel is temporarily set to @code{nil} so that the sentinel won't run recursively. commit f1a7cd71a04270e44845427daa896afe80b0acb0 Author: Eli Zaretskii Date: Tue May 2 20:46:17 2023 +0300 Fix Dired when QUITING_STYLE is set in the environment * lisp/dired.el (dired-insert-directory): Ensure non-default quoting style of file names is not used by 'ls' when we invoke it with the --dired switch. (Bug#63142) diff --git a/lisp/dired.el b/lisp/dired.el index d1471e993a1..e3a9d7bc428 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1653,7 +1653,10 @@ dired-insert-directory see `dired-use-ls-dired' for more details.") nil)) dired-use-ls-dired))) - (setq switches (concat "--dired " switches))) + ;; Use -N with --dired, to countermand possible non-default + ;; quoting style, in particular via the environment variable + ;; QUOTINTG_STYLE. + (setq switches (concat "--dired -N " switches))) ;; Expand directory wildcards and fill file-list. (let ((dir-wildcard (insert-directory-wildcard-in-dir-p dir))) (cond (dir-wildcard commit f8c86654c7fb6fc8c9217d137d472e374a87c279 Author: Eli Zaretskii Date: Tue May 2 15:55:44 2023 +0300 ; * doc/lispref/functions.texi (Declare Form): Fix whitespace. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index dc0d182d50d..2b1a2a1f500 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2633,7 +2633,7 @@ Declare Form @item (important-return-value @var{val}) If @var{val} is non-@code{nil}, the byte compiler will warn about -calls to this function that do not use the returned value. This is the +calls to this function that do not use the returned value. This is the same as the @code{important-return-value} property of the function's symbol, @pxref{Standard Properties}. commit daf602a5c8ec9e5d94f5e1e412182760a02c2505 Merge: 4f44c56c867 46392c1623b Author: Eli Zaretskii Date: Tue May 2 08:50:09 2023 -0400 Merge from origin/emacs-29 46392c1623b Fix vertical-motion when tab-line is displayed in a window 0e52beeacea Update to Org 9.6.5-3-g2993f4 dd21003878d Prevent generating empty autoload files 2bcf11d0efe * lisp/org/org-macs.el (org--inhibit-version-check): Fix ... ca43435816b Fix redisplay of mode line after its format changes from nil 610a7657e0a Fix c-ts-mode--emacs-c-range-query 7f94558b775 Improve documentation of warnings 5a3f0e2c558 ; Doc fix in c-ts-mode.el 21361d05635 Fix FOR_EACH_TAIL fontification (bug#62951) d0df3404fde ; * etc/EGLOT-NEWS: chsharp-le -> csharp-ls c229e83c3ce ; * etc/EGLOT-NEWS (https): Elglot -> Eglot. b4f2f499783 Fix documentation of libxml-parse-* functions 5dd784961d1 ; * src/treesit.c (syms_of_treesit): Fix error messages. ddfa0d8da9a ; Remove some leftover text commit 4f44c56c867b99bc7b813d8b104b9939479f86f2 Author: Eli Zaretskii Date: Tue May 2 15:43:51 2023 +0300 Revert "; * lisp/progmodes/c-ts-mode.el: allow loading file without treesit" This reverts commit 7d246c359cf3d25cab5134076e393c4d25015827. The same problem was already fixed on the release branch,and this change will just cause merge conflicts. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 1f420689432..4971ed0b7c2 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -1001,14 +1001,13 @@ c-ts-mode--for-each-tail-body-matcher (looking-at c-ts-mode--for-each-tail-regexp)))) (defvar c-ts-mode--emacs-c-range-query - (and (treesit-available-p) - (treesit-query-compile - 'emacs-c `(((declaration - type: (macro_type_specifier - name: (identifier) @_name) - @for-each-tail) - (:match ,c-ts-mode--for-each-tail-regexp - @_name))))) + (treesit-query-compile + 'emacs-c `(((declaration + type: (macro_type_specifier + name: (identifier) @_name) + @for-each-tail) + (:match ,c-ts-mode--for-each-tail-regexp + @_name)))) "Query that finds a FOR_EACH_* macro with an unbracketed body.") (defvar-local c-ts-mode--for-each-tail-ranges nil commit 46392c1623bc3f9764b8c7df293a89fcd47ab0ad Author: Eli Zaretskii Date: Mon May 1 15:27:21 2023 +0300 Fix vertical-motion when tab-line is displayed in a window * src/xdisp.c (try_window, try_window_id): Account for tab-line, if present, when converting scroll-margin at the top of the window to vertical pixel coordinate. (Bug#63201) diff --git a/src/xdisp.c b/src/xdisp.c index 8e265fb5a49..43847544396 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20600,6 +20600,8 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) int bot_scroll_margin = top_scroll_margin; if (window_wants_header_line (w)) top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w); + if (window_wants_tab_line (w)) + top_scroll_margin += CURRENT_TAB_LINE_HEIGHT (w); start_display (&it, w, pos); if ((w->cursor.y >= 0 @@ -21944,17 +21946,23 @@ #define GIVE_UP(X) return 0 /* Don't let the cursor end in the scroll margins. */ { - int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); + int top_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); + int bot_scroll_margin = top_scroll_margin; int cursor_height = MATRIX_ROW (w->desired_matrix, w->cursor.vpos)->height; - if ((w->cursor.y < this_scroll_margin + if (window_wants_header_line (w)) + top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w); + if (window_wants_tab_line (w)) + top_scroll_margin += CURRENT_TAB_LINE_HEIGHT (w); + + if ((w->cursor.y < top_scroll_margin && CHARPOS (start) > BEGV) /* Old redisplay didn't take scroll margin into account at the bottom, but then global-hl-line-mode doesn't scroll. KFS 2004-06-14 */ || (w->cursor.y + (cursor_row_fully_visible_p (w, false, true, true) ? 1 - : cursor_height + this_scroll_margin)) > it.last_visible_y) + : cursor_height + bot_scroll_margin)) > it.last_visible_y) { w->cursor.vpos = -1; clear_glyph_matrix (w->desired_matrix); commit 0e52beeacead956cdaa7921e911afc2fd29aea61 Author: Kyle Meyer Date: Sun Apr 30 19:36:21 2023 -0400 Update to Org 9.6.5-3-g2993f4 diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index c5d112dba72..6ee77758e06 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{9.6.4} +\def\orgversionnumber{9.6.5} \def\versionyear{2023} % latest update \input emacsver.tex diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 3f6696fce77..e69ce4f1d12 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -2426,7 +2426,8 @@ org-babel-insert-result (delete-region (point) (org-babel-result-end))) ((member "append" result-params) (goto-char (org-babel-result-end)) (setq beg (point-marker))) - ((member "prepend" result-params))) ; already there + ;; ((member "prepend" result-params)) ; already there + ) (setq results-switches (if results-switches (concat " " results-switches) "")) (let ((wrap diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index b82e915ecd1..ef61dc9cbd6 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -5,13 +5,13 @@ (defun org-release () "The release version of Org. Inserted by installing Org mode or when a release is made." - (let ((org-release "9.6.4")) + (let ((org-release "9.6.5")) org-release)) ;;;###autoload (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.6.4-9-g8eb209")) + (let ((org-git-version "release_9.6.5-3-g2993f4")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index 61862b3d63b..f4aa28cc486 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -9,7 +9,7 @@ ;; URL: https://orgmode.org ;; Package-Requires: ((emacs "26.1")) -;; Version: 9.6.4 +;; Version: 9.6.5 ;; This file is part of GNU Emacs. ;; @@ -18602,6 +18602,10 @@ org-in-block-p (throw 'exit n))))) nil))) +;; Defined in org-agenda.el +(defvar org-agenda-restrict) +(defvar org-agenda-restrict-begin) +(defvar org-agenda-restrict-end) (defun org-occur-in-agenda-files (regexp &optional _nlines) "Call `multi-occur' with buffers for all agenda files." (interactive "sOrg-files matching: ") diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el index 03c909f78ed..dd96ed8e064 100644 --- a/lisp/org/ox-odt.el +++ b/lisp/org/ox-odt.el @@ -2926,24 +2926,25 @@ org-odt-plain-text ;; FIXME: The unnecessary spacing may still remain when a newline ;; is at a boundary between Org objects (e.g. italics markup ;; followed by newline). - (setq output - (with-temp-buffer - (save-match-data - (let ((leading (and (string-match (rx bos (1+ blank)) output) - (match-string 0 output))) - (trailing (and (string-match (rx (1+ blank) eos) output) - (match-string 0 output)))) - (insert - (substring - output - (length leading) - (pcase (length trailing) - (0 nil) - (n (- n))))) - ;; Unfill, retaining leading/trailing space. - (let ((fill-column most-positive-fixnum)) - (fill-region (point-min) (point-max))) - (concat leading (buffer-string) trailing)))))) + (when (org-string-nw-p output) ; blank string needs not to be re-filled + (setq output + (with-temp-buffer + (save-match-data + (let ((leading (and (string-match (rx bos (1+ blank)) output) + (match-string 0 output))) + (trailing (and (string-match (rx (1+ blank) eos) output) + (match-string 0 output)))) + (insert + (substring + output + (length leading) + (pcase (length trailing) + (0 nil) + (n (- n))))) + ;; Unfill, retaining leading/trailing space. + (let ((fill-column most-positive-fixnum)) + (fill-region (point-min) (point-max))) + (concat leading (buffer-string) trailing))))))) ;; Return value. output)) commit dd21003878dadba1e0420269e63e10685d4670a9 Author: Philip Kaludercic Date: Sun Apr 30 13:17:09 2023 +0200 Prevent generating empty autoload files * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Remove optimisation that would mistakenly discard old loaddefs in case a file was not modified by EXTRA-DATA is non-nil. (Bug#62734) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 1007be62dd9..a966b1e9f40 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -597,73 +597,63 @@ loaddefs-generate defs)))))) (progress-reporter-done progress)) - ;; If we have no autoloads data, but we have EXTRA-DATA, then - ;; generate the (almost) empty file anyway. - (if (and (not defs) extra-data) + ;; First group per output file. + (dolist (fdefs (seq-group-by (lambda (x) (expand-file-name (car x))) + defs)) + (let ((loaddefs-file (car fdefs)) + hash) (with-temp-buffer - (insert (loaddefs-generate--rubric output-file nil t)) - (search-backward "\f") - (insert extra-data) - (ensure-empty-lines 1) - (write-region (point-min) (point-max) output-file nil 'silent)) - ;; We have some data, so generate the loaddef files. First - ;; group per output file. - (dolist (fdefs (seq-group-by (lambda (x) (expand-file-name (car x))) - defs)) - (let ((loaddefs-file (car fdefs)) - hash) - (with-temp-buffer - (if (and updating (file-exists-p loaddefs-file)) - (insert-file-contents loaddefs-file) - (insert (loaddefs-generate--rubric - loaddefs-file nil t include-package-version)) - (search-backward "\f") - (when extra-data - (insert extra-data) - (ensure-empty-lines 1))) - (setq hash (buffer-hash)) - ;; Then group by source file (and sort alphabetically). - (dolist (section (sort (seq-group-by #'cadr (cdr fdefs)) - (lambda (e1 e2) - (string< - (file-name-sans-extension - (file-name-nondirectory (car e1))) - (file-name-sans-extension - (file-name-nondirectory (car e2))))))) - (pop section) - (let* ((relfile (file-relative-name - (cadar section) - (file-name-directory loaddefs-file))) - (head (concat "\n\f\n;;; Generated autoloads from " - relfile "\n\n"))) - (when (file-exists-p loaddefs-file) - ;; If we're updating an old loaddefs file, then see if - ;; there's a section here for this file already. - (goto-char (point-min)) - (if (not (search-forward head nil t)) - ;; It's a new file; put the data at the end. - (progn - (goto-char (point-max)) - (search-backward "\f\n" nil t)) - ;; Delete the old version of the section. - (delete-region (match-beginning 0) - (and (search-forward "\n\f\n;;;") - (match-beginning 0))) - (forward-line -2))) - (insert head) - (dolist (def (reverse section)) - (setq def (caddr def)) - (if (stringp def) - (princ def (current-buffer)) - (loaddefs-generate--print-form def)) - (unless (bolp) - (insert "\n"))))) - ;; Only write the file if we actually made a change. - (unless (equal (buffer-hash) hash) - (write-region (point-min) (point-max) loaddefs-file nil 'silent) - (byte-compile-info - (file-relative-name loaddefs-file (car (ensure-list dir))) - t "GEN")))))))) + (if (and updating (file-exists-p loaddefs-file)) + (insert-file-contents loaddefs-file) + (insert (loaddefs-generate--rubric + loaddefs-file nil t include-package-version)) + (search-backward "\f") + (when extra-data + (insert extra-data) + (ensure-empty-lines 1))) + (setq hash (buffer-hash)) + ;; Then group by source file (and sort alphabetically). + (dolist (section (sort (seq-group-by #'cadr (cdr fdefs)) + (lambda (e1 e2) + (string< + (file-name-sans-extension + (file-name-nondirectory (car e1))) + (file-name-sans-extension + (file-name-nondirectory (car e2))))))) + (pop section) + (let* ((relfile (file-relative-name + (cadar section) + (file-name-directory loaddefs-file))) + (head (concat "\n\f\n;;; Generated autoloads from " + relfile "\n\n"))) + (when (file-exists-p loaddefs-file) + ;; If we're updating an old loaddefs file, then see if + ;; there's a section here for this file already. + (goto-char (point-min)) + (if (not (search-forward head nil t)) + ;; It's a new file; put the data at the end. + (progn + (goto-char (point-max)) + (search-backward "\f\n" nil t)) + ;; Delete the old version of the section. + (delete-region (match-beginning 0) + (and (search-forward "\n\f\n;;;") + (match-beginning 0))) + (forward-line -2))) + (insert head) + (dolist (def (reverse section)) + (setq def (caddr def)) + (if (stringp def) + (princ def (current-buffer)) + (loaddefs-generate--print-form def)) + (unless (bolp) + (insert "\n"))))) + ;; Only write the file if we actually made a change. + (unless (equal (buffer-hash) hash) + (write-region (point-min) (point-max) loaddefs-file nil 'silent) + (byte-compile-info + (file-relative-name loaddefs-file (car (ensure-list dir))) + t "GEN"))))))) (defun loaddefs-generate--print-form (def) "Print DEF in a format that makes sense for version control." commit 2bcf11d0efecd18a1be8bcf0ac1a1dadb14d971a Author: Stefan Monnier Date: Sun Apr 30 09:41:13 2023 -0400 * lisp/org/org-macs.el (org--inhibit-version-check): Fix docstring Also, add an explanation to the docstring for what the version check is about. diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index b8e026553b3..1552675f8a8 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -37,9 +37,16 @@ ;;; Org version verification. (defvar org--inhibit-version-check nil - "When non-nil, assume that Org is a part of Emacs source. + "When non-nil, skip the detection of mixed-versions situations. For internal use only. See Emacs bug #62762. -This variable is only supposed to be changed by Emacs build scripts.") +This variable is only supposed to be changed by Emacs build scripts. +When nil, Org tries to detect when Org source files were compiled with +a different version of Org (which tends to lead to incorrect `.elc' files), +or when the current Emacs session has loaded a mix of files from different +Org versions (typically the one bundled with Emacs and another one installed +from GNU ELPA), which can happen if some parts of Org were loaded before +`load-path' was changed (e.g. before the GNU-ELPA-installed Org is activated +by `package-activate-all').") (defmacro org-assert-version () "Assert compile time and runtime version match." ;; We intentionally use a more permissive `org-release' instead of commit ca43435816b7c7ceaef1a6fce967cbdbcf243ea3 Author: Eli Zaretskii Date: Sun Apr 30 16:24:05 2023 +0300 Fix redisplay of mode line after its format changes from nil * src/dispnew.c (update_window): Make sure a mode-line's row of the current glyph matrix is disabled when the mode line is not being displayed. (Bug#63186) diff --git a/src/dispnew.c b/src/dispnew.c index 87ec83acdf3..65d9cf9b4e1 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3748,6 +3748,14 @@ update_window (struct window *w, bool force_p) } } + /* If the window doesn't display its mode line, make sure the + corresponding row of the current glyph matrix is disabled, so + that if and when the mode line is displayed again, it will be + cleared and completely redrawn. */ + if (!window_wants_mode_line (w)) + SET_MATRIX_ROW_ENABLED_P (w->current_matrix, + w->current_matrix->nrows - 1, false); + /* Was display preempted? */ paused_p = row < end; commit 610a7657e0aeaaf6299de76f13a6dc6e4af7db96 Author: Michael Albinus Date: Sun Apr 30 12:11:00 2023 +0200 Fix c-ts-mode--emacs-c-range-query * lisp/progmodes/c-ts-mode.el (c-ts-mode--emacs-c-range-query): Check for (treesit-available-p). diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 0fa53e06962..1186bd5b8df 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -1025,13 +1025,14 @@ c-ts-mode--for-each-tail-body-matcher (looking-at c-ts-mode--for-each-tail-regexp)))) (defvar c-ts-mode--emacs-c-range-query - (treesit-query-compile - 'emacs-c `(((declaration - type: (macro_type_specifier - name: (identifier) @_name) - @for-each-tail) - (:match ,c-ts-mode--for-each-tail-regexp - @_name)))) + (when (treesit-available-p) + (treesit-query-compile + 'emacs-c `(((declaration + type: (macro_type_specifier + name: (identifier) @_name) + @for-each-tail) + (:match ,c-ts-mode--for-each-tail-regexp + @_name))))) "Query that finds a FOR_EACH_* macro with an unbracketed body.") (defvar-local c-ts-mode--for-each-tail-ranges nil commit 7f94558b775e36042b28d3df6460463bd112dfda Author: Eli Zaretskii Date: Sun Apr 30 11:07:36 2023 +0300 Improve documentation of warnings * doc/lispref/control.texi (Errors): * doc/lispref/os.texi (Startup Summary): * doc/lispref/display.texi (Warning Basics, Warning Variables) (Warning Options, Delayed Warnings): Improve documentation of warnings. Document the automatic delaying of warnings during startup. (Bug#63181) diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 930903d5085..e621a28acda 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -1809,6 +1809,9 @@ Errors In these cases, you would use @code{condition-case} to establish @dfn{error handlers} to recover control in case of error. + For reporting problems without terminating the execution of the +current command, consider issuing a warning instead. @xref{Warnings}. + Resist the temptation to use error handling to transfer control from one part of the program to another; use @code{catch} and @code{throw} instead. @xref{Catch and Throw}. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 8184021d998..f1b4b001889 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -752,7 +752,8 @@ Warnings @cindex warnings @dfn{Warnings} are a facility for a program to inform the user of a -possible problem, but continue running. +possible problem, but continue running (as opposed to signaling an +error, @pxref{Errors}). @menu * Warning Basics:: Warnings concepts and functions to report them. @@ -765,69 +766,74 @@ Warning Basics @subsection Warning Basics @cindex severity level - Every warning has a textual message, which explains the problem for -the user, and a @dfn{severity level} which is a symbol. Here are the -possible severity levels, in order of decreasing severity, and their -meanings: + Every warning is a textual message, which explains the problem for +the user, with the associated @dfn{severity level} which is a symbol. +Here are the supported severity levels, in order of decreasing +severity, and their meanings: @table @code @item :emergency A problem that will seriously impair Emacs operation soon -if you do not attend to it promptly. +if the user does not attend to it promptly. @item :error -A report of data or circumstances that are inherently wrong. +A report about data or circumstances that are inherently wrong. @item :warning -A report of data or circumstances that are not inherently wrong, but -raise suspicion of a possible problem. +A report about data or circumstances that are not inherently wrong, +but raise suspicion of a possible problem. @item :debug -A report of information that may be useful if you are debugging. +A report of information that may be useful if the user is currently +debugging the Lisp program which issues the warning. @end table When your program encounters invalid input data, it can either -signal a Lisp error by calling @code{error} or @code{signal} or report -a warning with severity @code{:error}. Signaling a Lisp error is the -easiest thing to do, but it means the program cannot continue -processing. If you want to take the trouble to implement a way to -continue processing despite the bad data, then reporting a warning of -severity @code{:error} is the right way to inform the user of the -problem. For instance, the Emacs Lisp byte compiler can report an -error that way and continue compiling other functions. (If the -program signals a Lisp error and then handles it with -@code{condition-case}, the user won't see the error message; it could -show the message to the user by reporting it as a warning.) - -@c FIXME: Why use "(bytecomp)" instead of "'bytecomp" or simply -@c "bytecomp" here? The parens are part of warning-type-format but -@c not part of the warning type. --xfq +signal a Lisp error by calling @code{error} or @code{signal} +(@pxref{Signaling Errors}) or report a warning with severity +@code{:error}. Signaling a Lisp error is the easiest thing to do, but +it means the signaling program cannot continue execution. If you want +to take the trouble of implementing a way to continue processing +despite the invalid data, then reporting a warning of severity +@code{:error} is the right way of informing the user of the problem. +For instance, the Emacs Lisp byte compiler can report an error that +way and continue compiling other functions. (If the program signals a +Lisp error and then handles it with @code{condition-case}, the user +won't see the error message; reporting that as a warning instead +avoids that problem.) + @cindex warning type - Each warning has a @dfn{warning type} to classify it. The type is a -list of symbols. The first symbol should be the custom group that you -use for the program's user options. For example, byte compiler -warnings use the warning type @code{(bytecomp)}. You can also -subcategorize the warnings, if you wish, by using more symbols in the -list. + In addition to severity level, each warning has a @dfn{warning type} +to classify it. The warning type is either a symbol or a list of +symbols. If it is a symbol, it should be the custom group that you +use for the program's user options; if it is a list, the first element +of the list should be that custom group. For example, byte compiler +warnings use the warning type @code{(bytecomp)}. If the warning type +is a list, the elements of the list after the first one, which should +be arbitrary symbols, represent subcategories of the warning: they +will be displayed to the user to better explain the nature of the +warning. @defun display-warning type message &optional level buffer-name -This function reports a warning, using @var{message} as the message -and @var{type} as the warning type. @var{level} should be the -severity level, with @code{:warning} being the default. +This function reports a warning, using the string @var{message} as the +warning text and @var{type} as the warning type. @var{level} should +be the severity level, and defaults to @code{:warning} if omitted or +@code{nil}. @var{buffer-name}, if non-@code{nil}, specifies the name of the buffer -for logging the warning. By default, it is @file{*Warnings*}. +for logging the warning message. By default, it is @file{*Warnings*}. @end defun @defun lwarn type level message &rest args -This function reports a warning using the value of @code{(format-message -@var{message} @var{args}...)} as the message in the @file{*Warnings*} -buffer. In other respects it is equivalent to @code{display-warning}. +This function reports a warning using the value returned by +@w{@code{(format-message @var{message} @var{args}@dots{})}} as the +message text in the @file{*Warnings*} buffer. In other respects it is +equivalent to @code{display-warning}. @end defun @defun warn message &rest args -This function reports a warning using the value of @code{(format-message -@var{message} @var{args}...)} as the message, @code{(emacs)} as the -type, and @code{:warning} as the severity level. It exists for -compatibility only; we recommend not using it, because you should -specify a specific warning type. +This function reports a warning using the value returned by +@w{@code{(format-message @var{message} @var{args}@dots{})}} as the +message text, @code{emacs} as the warning type, and @code{:warning} as +the severity level. It exists for compatibility only; we recommend +not using it, because you should specify a specific warning type. @end defun @node Warning Variables @@ -842,15 +848,16 @@ Warning Variables severity levels. Each element defines one severity level, and they are arranged in order of decreasing severity. -Each element has the form @code{(@var{level} @var{string} -@var{function})}, where @var{level} is the severity level it defines. -@var{string} specifies the textual description of this level. -@var{string} should use @samp{%s} to specify where to put the warning -type information, or it can omit the @samp{%s} so as not to include -that information. +Each element has the form @w{@code{(@var{level} @var{string} +[@var{function}])}}, where @var{level} is the severity level it +defines. @var{string} specifies the textual description of this +level. @var{string} should use @samp{%s} to specify where to put the +warning type information, or it can omit the @samp{%s} so as not to +include that information. The optional @var{function}, if non-@code{nil}, is a function to call -with no arguments, to get the user's attention. +with no arguments, to get the user's attention. A notable example is +@code{ding} (@pxref{Beeping}). Normally you should not change the value of this variable. @end defvar @@ -859,18 +866,19 @@ Warning Variables If non-@code{nil}, the value is a function to generate prefix text for warnings. Programs can bind the variable to a suitable function. @code{display-warning} calls this function with the warnings buffer -current, and the function can insert text in it. That text becomes -the beginning of the warning message. +the current buffer, and the function can insert text into it. That +text becomes the beginning of the warning message. The function is called with two arguments, the severity level and its -entry in @code{warning-levels}. It should return a list to use as the -entry (this value need not be an actual member of -@code{warning-levels}). By constructing this value, the function can -change the severity of the warning, or specify different handling for -a given severity level. - -If the variable's value is @code{nil} then there is no function -to call. +entry in @code{warning-levels}. It should return a list to use +@emph{instead} of that entry (the value need not be an actual member +of @code{warning-levels}, but it must have the same structure). By +constructing this value, the function can change the severity of the +warning, or specify different handling for a given severity level. + +If the variable's value is @code{nil}, there's no prefix text, before +the warning is displayed, starting with the @var{string} part of the +entry in @code{warning-levels} corresponding to the warning's level. @end defvar @defvar warning-series @@ -878,17 +886,18 @@ Warning Variables warning should begin a series. When several warnings form a series, that means to leave point on the first warning of the series, rather than keep moving it for each warning so that it appears on the last one. -The series ends when the local binding is unbound and +The series ends when the local binding of this variable is unbound and @code{warning-series} becomes @code{nil} again. The value can also be a symbol with a function definition. That is equivalent to @code{t}, except that the next warning will also call -the function with no arguments with the warnings buffer current. The -function can insert text which will serve as a header for the series -of warnings. +the function with no arguments with the warnings buffer the current +buffer. The function can, for example, insert text which will serve +as a header for the series of warnings. -Once a series has begun, the value is a marker which points to the -buffer position in the warnings buffer of the start of the series. +Once a series has begun, the value of this variable is a marker which +points to the buffer position in the warnings buffer of the start of +the series. The variable's normal value is @code{nil}, which means to handle each warning separately. @@ -896,7 +905,7 @@ Warning Variables @defvar warning-fill-prefix When this variable is non-@code{nil}, it specifies a fill prefix to -use for filling each warning's text. +use for filling the text of each warning. @end defvar @defvar warning-fill-column @@ -905,11 +914,11 @@ Warning Variables @defvar warning-type-format This variable specifies the format for displaying the warning type -in the warning message. The result of formatting the type this way +in the warning text. The result of formatting the type this way gets included in the message under the control of the string in the entry in @code{warning-levels}. The default value is @code{" (%s)"}. -If you bind it to @code{""} then the warning type won't appear at -all. +If you bind it to the empty string @code{""} then the warning type +won't appear at all. @end defvar @node Warning Options @@ -921,38 +930,71 @@ Warning Options @defopt warning-minimum-level This user option specifies the minimum severity level that should be -shown immediately to the user. The default is @code{:warning}, which -means to immediately display all warnings except @code{:debug} -warnings. +shown immediately to the user, by popping the warnings buffer in some +window. The default is @code{:warning}, which means to show the +warning buffer for any warning severity except @code{:debug}. The +warnings of lower severity levels will still be written into the +warnings buffer, but the buffer will not be forced onto display. @end defopt @defopt warning-minimum-log-level This user option specifies the minimum severity level that should be -logged in the warnings buffer. The default is @code{:warning}, which -means to log all warnings except @code{:debug} warnings. +logged in the warnings buffer. Warnings of lower severity will be +completely ignored: not written to the warnings buffer and not +displayed. The default is @code{:warning}, which means to log +warnings of any severity except @code{:debug}. @end defopt @defopt warning-suppress-types This list specifies which warning types should not be displayed -immediately for the user. Each element of the list should be a list -of symbols. If its elements match the first elements in a warning -type, then that warning is not displayed immediately. +immediately when they occur. Each element of the list should be a +list of symbols. If an element of this list has the same elements as +the first elements in a warning type, then the warning of that type +will not be shown on display by popping the warnings buffer in some +window (the warning will still be logged in the warnings buffer). + +For example, if the value of this variable is a list like this: + +@lisp +((foo) (bar subtype)) +@end lisp + +@noindent +then warnings whose types are @code{foo} or @code{(foo)} or +@w{@code{(foo something)}} or @w{@code{(bar subtype other)}} will not +be shown to the user. @end defopt @defopt warning-suppress-log-types -This list specifies which warning types should not be logged in the -warnings buffer. Each element of the list should be a list of -symbols. If it matches the first few elements in a warning type, then -that warning is not logged. +This list specifies which warning types should be ignored: not logged +in the warnings buffer and not shown to the user. The structure and +the matching of warning types are the same as for +@code{warning-suppress-types} above. @end defopt +@cindex warnings, suppressing during startup +@cindex prevent warnings in init files + During startup, Emacs delays showing any warnings until after it +loads and processes the site-wide and user's init files +(@pxref{Startup Summary}). Let-binding (@pxref{Local Variables}) the +values of these options around some code in your init files which +might emit a warning will therefore not work, because it will not be +in effect by the time the warning is actually processed. Thus, if you +want to suppress some warnings during startup, change the values of +the above options in your init file early enough, or put those +let-binding forms in your @code{after-init-hook} or +@code{emacs-startup-hook} functions. @xref{Init File}. + @node Delayed Warnings @subsection Delayed Warnings @cindex delayed warnings +@cindex warnings, delayed Sometimes, you may wish to avoid showing a warning while a command is running, and only show it only after the end of the command. You can -use the function @code{delay-warning} for this. +use the function @code{delay-warning} for this. Emacs automatically +delays any warnings emitted during the early stages of startup, and +shows them only after the init files are processed. @defun delay-warning type message &optional level buffer-name This function is the delayed counterpart to @code{display-warning} @@ -973,7 +1015,7 @@ Delayed Warnings @code{display-warning}. Immediately after running @code{post-command-hook} (@pxref{Command Overview}), the Emacs command loop displays all the warnings specified by this variable, -then resets it to @code{nil}. +then resets the variable to @code{nil}. @end defvar Programs which need to further customize the delayed warnings @@ -982,7 +1024,9 @@ Delayed Warnings @defvar delayed-warnings-hook This is a normal hook which is run by the Emacs command loop, after @code{post-command-hook}, in order to process and display delayed -warnings. +warnings. Emacs also runs this hook during startup, after loading the +site-start and user init files (@pxref{Startup Summary}), because +warnings emitted before that are automatically delayed. Its default value is a list of two functions: diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 3be7036f637..7c8b35236cd 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -182,7 +182,9 @@ Startup Summary measurement of how long it took. @item -It runs the normal hook @code{after-init-hook}. +It runs the normal hooks @code{after-init-hook} and +@code{delayed-warnings-hook}. The latter shows any warnings emitted +during previous stages of startup, which are automatically delayed. @item If the buffer @file{*scratch*} exists and is still in Fundamental mode commit 5a3f0e2c558d783caad6b356310217866e9cd47e Author: Eli Zaretskii Date: Sun Apr 30 08:21:38 2023 +0300 ; Doc fix in c-ts-mode.el * lisp/progmodes/c-ts-mode.el (c-ts-mode--fontify-for-each-tail): Doc fix. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 761a87c5a78..0fa53e06962 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -801,7 +801,7 @@ c-ts-mode--fontify-DEFUN 'default override start end)))))) (defun c-ts-mode--fontify-for-each-tail (node override start end &rest _) - "Fontify FOR_EACH_TAIL variants in Emacs sources. + "Fontify FOR_EACH_* macro variants in Emacs sources. For NODE, OVERRIDE, START, and END, see `treesit-font-lock-rules'. The captured NODE is a function_definition node." commit 21361d0563524f25805de4705ab6a0fe16ea3d44 Author: Yuan Fu Date: Sat Apr 29 15:39:54 2023 -0700 Fix FOR_EACH_TAIL fontification (bug#62951) Fix the fontification inconsistency between different FOR_EACH_TAIL's. See the comment for more explanation. Also enable the emacs-devel feature automatically when c-ts-mode-emacs-sources-support is on. * lisp/progmodes/c-ts-mode.el: (c-ts-mode--for-each-tail-regexp): Move up. (c-ts-mode--font-lock-settings): New font-lock rule for FOR_EACH_TAIL. (c-ts-mode--fontify-for-each-tail): New function. (c-ts-mode): Automatically enable emacs-devel feature. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 113f3b6ee84..761a87c5a78 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -536,6 +536,11 @@ c-ts-mode--operators "+=" "*=" "/=" "%=" "|=" "&=" "^=" ">>=" "<<=" "--" "++") "C/C++ operators for tree-sitter font-locking.") +(defvar c-ts-mode--for-each-tail-regexp + (rx "FOR_EACH_" (or "TAIL" "TAIL_SAFE" "ALIST_VALUE" + "LIVE_BUFFER" "FRAME")) + "A regexp matching all the variants of the FOR_EACH_* macro.") + (defun c-ts-mode--font-lock-settings (mode) "Tree-sitter font-lock settings. MODE is either `c' or `cpp'." @@ -686,10 +691,14 @@ c-ts-mode--font-lock-settings :language mode :feature 'emacs-devel :override t - '(((call_expression + `(((call_expression (call_expression function: (identifier) @fn) @c-ts-mode--fontify-DEFUN) - (:match "^DEFUN$" @fn))))) + (:match "^DEFUN$" @fn)) + + ((function_definition type: (_) @for-each-tail) + @c-ts-mode--fontify-for-each-tail + (:match ,c-ts-mode--for-each-tail-regexp @for-each-tail))))) ;;; Font-lock helpers @@ -791,6 +800,20 @@ c-ts-mode--fontify-DEFUN (treesit-node-start arg) (treesit-node-end arg) 'default override start end)))))) +(defun c-ts-mode--fontify-for-each-tail (node override start end &rest _) + "Fontify FOR_EACH_TAIL variants in Emacs sources. +For NODE, OVERRIDE, START, and END, see +`treesit-font-lock-rules'. The captured NODE is a +function_definition node." + (let ((for-each-tail (treesit-node-child-by-field-name node "type")) + (args (treesit-node-child-by-field-name node "declarator"))) + (treesit-fontify-with-override + (treesit-node-start for-each-tail) (treesit-node-end for-each-tail) + 'default override start end) + (treesit-fontify-with-override + (1+ (treesit-node-start args)) (1- (treesit-node-end args)) + 'default override start end))) + (defun c-ts-mode--fontify-error (node override start end &rest _) "Fontify the error nodes. For NODE, OVERRIDE, START, and END, see @@ -984,11 +1007,12 @@ c-ts-mode--emacs-current-defun-name ;; skips those FOR_EACH_*'s. Note that we only ignore FOR_EACH_*'s ;; with a unbracketed body. Those with a bracketed body parse more ;; or less fine. - -(defvar c-ts-mode--for-each-tail-regexp - (rx "FOR_EACH_" (or "TAIL" "TAIL_SAFE" "ALIST_VALUE" - "LIVE_BUFFER" "FRAME")) - "A regexp matching all the variants of the FOR_EACH_* macro.") +;; +;; In the meantime, we have a special fontification rule for +;; FOR_EACH_* macros with a bracketed body that removes any applied +;; fontification (which are wrong anyway), to keep them consistent +;; with the skipped FOR_EACH_* macros (which have no fontification). +;; The rule is in 'emacs-devel' feature. (defun c-ts-mode--for-each-tail-body-matcher (_n _p bol &rest _) "A matcher that matches the first line after a FOR_EACH_* macro. @@ -1187,7 +1211,8 @@ c-ts-mode (treesit-range-rules 'c-ts-mode--emacs-set-ranges)) (setq-local treesit-language-at-point-function - (lambda (_pos) 'c))))) + (lambda (_pos) 'c)) + (treesit-font-lock-recompute-features '(emacs-devel))))) ;;;###autoload (define-derived-mode c++-ts-mode c-ts-base-mode "C++" commit d0df3404fdea7134194a684c7d30479181f3ec49 Author: Theodor Thornhill Date: Sat Apr 29 19:59:49 2023 +0200 ; * etc/EGLOT-NEWS: chsharp-le -> csharp-ls diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index e94dbf8bc89..d2d84c5ff9e 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -86,7 +86,7 @@ systems (bug#58790). These modes are usually handled by the same server that handles the "classical mode". -** New servers chsharp-ls and texlab added to 'eglot-server-programs'. +** New servers csharp-ls and texlab added to 'eglot-server-programs'. ** Assorted bugfixes. (bug#59824, bug#59338) commit c229e83c3ceec9ef5715b2cf15e3d23f58982b43 Author: Theodor Thornhill Date: Sat Apr 29 19:54:09 2023 +0200 ; * etc/EGLOT-NEWS (https): Elglot -> Eglot. diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index d10412afd33..e94dbf8bc89 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -40,7 +40,7 @@ The position-encoding scheme (UTF-8, UTF-16 or UTF-32) can now be negotiated with the server. ** More of the user's Eldoc configuration is respected. -This change addresses the problems reported in many Elglot reports +This change addresses the problems reported in many Eglot reports dating back to early 2021 at least. (github#646, github#894, github#920, github#1031, github#1171). commit b4f2f499783386ed1290393790065b96273ae884 Author: Eli Zaretskii Date: Sat Apr 29 09:39:15 2023 +0300 Fix documentation of libxml-parse-* functions * doc/lispref/text.texi (Parsing HTML/XML): * src/xml.c (Flibxml_parse_html_region, Flibxml_parse_xml_region): Update the documentation regarding the use of BASE-URL argument. (Bug#63125) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 4c13185b0dd..f15b3c33e0c 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -5510,7 +5510,7 @@ Parsing HTML/XML @section Parsing HTML and XML @cindex parsing html - Emacs can be compiled with built-in libxml2 support. + Emacs can be compiled with built-in @file{libxml2} support. @defun libxml-available-p This function returns non-@code{nil} if built-in libxml2 support is @@ -5529,8 +5529,10 @@ Parsing HTML/XML If @var{start} or @var{end} are @code{nil}, they default to the values from @code{point-min} and @code{point-max}, respectively. -The optional argument @var{base-url}, if non-@code{nil}, should be a -string specifying the base URL for relative URLs occurring in links. +The optional argument @var{base-url}, if non-@code{nil}, should be +used for warnings and errors reported by the @file{libxml2} library, +but Emacs currently calls the library with errors and warnings +disabled, so this argument is not used. If the optional argument @var{discard-comments} is non-@code{nil}, any top-level comment is discarded. (This argument is obsolete and diff --git a/src/xml.c b/src/xml.c index b55ac62cdd3..b4c849e6a65 100644 --- a/src/xml.c +++ b/src/xml.c @@ -280,7 +280,10 @@ DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region, If START is nil, it defaults to `point-min'. If END is nil, it defaults to `point-max'. -If BASE-URL is non-nil, it is used to expand relative URLs. +If BASE-URL is non-nil, it is used if and when reporting errors and +warnings from the underlying libxml2 library. Currently, errors and +warnings from the library are suppressed, so this argument is largely +ignored. If you want comments to be stripped, use the `xml-remove-comments' function to strip comments before calling this function. */) @@ -298,7 +301,10 @@ DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region, If START is nil, it defaults to `point-min'. If END is nil, it defaults to `point-max'. -If BASE-URL is non-nil, it is used to expand relative URLs. +If BASE-URL is non-nil, it is used if and when reporting errors and +warnings from the underlying libxml2 library. Currently, errors and +warnings from the library are suppressed, so this argument is largely +ignored. If you want comments to be stripped, use the `xml-remove-comments' function to strip comments before calling this function. */) commit 5dd784961d19a4575dfb60bcdba55bbfddcc9ba9 Author: Eli Zaretskii Date: Fri Apr 28 21:14:32 2023 +0300 ; * src/treesit.c (syms_of_treesit): Fix error messages. diff --git a/src/treesit.c b/src/treesit.c index a2d32770ed8..705ef6af39f 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -3552,9 +3552,9 @@ syms_of_treesit (void) define_error (Qtreesit_parse_error, "Parse failed", Qtreesit_error); define_error (Qtreesit_range_invalid, - "RANGES are invalid, they have to be ordered and not overlapping", + "RANGES are invalid: they have to be ordered and should not overlap", Qtreesit_error); - define_error (Qtreesit_buffer_too_large, "Buffer too large (> 4GB)", + define_error (Qtreesit_buffer_too_large, "Buffer too large (> 4GiB)", Qtreesit_error); define_error (Qtreesit_load_language_error, "Cannot load language definition", commit ddfa0d8da9aafc926bd403c29a2cebfea571ebde Author: Dmitry Gutov Date: Fri Apr 28 19:28:25 2023 +0300 ; Remove some leftover text diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 9cc3f8724af..0919ce34448 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2311,10 +2311,7 @@ package-upgrade-all Currently, packages which are part of the Emacs distribution are not upgraded by this command. To enable upgrading such a package using this command, first upgrade the package to a newer version -from ELPA by using `\\\\[package-menu-mark-install]' after `\\[list-packages]'. - - Use `i' after `M-x list-packages' to -upgrade to an ELPA version first." +from ELPA by using `\\\\[package-menu-mark-install]' after `\\[list-packages]'." (interactive (list (not noninteractive))) (package-refresh-contents) (let ((upgradeable (package--upgradeable-packages)))