[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/android 11cb9cc5988 2/2: Merge remote-tracking branch 'origin/ma
|
From: |
Po Lu |
|
Subject: |
feature/android 11cb9cc5988 2/2: Merge remote-tracking branch 'origin/master' into feature/android |
|
Date: |
Sat, 6 May 2023 08:36:33 -0400 (EDT) |
branch: feature/android
commit 11cb9cc598811ed36ba8aa2e5dafddeecaf95971
Merge: c7ca46b0a7c 9b66a64d9c2
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/android
---
doc/lispref/modes.texi | 2 +-
doc/lispref/numbers.texi | 39 +-
doc/lispref/processes.texi | 8 +-
doc/misc/eglot.texi | 4 +-
doc/misc/message.texi | 19 +-
etc/EGLOT-NEWS | 10 +
etc/ERC-NEWS | 63 +++-
lisp/calc/calc-misc.el | 1 -
lisp/calc/calc-prog.el | 1 -
lisp/calculator.el | 5 +-
lisp/calendar/parse-time.el | 16 +-
lisp/emacs-lisp/backtrace.el | 1 -
lisp/emacs-lisp/cl-preloaded.el | 1 +
lisp/emacs-lisp/loaddefs-gen.el | 7 +-
lisp/emacs-lisp/package-vc.el | 17 +-
lisp/emacs-lisp/package.el | 52 +--
lisp/erc/erc-backend.el | 88 ++++-
lisp/erc/erc-button.el | 332 ++++++++++-------
lisp/erc/erc-common.el | 88 +++--
lisp/erc/erc-fill.el | 22 +-
lisp/erc/erc-goodies.el | 5 +-
lisp/erc/erc-match.el | 2 +
lisp/erc/erc-ring.el | 4 +-
lisp/erc/erc-stamp.el | 10 +-
lisp/erc/erc.el | 400 +++++++++++++++------
lisp/filesets.el | 1 -
lisp/gnus/message.el | 38 +-
lisp/net/dictionary.el | 3 -
lisp/net/ntlm.el | 1 -
lisp/net/rcirc.el | 14 +-
lisp/net/socks.el | 1 -
lisp/nxml/rng-nxml.el | 2 +-
lisp/progmodes/dcl-mode.el | 2 +-
lisp/progmodes/ebrowse.el | 6 +-
lisp/progmodes/eglot.el | 5 +-
lisp/progmodes/go-ts-mode.el | 13 +-
lisp/progmodes/gud.el | 2 +-
lisp/progmodes/vhdl-mode.el | 9 +-
lisp/select.el | 31 +-
lisp/speedbar.el | 4 +-
lisp/subr.el | 4 +-
lisp/transient.el | 3 +-
lisp/treesit.el | 1 -
lisp/woman.el | 1 -
src/sysdep.c | 7 +
test/lisp/calendar/cal-julian-tests.el | 2 +-
test/lisp/erc/erc-button-tests.el | 283 +++++++++++++++
test/lisp/erc/erc-fill-tests.el | 2 +
test/lisp/erc/erc-scenarios-base-attach.el | 191 ++++++++++
test/lisp/erc/erc-scenarios-base-buffer-display.el | 235 ++++++++++++
test/lisp/erc/erc-scenarios-base-reconnect.el | 89 -----
test/lisp/erc/erc-scenarios-base-split-line.el | 202 +++++++++++
test/lisp/erc/erc-tests.el | 248 ++++++++-----
.../base/channel-buffer-revival/reattach.eld | 56 +++
test/lisp/erc/resources/base/flood/ascii.eld | 49 +++
test/lisp/erc/resources/base/flood/koi8-r.eld | 47 +++
test/lisp/erc/resources/base/flood/utf-8.eld | 54 +++
test/lisp/erc/resources/erc-d/erc-d-tests.el | 2 +-
test/lisp/erc/resources/erc-d/erc-d.el | 9 +-
59 files changed, 2196 insertions(+), 618 deletions(-)
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index fd497d14f63..f1d0c41dfe4 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -4155,7 +4155,7 @@ Other keywords are optional:
@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
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 @@ creates huge integers.
@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 @@ two NaNs as equal when their
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 @@ by rounding the quotient towards zero after each division.
@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
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index aa71e3ee131..7cbe87240c9 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -1773,7 +1773,9 @@ caught automatically, so that it doesn't stop the
execution of whatever
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.
@@ -2177,7 +2179,9 @@ automatically, so that it doesn't stop the execution of
whatever
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.
diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi
index 542a4259d66..962e6c914ce 100644
--- a/doc/misc/eglot.texi
+++ b/doc/misc/eglot.texi
@@ -1307,8 +1307,8 @@ Eglot, use @kbd{M-x package-install}.
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
-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/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 @@ requires the @acronym{POP}-before-@acronym{SMTP}
authentication.
@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 @@ This is the same as the above, but uses
@samp{other-user} as the user
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/etc/EGLOT-NEWS b/etc/EGLOT-NEWS
index 7a1aaffaea3..37ee94f1730 100644
--- a/etc/EGLOT-NEWS
+++ b/etc/EGLOT-NEWS
@@ -97,6 +97,16 @@ been added to 'eglot-stay-out-of'.
** ELPA installations on Emacs 26.3 are supported again.
+* 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.
+
+
* Changes in Eglot 1.12 (13/03/2023)
** LSP inlay hints are now supported.
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 8f1b89f268b..f2a8eb72b95 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -37,17 +37,26 @@ 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. 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.
+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
+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,13 +117,21 @@ 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
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.
@@ -170,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
@@ -183,10 +206,14 @@ 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', and the bracketed "<URL:...>"
+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.
* Changes in ERC 5.5
@@ -332,8 +359,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/calc/calc-misc.el b/lisp/calc/calc-misc.el
index 93de04a586d..4b1aab837af 100644
--- a/lisp/calc/calc-misc.el
+++ b/lisp/calc/calc-misc.el
@@ -195,7 +195,6 @@ Calc user interface as before (either \\`C-x * C' or \\`C-x
* K'; initially \\`C
;;;###autoload
(defun calc-info-goto-node (node)
"Go to a node in the Calculator info documentation."
- (interactive)
(select-window (get-largest-window))
(info (concat "(Calc)" node)))
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index d8569d0c5af..8502b5196d2 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -936,7 +936,6 @@
(defun calc-edit-macro-finish-edit (cmdname key)
"Finish editing a Calc macro.
Redefine the corresponding command."
- (interactive)
(let ((cmd (intern cmdname)))
(calc-edit-macro-pre-finish-edit)
(let* ((str (buffer-substring calc-edit-top (point-max)))
diff --git a/lisp/calculator.el b/lisp/calculator.el
index 6a1d960c3e4..bf2ac9b6215 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -1349,8 +1349,9 @@ Optional string argument KEYS will force using it as the
keys entered."
(calculator-update-display t))
(defun calculator-saved-move (n)
- "Go N elements up the list of saved values."
- (interactive)
+ "Go N elements up the list of saved values.
+Interactively, N is the prefix numeric argument and defaults to 1."
+ (interactive "p")
(when (and calculator-saved-list
(or (null calculator-stack) calculator-display-fragile))
(setq calculator-saved-ptr
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 @@ letters, digits, plus or minus signs or colons."
;;;###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 @@ somewhat liberal in what format it accepts, and will
attempt to
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 @@ unknown DST value is returned as -1."
(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/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index 53e17693933..57912c854b0 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/lisp/emacs-lisp/backtrace.el
@@ -499,7 +499,6 @@ Reprint the frame with the new view plist."
(defun backtrace-expand-ellipsis (button)
"Expand display of the elided form at BUTTON."
- (interactive)
(goto-char (button-start button))
(unless (get-text-property (point) 'cl-print-ellipsis)
(if (and (> (point) (point-min))
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 @@ supertypes from the most specific to least specific.")
(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
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 @@ instead of just updating them with the new/changed
autoloads."
(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)
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index 83d697a2e90..421947b528d 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -167,7 +167,7 @@ archive."
(: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'.")
@@ -199,15 +199,15 @@ name for PKG-DESC."
(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)
@@ -224,7 +224,7 @@ This function is meant to be used as a hook for
`package-read-archive-hook'."
(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))
@@ -235,7 +235,7 @@ This function is meant to be used as a hook for
`package-read-archive-hook'."
(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."
@@ -583,7 +583,7 @@ Emacs Lisp files.")
(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)
@@ -632,7 +632,8 @@ abort installation?" name))
(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)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 0f68f0e8041..2892728ebd9 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2263,25 +2263,26 @@ had been enabled."
;;;###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-mode-map>\\[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)
- (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 @@ newer version from ELPA by using
`\\<package-menu-mode-map>\\[package-menu-mark-
(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 @@ interactively, QUERY is always true.
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-mode-map>\\[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-mode-map>\\[package-menu-mark-install]' after
`\\[list-packages]'."
(interactive (list (not noninteractive)))
(package-refresh-contents)
(let ((upgradeable (package--upgradeable-packages)))
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index bdf4e2ddca2..2de24e7cb25 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -102,11 +102,12 @@
(require 'erc-common)
(defvar erc--target)
-(defvar erc-auto-query)
+(defvar erc--user-from-nick-function)
(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 +124,8 @@
(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)
@@ -297,6 +300,12 @@ function `erc-server-process-alive' instead.")
(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.")
@@ -564,6 +573,47 @@ If this is set to nil, never try to reconnect."
;;;; 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.
@@ -901,6 +951,22 @@ EVENT is the message received from the closed connection
process."
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
@@ -1435,8 +1501,6 @@ Finds hooks by looking in the `erc-server-responses' hash
table."
(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)
@@ -1831,11 +1895,16 @@ add things to `%s' instead."
(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))
@@ -1844,7 +1913,8 @@ add things to `%s' instead."
;; 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 33e69f3b0b8..4307dc3b860 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -55,11 +55,11 @@
((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 "<backtab>" #'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 "<backtab>" #'erc-button-previous)))
;;; Variables
@@ -128,7 +128,6 @@ longer than `erc-fill-column'."
;; 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)
- ("<URL: *\\([^<> ]+\\) *>" 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 @@ REGEXP is the string matching text around the button or a
symbol
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,28 +284,54 @@ specified by `erc-button-alist'."
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.
- (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
@@ -318,67 +340,66 @@ specified by `erc-button-alist'."
;; 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))
- (_ 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 <bob>, 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 \"<bob>\", 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))
@@ -402,32 +423,46 @@ early (outer), args-filtering advice wrapping
(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))
- (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."
(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.
@@ -529,6 +564,7 @@ call it with the value of the `erc-data' text property."
(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 +582,73 @@ For use on `completion-at-point-functions'."
(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."
@@ -635,15 +717,15 @@ and `apropos' for other symbols."
(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
@@ -680,7 +762,7 @@ non-strings, concatenate leading string members before
applying
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/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 6c015c71ff9..86d78768374 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -30,8 +30,11 @@
(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)
@@ -40,15 +43,22 @@
(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))
(cl-defstruct erc-input
- string insertp sendp)
+ string insertp sendp refoldp)
-(cl-defstruct (erc--input-split (:include erc-input))
- lines cmdp)
+(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
@@ -195,16 +205,6 @@ instead of a `set' state, which precludes any actual
saving."
(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 +230,42 @@ Do so by always returning its standard value, namely nil."
(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 +281,12 @@ Do so by always returning its standard value, namely nil."
(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 +333,7 @@ if ARG is omitted or nil.
\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 +394,13 @@ If no server buffer exists, return nil."
(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/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 7b6495f9f3f..bf995a5a5e6 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -221,8 +221,13 @@ messages less than a day apart."
(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'."
@@ -295,7 +300,9 @@ of the minor-mode toggles as usual."
(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))
@@ -323,6 +330,8 @@ of the minor-mode toggles as usual."
(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))
@@ -389,6 +398,9 @@ See `erc-fill-wrap-mode' for details."
(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)
@@ -406,6 +418,10 @@ See `erc-fill-wrap-mode' for details."
`((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-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 @@ does not appear in the ERC buffer after the user presses
ENTER.")
"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-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 @@ See `erc-log-match-format'."
(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-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 @@
(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-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 @@ may not be unique, `equal'-wise."
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))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 284990e2d43..dbf413bac74 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -98,7 +98,9 @@
: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
@@ -352,7 +354,7 @@ simply because we do not necessarily receive the QUIT
event."
: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
@@ -907,6 +909,9 @@ Flooding is sending too much information to the server in
too
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
@@ -1089,33 +1094,40 @@ The struct has three slots:
`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)
- "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.
@@ -1157,8 +1169,8 @@ preserve point if needed."
(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.
@@ -1229,7 +1241,7 @@ which the local user typed."
(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.
@@ -1507,9 +1519,9 @@ Defaults to the server buffer."
"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 +1530,9 @@ The available choices are:
`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 +1542,17 @@ The available choices are:
(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,21 +1560,27 @@ possible values."
(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)
(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'."
@@ -2044,6 +2068,9 @@ to display-buffer machinery."
(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 +2278,8 @@ Returns the buffer for the given server or channel."
;; 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 +3085,10 @@ present."
(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 +3142,9 @@ this function from interpreting the line as a command."
(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))
+ (erc--server-last-reconnect-display-reset (erc-server-buffer))
(condition-case nil
(if (listp args)
(apply cmd args)
@@ -3583,7 +3617,21 @@ were most recently invited. See also `invitation'."
((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)
+ (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 +3995,10 @@ just as you provided it. Use this command with care!"
(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 ;-)"
@@ -3978,8 +4009,8 @@ on the value of `erc-query-display'."
(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))))
@@ -4654,6 +4685,19 @@ This places `point' just after the prompt, or at the
beginning of the line."
(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))
@@ -4668,9 +4712,13 @@ This places `point' just after the prompt, or at the
beginning of the line."
; 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)
@@ -4678,6 +4726,7 @@ This places `point' just after the prompt, or at the
beginning of the line."
"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
@@ -4700,7 +4749,7 @@ See `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)
@@ -4722,23 +4771,30 @@ See `erc-default-server-hook'."
"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 +4802,37 @@ a new window, but not to select it. See the
documentation for
(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)
@@ -4865,6 +4943,9 @@ See also `erc-display-error-notice'."
;;; 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.
@@ -4912,6 +4993,16 @@ and as second argument the event parsed as a vector."
(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 "*" "<") "-"))
@@ -5161,6 +5252,12 @@ Set user modes and run `erc-after-connect' hook."
(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)
@@ -6005,6 +6102,9 @@ submitted line to be intentional."
(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
@@ -6022,16 +6122,18 @@ is empty or consists of one or more spaces, tabs, or
form-feeds."
(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))))))
@@ -6054,16 +6156,34 @@ is empty or consists of one or more spaces, tabs, or
form-feeds."
(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
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."
@@ -6078,12 +6198,15 @@ When the returned value is a string, pass it to
`erc-error'.")
(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
@@ -6091,7 +6214,7 @@ When the returned value is a string, pass it to
`erc-error'.")
;; 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
@@ -6113,19 +6236,69 @@ When the returned value is a string, pass it to
`erc-error'.")
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--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--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.
@@ -6157,23 +6330,22 @@ Return non-nil only if we actually send anything."
: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/lisp/filesets.el b/lisp/filesets.el
index 1b7e6ffa81f..81a194a45e6 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -1807,7 +1807,6 @@ If no fileset name is provided, prompt for NAME."
(defun filesets-convert-patterns (name)
"Change fileset NAME's mode from :pattern to :files."
- (interactive)
(let ((entry (assoc name filesets-data)))
(if entry
(let ((pattern (filesets-entry-get-pattern entry))
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 @@ Each line should be no more than 79 characters long."
"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."
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index d9973b831ba..ba65225692a 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -683,7 +683,6 @@ previous state."
"Save the current state and start a new search based on ARGS.
The parameter ARGS is a cons cell where car is the word to search
and cdr is the dictionary where to search the word in."
- (interactive)
(dictionary-store-positions)
(let ((word (car args))
(dictionary (cdr args)))
@@ -1258,7 +1257,6 @@ allows editing it."
:version "28.1")
(defun dictionary-definition (word &optional dictionary)
- (interactive)
(unwind-protect
(let ((dictionary (or dictionary dictionary-default-dictionary)))
(dictionary-do-search word dictionary 'dictionary-read-definition t))
@@ -1315,7 +1313,6 @@ tooltip mode. The hook function will check the value of
the
variable `dictionary-tooltip-mode' to decide if some action must be
taken. When disabling the tooltip mode the value of this variable
will be set to nil."
- (interactive)
(tooltip-mode on)
(if on
(add-hook 'tooltip-functions #'dictionary-display-tooltip)
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index 356bf95669f..c92c90bf694 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -98,7 +98,6 @@ USER is a string representing a user name to be authenticated
and
DOMAIN is a NT domain. USER can include a NT domain part as in
user@domain where the string after @ is used as the domain if DOMAIN
is not given."
- (interactive)
(let ((request-ident (concat "NTLMSSP" (make-string 1 0)))
(request-msgType (concat (make-string 1 1) (make-string 3 0)))
;0x01 0x00 0x00 0x00
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 5e4aa5e1198..0ee52d8ef6c 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -584,7 +584,7 @@ If ARG is non-nil, instead prompt for connection
parameters."
(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 @@ See `rcirc-connect' for more details on these variables.")
;;;###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
@@ -1233,9 +1233,9 @@ If SILENT is non-nil, do not print the message in any irc
buffer."
(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 @@ connection."
(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 @@ The message is logged in `rcirc-log', and is later
written to
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)
@@ -2998,7 +2998,7 @@ If ARG is given, opens the URL in a new browser window."
"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))))
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index adf8b357dc3..968a28d2be8 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -328,7 +328,6 @@
(advice-add 'open-network-stream :around #'socks--open-network-stream))
(defun socks-open-connection (server-info)
- (interactive)
(save-excursion
(let ((proc
(let ((socks-override-functions nil))
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 @@ Validation will be enabled if `rng-nxml-auto-validate-flag'
is non-nil."
(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
diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el
index 0bb1a01f902..cf589762e8f 100644
--- a/lisp/progmodes/dcl-mode.el
+++ b/lisp/progmodes/dcl-mode.el
@@ -1396,7 +1396,7 @@ regexps in `dcl-electric-reindent-regexps'."
;;;-------------------------------------------------------------------------
(defun dcl-indent-to (col &optional minimum)
"Like `indent-to', but only indents if indentation would change."
- (interactive)
+ (interactive "NIndent to column: ")
(let (cur-indent collapsed indent)
(save-excursion
(skip-chars-forward " \t")
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index 4563b83389f..5ca2f09b141 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -1130,7 +1130,7 @@ If given a numeric N-TIMES argument, mark that many
classes."
(defun ebrowse-redraw-marks (start end)
"Display class marker signs in the tree between START and END."
- (interactive)
+ (interactive "r")
(save-excursion
(with-silent-modifications
(catch 'end
@@ -1494,9 +1494,9 @@ and possibly kill the viewed buffer."
(defun ebrowse-view-file-other-frame (file)
- "View a file FILE in another frame.
+ "View FILE in another frame.
The new frame is deleted when you quit viewing the file in that frame."
- (interactive)
+ (interactive "fIn other frame view file: ")
(let ((old-frame-configuration (current-frame-configuration))
(had-a-buf (get-file-buffer file))
(buf-to-view (find-file-noselect file)))
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 1e0bcd30485..dc8d4674425 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -2003,7 +2003,7 @@ If it is activated, also signal textDocument/didOpen."
(interactive) (info "(eglot)"))
;;;###autoload
-(defun eglot-update (&rest _) "Update Eglot."
+(defun eglot-upgrade-eglot (&rest _) "Update Eglot to latest version."
(interactive)
(with-no-warnings
(require 'package)
@@ -2012,6 +2012,9 @@ If it is activated, also signal textDocument/didOpen."
(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.
diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el
index fda6a36e42d..b8705ecc4d0 100644
--- a/lisp/progmodes/go-ts-mode.el
+++ b/lisp/progmodes/go-ts-mode.el
@@ -106,6 +106,11 @@
">>" "%=" ">>=" "--" "!" "..." "&^" "&^=" "~")
"Go operators for tree-sitter font-locking.")
+(defun go-ts-mode--iota-query-supported-p ()
+ "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)))
+
(defvar go-ts-mode--font-lock-settings
(treesit-font-lock-rules
:language 'go
@@ -118,7 +123,9 @@
: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)))
@@ -296,7 +303,7 @@ Methods are prefixed with the receiver name, unless
SKIP-PREFIX is t."
(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))
@@ -351,7 +358,7 @@ comment already exists, jump to it."
"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
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index d5c8e37a37b..2b178e50684 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -3150,7 +3150,7 @@ Obeying it means displaying in another window the
specified file and line."
(defun gud-basic-call (command)
"Invoke the debugger COMMAND displaying source in other window."
- (interactive)
+ (interactive "sInvoke debugger command: ")
(gud-set-buffer)
(let ((proc (get-buffer-process gud-comint-buffer)))
(or proc (error "Current buffer has no process"))
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 @@ Overrides local variable `indent-tabs-mode'."
;; 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 @@ Overrides local variable `indent-tabs-mode'."
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:
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 @@ This function returns the string \"emacs\"."
(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)
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index a48a371d33a..f56c3915521 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -3550,9 +3550,7 @@ This variable is ignored if `speedbar-use-imenu-flag' is
t."
"Toggle FLAG in `speedbar-fetch-etags-arguments'.
FLAG then becomes a member of etags command line arguments. If flag
is \"sort\", then toggle the value of `speedbar-sort-tags'. If its
-value is \"show\" then toggle the value of
-`speedbar-show-unknown-files'."
- (interactive)
+value is \"show\" then toggle the value of `speedbar-show-unknown-files'."
(cond
((equal flag "sort")
(setq speedbar-sort-tags (not speedbar-sort-tags)))
diff --git a/lisp/subr.el b/lisp/subr.el
index 71fb1497e3b..66674786330 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1895,8 +1895,8 @@ be a list of the form returned by `event-start' and
`event-end'."
(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.
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 @@ example, sets a variable, use `transient-define-infix'
instead.
(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))
diff --git a/lisp/treesit.el b/lisp/treesit.el
index 1750929cc85..1b1a7783a32 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -2753,7 +2753,6 @@ in the region."
(defun treesit--explorer-jump (button)
"Mark the original text corresponding to BUTTON."
- (interactive)
(when (and (derived-mode-p 'treesit--explorer-tree-mode)
(buffer-live-p treesit--explorer-source-buffer))
(with-current-buffer treesit--explorer-source-buffer
diff --git a/lisp/woman.el b/lisp/woman.el
index 24f23c8e8f0..e4e3d176d08 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -1846,7 +1846,6 @@ Argument EVENT is the invoking mouse event."
(defun woman-reset-emulation (value)
"Reset `woman-emulation' to VALUE and reformat, for menu use."
- (interactive)
(setq woman-emulation value)
(woman-reformat-last-file))
diff --git a/src/sysdep.c b/src/sysdep.c
index cb63d8bba08..bec2c00d3e5 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -2065,7 +2065,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.
@@ -2078,6 +2080,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__ */
}
/* SIGUSR1 and SIGUSR2 are used internally by the android_select
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 @@
(progn
(calendar)
,@body)
- (kill-buffer "*Calendar*"))))
+ (kill-buffer calendar-buffer))))
(ert-deftest cal-julian-test-goto-date ()
(with-cal-julian-test
diff --git a/test/lisp/erc/erc-button-tests.el
b/test/lisp/erc/erc-button-tests.el
new file mode 100644
index 00000000000..6a6f6934389
--- /dev/null
+++ b/test/lisp/erc/erc-button-tests.el
@@ -0,0 +1,283 @@
+;;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(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 <URL: form> still works despite being removed in ERC 5.6.
+ (erc-display-message nil nil (current-buffer)
+ "Foo <URL: https://gnu.org> bar.")
+ (search-forward "https")
+ (funcall verify (point) "https://gnu.org";)
+
+ ;; Bracketed
+ (erc-display-message nil nil (current-buffer) "Foo <ftp://gnu.org> 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
+ (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 @@
;; 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-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 <https://www.gnu.org/licenses/>.
+
+;;; 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 <mlang@delysid.org>
+;; 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/erc-scenarios-base-buffer-display.el
b/test/lisp/erc/erc-scenarios-base-buffer-display.el
new file mode 100644
index 00000000000..548ad00e2d9
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-buffer-display.el
@@ -0,0 +1,235 @@
+;;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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
+ (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))
+ (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)
+
+ (should (memq 'autojoin erc-modules))
+
+ (ert-info ("Connect to foonet")
+ (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 "FooNet"
+ (funcall expect 10 "Connection failed! Re-establishing")))
+
+ (should (equal erc-autojoin-channels-alist '((FooNet "#chan"))))
+ (delete-other-windows)
+ (pop-to-buffer-same-window "*Messages*")
+
+ (ert-info ("Wait for auto reconnect")
+ (with-current-buffer "FooNet" (funcall expect 10 "still in debug mode")))
+
+ (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-buffer-display--defwin-recbury-intbuf ()
+ :tags '(:expensive-test)
+ (should (eq erc-buffer-display 'bury))
+ (should (eq erc-interactive-display 'window))
+ (should-not erc-reconnect-display)
+
+ (let ((erc-buffer-display 'window)
+ (erc-interactive-display 'buffer)
+ (erc-reconnect-display 'bury))
+
+ (erc-scenarios-base-buffer-display--reconnect-common
+
+ (lambda (_)
+ (should (eq (window-buffer) (current-buffer)))
+ (should-not (frame-root-window-p (selected-window))))
+
+ (lambda (_)
+ (should (eq (window-buffer) (current-buffer)))
+ (should (equal (get-buffer "FooNet") (window-buffer (next-window)))))
+
+ (lambda (_)
+ (with-current-buffer "FooNet"
+ (should (eq (window-buffer) (messages-buffer)))
+ (should (frame-root-window-p (selected-window))))
+
+ ;; A manual /JOIN command tells ERC we're done auto-reconnecting
+ (with-current-buffer "FooNet" (erc-scenarios-common-say "/JOIN #spam"))
+
+ (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)))))))))
+
+(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)
+
+ (let ((erc-buffer-display 'window-noselect)
+ (erc-reconnect-display 'bury)
+ (erc-interactive-display 'buffer))
+ (erc-scenarios-base-buffer-display--reconnect-common
+
+ (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 #<window 1 on *scratch*>).
+ (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.
+
+(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-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 @@
(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/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 <https://www.gnu.org/licenses/>.
+
+;;; 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 "<tester>")
+ (funcall expect -0.1 "<tester>"))
+
+ (ert-info ("Message over `erc-split-line-length'")
+ (erc-scenarios-common-say
+ (concat
+ "короче теперь если по русски написать все четко или все равно"
+ " короче теперь если по русски написать все четко или все равно"
+ " короче теперь если по русски написать все четко или все равно"
+ " короче теперь если по русски написать все четко или все равно"
+ " короче теперь если по русски написать все четко или все равно"
+ " короче теперь если по русски написать все четко или все равно"
+ " короче теперь если по русски написать все четко или все равно"
+ " будет разрыв строки непонятно где"))
+ (funcall expect 1 "<tester>")
+ (funcall expect 1 "<tester> разрыв")))
+
+ (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 "<tester>")
+ ;; Sent in a single go, hence no second <speaker>.
+ (funcall expect -0.1 "<tester>")
+ (funcall expect 0.1 "12345678"))
+
+ (ert-info ("Message with spaces too long.")
+ (erc-scenarios-common-say (concat msg-432 " 123456789"))
+ (funcall expect 1 "<tester>")
+ ;; Sent in two passes, split at last word.
+ (funcall expect 0.1 "<tester> 123456789"))
+
+ (ert-info ("Message sans spaces fits exactly")
+ (erc-scenarios-common-say (make-string 440 ?x))
+ (funcall expect 1 "<tester>")
+ ;; Sent in a single go, hence no second <speaker>.
+ (funcall expect -0.1 "<tester>"))
+
+ (ert-info ("Message sans spaces too long.")
+ (erc-scenarios-common-say (concat (make-string 440 ?y) "z"))
+ (funcall expect 1 "<tester>")
+ ;; Sent in two passes, split at last word.
+ (funcall expect 0.1 "<tester> 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 "<tester> короче")
+ (funcall expect 1 "<tester> все")
+ (funcall expect 1 "<tester> разрыв")
+ (funcall expect 1 "Entirely honour"))
+
+ (ert-info ("Message sans spaces over `erc-split-line-length'")
+ (erc-scenarios-common-say
+ (concat "話說天下大勢，分久必合，合久必分：周末七國分爭，并入於秦。"
+ "及秦滅之後，楚、漢分爭，又并入於漢。漢朝自高祖斬白蛇而起義，"
+ "一統天下。後來光武中興，傳至獻帝，遂分為三國。推其致亂之由，"
+ "殆始於桓、靈二帝。桓帝禁錮善類，崇信宦官。及桓帝崩，靈帝即位，"
+ "大將軍竇武、太傅陳蕃，共相輔佐。時有宦官曹節等弄權，竇武、陳蕃謀誅之，"
+ "作事不密，反為所害。中涓自此愈橫"))
+ (funcall expect 1 "<tester>")
+ ;; Sent in two passes, split at last word.
+ (funcall expect 0.1 "<tester> 竇武")
+ (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 "<tester>")
+ (funcall expect 1 "<tester> 🏳️🌈")))
+
+ (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 29bda7e742d..be5a566a268 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -942,8 +942,8 @@
(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 _)
@@ -1044,6 +1044,48 @@
(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
@@ -1114,7 +1156,9 @@
(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")
@@ -1181,8 +1225,9 @@
(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 +1235,8 @@
(should (eq (point) (point-max)))
(should (save-excursion (forward-line -1)
(search-forward "<tester> 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)))))
@@ -1236,15 +1282,23 @@
(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")
@@ -1262,13 +1316,14 @@
(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'")
@@ -1289,14 +1344,12 @@
(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))
@@ -1349,6 +1402,94 @@
(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 ()
@@ -1469,7 +1610,7 @@
: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 +1620,7 @@
: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 +1630,7 @@
: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 +1766,7 @@
'("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 +1827,7 @@
'("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 +1837,7 @@
'("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))))))))
@@ -2017,7 +2158,7 @@ ARG is omitted or nil.
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)
@@ -2109,65 +2250,4 @@ connection."
(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
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."))
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 [...]
+((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 [...]
+((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\ [...]
+((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 [...]
+((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
[...]
+((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-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 @@ nonzero for this to work."
(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..e9d880644d4 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 @@ PROCESS should be a client connection or a server network
process."
(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))
@@ -455,7 +456,7 @@ including line delimiters."
(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))))