[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/android 23e963b6f0d: Merge remote-tracking branch 'origin/master
|
From: |
Po Lu |
|
Subject: |
feature/android 23e963b6f0d: Merge remote-tracking branch 'origin/master' into feature/android |
|
Date: |
Sat, 8 Apr 2023 21:08:02 -0400 (EDT) |
branch: feature/android
commit 23e963b6f0d7c402d3d0679e4dd4288fba882f55
Merge: e1261fff85e e33c0a54915
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/android
---
doc/misc/erc.texi | 2 +-
etc/ERC-NEWS | 177 ++++
lisp/emacs-lisp/byte-opt.el | 8 +-
lisp/emacs-lisp/byte-run.el | 7 +-
lisp/emacs-lisp/bytecomp.el | 39 +-
lisp/erc/erc-backend.el | 127 ++-
lisp/erc/erc-button.el | 216 ++++-
lisp/erc/erc-capab.el | 1 +
lisp/erc/erc-common.el | 221 +++--
lisp/erc/erc-compat.el | 77 +-
lisp/erc/erc-dcc.el | 64 +-
lisp/erc/erc-fill.el | 380 ++++++++-
lisp/erc/erc-goodies.el | 272 +++++-
lisp/erc/erc-ibuffer.el | 1 +
lisp/erc/erc-imenu.el | 23 +-
lisp/erc/erc-log.el | 9 +-
lisp/erc/erc-match.el | 33 +-
lisp/erc/erc-networks.el | 22 +-
lisp/erc/erc-page.el | 4 +
lisp/erc/erc-pcomplete.el | 2 +
lisp/erc/erc-sasl.el | 9 +-
lisp/erc/erc-services.el | 1 +
lisp/erc/erc-sound.el | 1 +
lisp/erc/erc-speedbar.el | 1 +
lisp/erc/erc-stamp.el | 236 +++++-
lisp/erc/erc-track.el | 6 +-
lisp/erc/erc.el | 547 ++++++++----
lisp/ibuf-ext.el | 93 +--
lisp/progmodes/eglot.el | 101 +--
test/lisp/emacs-lisp/bytecomp-tests.el | 4 +-
test/lisp/erc/erc-dcc-tests.el | 69 +-
test/lisp/erc/erc-fill-tests.el | 313 +++++++
test/lisp/erc/erc-goodies-tests.el | 334 ++++++++
test/lisp/erc/erc-networks-tests.el | 10 +-
test/lisp/erc/erc-scenarios-base-auto-recon.el | 141 ++++
.../erc/erc-scenarios-base-local-module-modes.el | 211 +++++
test/lisp/erc/erc-scenarios-base-local-modules.el | 99 ---
.../erc/erc-scenarios-base-misc-regressions.el | 44 +
test/lisp/erc/erc-scenarios-base-renick.el | 43 +
test/lisp/erc/erc-scenarios-misc.el | 34 +
test/lisp/erc/erc-scenarios-sasl.el | 64 ++
test/lisp/erc/erc-services-tests.el | 225 ++---
test/lisp/erc/erc-stamp-tests.el | 265 ++++++
test/lisp/erc/erc-tests.el | 924 +++++++++++++++++++--
.../base/assoc/bouncer-history/foonet.eld | 1 +
test/lisp/erc/resources/base/commands/motd.eld | 48 ++
.../lisp/erc/resources/base/reconnect/just-eof.eld | 3 +
.../erc/resources/base/reconnect/just-ping.eld | 4 +
.../erc/resources/base/reconnect/ping-pong.eld | 6 +
.../base/reconnect/unexpected-disconnect.eld | 24 +
.../resources/base/renick/regain/normal-again.eld | 56 ++
.../erc/resources/base/renick/regain/normal.eld | 53 ++
test/lisp/erc/resources/erc-scenarios-common.el | 1 +
.../resources/fill/snapshots/merge-01-start.eld | 1 +
.../resources/fill/snapshots/merge-02-right.eld | 1 +
.../fill/snapshots/monospace-01-start.eld | 1 +
.../fill/snapshots/monospace-02-right.eld | 1 +
.../resources/fill/snapshots/monospace-03-left.eld | 1 +
.../fill/snapshots/monospace-04-reset.eld | 1 +
.../erc/resources/sasl/plain-overlong-aligned.eld | 39 +
.../erc/resources/sasl/plain-overlong-split.eld | 39 +
61 files changed, 4961 insertions(+), 779 deletions(-)
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index b80affbc954..e92bf576e75 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -952,7 +952,7 @@ Here, ``password'' refers to your account password, which
is usually
your @samp{NickServ} password. To make this work, customize
@code{erc-sasl-user} and @code{erc-sasl-password} or specify the
@code{:user} and @code{:password} keyword arguments when invoking
-@code{erc-tls}. Note that @code{:user} cannot be given interactively.
+@code{erc-tls}.
@item @code{external} (via Client TLS Certificate)
This works in conjunction with the @code{:client-certificate} keyword
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 434bfab94e9..8f1b89f268b 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -12,6 +12,183 @@ extensible IRC (Internet Relay Chat) client distributed with
GNU Emacs since Emacs version 22.1.
+* Changes in ERC 5.6
+
+** Module 'keep-place' now offers a visual indicator.
+Remember your place in ERC buffers a bit more easily while retaining
+the freedom to look around. Optionally sync the indicator to any
+progress made when you haven't yet caught up to the live stream. See
+options 'erc-keep-place-indicator-style' and friends and new module
+'keep-place-indicator', which for now must be added manually to
+'erc-modules'.
+
+** Module 'fill' now offers a style based on 'visual-line-mode'.
+This fill style mimics the "hanging indent" look of 'erc-fill-static'
+and provides some movement and editing commands to optionally tame the
+less familiar aspects of 'visual-line' behavior. An interactive
+helper called 'erc-fill-wrap-nudge' allows for dynamic "refilling" of
+buffers on the fly. Set 'erc-fill-function' to 'erc-fill-wrap' to get
+started.
+
+** A unified interactive entry point.
+New users are often dismayed to discover that M-x ERC doesn't connect
+to its default network, Libera.Chat, over TLS. Though perhaps a
+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'.
+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.
+
+** Setting a module's mode variable via Customize earns a warning.
+Trying and failing to activate a module via its minor mode's Custom
+widget has been an age-old annoyance for new users. Previously
+ineffective, this method now actually works, but it also admonishes
+users to edit the 'erc-modules' widget instead.
+
+** The option 'erc-timestamp-use-align-to' is more versatile.
+While this option has always offered to right-align stamps via the
+'display' text property, it's now more effective at doing so when set
+to a number indicating an offset from the right edge. And when set to
+the symbol 'margin', it displays stamps in the right margin, although,
+at the moment, this is mostly intended for use by other modules, such
+as 'fill-wrap', described above. For both these variants, users of
+the 'log' module may want to customize 'erc-log-filter-function' to
+'erc-stamp-prefix-log-filter' to avoid ragged right-hand stamps
+appearing in their saved logs.
+
+** Smarter reconnect handling for users on the move.
+ERC now offers a new, experimental reconnect strategy in the function
+'erc-server-delayed-check-reconnect', which tests for underlying
+connectivity before attempting to reconnect in earnest. See options
+'erc-server-reconnect-function' and 'erc-nickname-in-use-functions' to
+get started.
+
+** Easily constrain all ERC-related business to a dedicated frame.
+The option 'erc-reuse-frames' can now be set to 'displayed', which
+tells ERC to show new buffers in frames already occupied by buffers
+from the same connection. This customization depends on the option
+'erc-buffer-display' (formerly 'erc-join-buffer') being set to
+'frame'. If you find the name 'displayed' unhelpful, please suggest
+an alternative by writing to the mailing list.
+
+** Some keybindings are now set by modules rather than their libraries.
+To put it another way, simply loading a built-in module's library no
+longer modifies 'erc-mode-map'. Instead, modifications occur during
+module setup. This should not impact most user configs since ERC
+doesn't bother with keys already taken and only removes bindings it's
+previously created. Note that while all affected bindings still
+reside in 'erc-mode-map', future built-in modules will use their own
+minor-mode maps, and new third-party modules should do the same.
+
+** The option 'erc-timestamp-format-right' has been deprecated.
+Having to account for this option prevented other ERC modules from
+easily determining what right-hand stamps would look like before
+insertion, which is knowledge needed for certain UI decisions. The
+way ERC has chosen to address this is imperfect and boils down to
+asking users who've customized this option to switch to
+'erc-timestamp-format' instead. If you're affected by this and feel
+that some other solution, like automatic migration, is justified,
+please make that known on the bug list.
+
+** The 'nicknames' entry in 'erc-button-alist' is officially exceptional.
+It's no secret that the 'buttons' module treats potential nicknames
+specially. To simplify ERC's move to next-gen "rich UI" extensions,
+this special treatment is being canonized. From now on, all values
+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.
+
+** 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.
+
+** Changes in the library API.
+
+*** Some top-level dependencies have been removed.
+The library 'erc-goodies' is no longer loaded by ERC's main library.
+This was done to further cement the move toward a unidirectional
+dependency flow begun in 5.5. Additionally, a few barely used and
+newly introduced dependencies are now lazily loaded, which may upset
+some third-party code. The first of these is 'pp' because its
+'pp-to-string' is autoloaded in all supported ERC versions. Also gone
+are 'thingatpt', 'time-date', and 'iso8601'. All were used ultra
+sparingly, and the latter two have only been around for one minor
+release cycle, so their removal hopefully won't cause much churn.
+
+*** Some ERC-applied text properties have changed.
+Chiefly, 'rear-sticky' has been replaced by 'erc-command', which
+records the IRC command (or numeric) associated with a message. Less
+impactfully, the value of the 'field' property for ERC's prompt has
+changed from 't' to the more useful 'erc-prompt', although the
+property of the same name has been retained.
+
+*** ERC now manages timestamp-related properties a bit differently.
+For starters, the 'cursor-sensor-functions' property no longer
+contains unique closures and thus no longer proves effective for
+traversing messages. To compensate, a new property, 'erc-timestamp',
+now spans message bodies but not the newlines delimiting them.
+Somewhat relatedly, the function 'erc-insert-aligned' has been
+deprecated and removed from the primary client code path.
+
+*** The role of a module's Custom group is now more clearly defined.
+Associating built-in modules with Custom groups and provided library
+features has improved. More specifically, a module's group now enjoys
+the singular purpose of determining where the module's minor mode
+variable lives in the Customize interface. And although ERC is now
+slightly more adept at linking these entities, third-parties are still
+encouraged to keep a module's name aligned with its group's as well as
+the provided feature of its containing library, if only for the usual
+reasons of namespace hygiene and discoverability.
+
+*** ERC now supports arbitrary CHANTYPES.
+Specifically, channels can be prefixed with any predesignated
+character, mainly to afford more flexibility to specialty services,
+like bridges to other protocols.
+
+*** 'erc-cmd-HELP' recognizes subcommands.
+Some IRC "slash" commands are hierarchical and require users to
+specify a subcommand to actually carry out anything of consequence.
+Built-in modules can now provide more detailed help for a particular
+subcommand by telling ERC to defer to a specialized handler.
+
+*** Longtime quasi modules have been made proper.
+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'.
+
+*** 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
+"insert marker" (ERC's per-buffer process mark) was inconsistent
+during these spells. To make insertion handling more predictable in
+preparation for incorporating various protocol extensions, the prompt
+and its bounding markers have become perennial fixtures. In rare
+cases, these changes may mean third-party code needs tweaking, for
+example, requiring the use of 'insert-before-markers' instead of
+'insert'. As always, users feeling unduly inconvenienced by these
+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'.
+
+
* Changes in ERC 5.5
** Smarter buffer naming for withstanding collisions.
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 0891ec80beb..70317e2365d 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -506,13 +506,7 @@ for speeding up processing.")
((guard (when for-effect
(if-let ((tmp (byte-opt--fget fn 'side-effect-free)))
(or byte-compile-delete-errors
- (eq tmp 'error-free)
- (progn
- (byte-compile-warn-x
- form
- "value returned from %s is unused"
- form)
- nil)))))
+ (eq tmp 'error-free)))))
(byte-compile-log " %s called for effect; deleted" fn)
(byte-optimize-form (cons 'progn (cdr form)) t))
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 9345665eea8..fd9913d1be8 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -650,11 +650,8 @@ in `byte-compile-warning-types'; see the variable
`byte-compile-warnings' for a fuller explanation of the warning
types. The types that can be suppressed with this macro are
`free-vars', `callargs', `redefine', `obsolete',
-`interactive-only', `lexical', `mapcar', `constants',
-`suspicious' and `empty-body'.
-
-For the `mapcar' case, only the `mapcar' function can be used in
-the symbol list."
+`interactive-only', `lexical', `ignored-return-value', `constants',
+`suspicious' and `empty-body'."
;; Note: during compilation, this definition is overridden by the one in
;; byte-compile-initial-macro-environment.
(declare (debug (sexp body)) (indent 1))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index a122e81ba3c..4a10ae29804 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -317,7 +317,9 @@ Elements of the list may be:
lexical-dynamic
lexically bound variable declared dynamic elsewhere
make-local calls to `make-variable-buffer-local' that may be incorrect.
- mapcar mapcar called for effect.
+ ignored-return-value
+ function called without using the return value where this
+ is likely to be a mistake
not-unused warning about using variables with symbol names starting with _.
constants let-binding of, or assignment to, constants/nonvariables.
docstrings docstrings that are too wide (longer than
@@ -330,7 +332,7 @@ Elements of the list may be:
empty-body body argument to a special form or macro is empty.
If the list begins with `not', then the remaining elements specify warnings to
-suppress. For example, (not mapcar) will suppress warnings about mapcar.
+suppress. For example, (not free-vars) will suppress the `free-vars' warning.
The t value means \"all non experimental warning types\", and
excludes the types in `byte-compile--emacs-build-warning-types'.
@@ -3490,6 +3492,27 @@ lambda-expression."
(byte-compile-report-error
(format-message "`%s' defined after use in %S (missing `require'
of a library file?)"
(car form) form)))
+
+ (when byte-compile--for-effect
+ (let ((sef (function-get (car form) 'side-effect-free)))
+ (cond
+ ((and sef (or (eq sef 'error-free)
+ byte-compile-delete-errors))
+ ;; This transform is normally done in the Lisp optimiser,
+ ;; so maybe we don't need to bother about it here?
+ (setq form (cons 'progn (cdr form)))
+ (setq handler #'byte-compile-progn))
+ ((and (or sef (eq (car form) 'mapcar))
+ (byte-compile-warning-enabled-p
+ 'ignored-return-value (car form)))
+ (byte-compile-warn-x
+ (car form)
+ "value from call to `%s' is unused%s"
+ (car form)
+ (cond ((eq (car form) 'mapcar)
+ "; use `mapc' or `dolist' instead")
+ (t "")))))))
+
(if (and handler
;; Make sure that function exists.
(and (functionp handler)
@@ -3523,11 +3546,7 @@ lambda-expression."
(byte-compile-callargs-warn form))
(if byte-compile-generate-call-tree
(byte-compile-annotate-call-tree form))
- (when (and byte-compile--for-effect (eq (car form) 'mapcar)
- (byte-compile-warning-enabled-p 'mapcar 'mapcar))
- (byte-compile-warn-x
- (car form)
- "`mapcar' called for effect; use `mapc' or `dolist' instead"))
+
(byte-compile-push-constant (car form))
(mapc 'byte-compile-form (cdr form)) ; wasteful, but faster.
(byte-compile-out 'byte-call (length (cdr form))))
@@ -4367,7 +4386,11 @@ This function is never called when `lexical-binding' is
nil."
(defun byte-compile-ignore (form)
(dolist (arg (cdr form))
- (byte-compile-form arg t))
+ ;; Compile args for value (to avoid warnings about unused values),
+ ;; emit a discard after each, and trust the LAP peephole optimiser
+ ;; to annihilate useless ops.
+ (byte-compile-form arg)
+ (byte-compile-discard))
(byte-compile-form nil))
;; Return the list of items in CONDITION-PARAM that match PRED-LIST.
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 567443f5329..bdf4e2ddca2 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -415,8 +415,12 @@ This only has an effect if `erc-server-auto-reconnect' is
non-nil."
(defcustom erc-server-reconnect-timeout 1
"Number of seconds to wait between successive reconnect attempts.
-
-If a key is pressed while ERC is waiting, it will stop waiting."
+If this value is too low, servers may reject your initial nick
+request upon reconnecting because they haven't yet noticed that
+your previous connection is dead. If this happens, try setting
+this value to 120 or greater and/or exploring the option
+`erc-nickname-in-use-functions', which may provide a more
+proactive means of handling this situation on some servers."
:type 'number)
(defcustom erc-server-reconnect-function 'erc-server-delayed-reconnect
@@ -427,6 +431,7 @@ dialing. Use `erc-schedule-reconnect' to instead try again
later
and optionally alter the attempts tally."
:package-version '(ERC . "5.5")
:type '(choice (function-item erc-server-delayed-reconnect)
+ (function-item erc-server-delayed-check-reconnect)
function))
(defcustom erc-split-line-length 440
@@ -658,6 +663,30 @@ The current buffer is given by BUFFER."
(run-hooks 'erc--server-post-connect-hook)
(erc-login))
+(defvar erc--server-connect-function #'erc--server-propagate-failed-connection
+ "Function called one second after creating a server process.
+Called with the newly created process just before the opening IRC
+protocol exchange.")
+
+(defun erc--server-propagate-failed-connection (process)
+ "Ensure the PROCESS sentinel runs at least once on early failure.
+Act as a watchdog timer to force `erc-process-sentinel' and its
+finalizers, like `erc-disconnected-hook', to run when PROCESS has
+a status of `failed' after one second. But only do so when its
+error data is something ERC recognizes. Print an explanation to
+the server buffer in any case."
+ (when (eq (process-status process) 'failed)
+ (erc-display-message
+ nil 'error (process-buffer process)
+ (format "Process exit status: %S" (process-exit-status process)))
+ (pcase (process-exit-status process)
+ (111
+ (erc-process-sentinel process "failed with code 111\n"))
+ (`(file-error . ,_)
+ (erc-process-sentinel process "failed with code -523\n"))
+ ((rx "tls" (+ nonl) "failed")
+ (erc-process-sentinel process "failed with code -525\n")))))
+
(defvar erc--server-connect-dumb-ipv6-regexp
;; Not for validation (gives false positives).
(rx bot "[" (group (+ (any xdigit digit ":.")) (? "%" (+ alnum))) "]" eot))
@@ -710,7 +739,9 @@ TLS (see `erc-session-client-certificate' for more
details)."
;; MOTD line)
(if (eq (process-status process) 'connect)
;; waiting for a non-blocking connect - keep the user informed
- (erc-display-message nil nil buffer "Opening connection..\n")
+ (progn
+ (erc-display-message nil nil buffer "Opening connection..\n")
+ (run-at-time 1 nil erc--server-connect-function process))
(message "%s...done" msg)
(erc--register-connection))))
@@ -744,6 +775,78 @@ Make sure you are in an ERC buffer when running this."
(with-current-buffer buffer
(erc-server-reconnect))))
+(defvar-local erc--server-reconnect-timeout nil)
+(defvar-local erc--server-reconnect-timeout-check 10)
+(defvar-local erc--server-reconnect-timeout-scale-function
+ #'erc--server-reconnect-timeout-double)
+
+(defun erc--server-reconnect-timeout-double (existing)
+ "Double EXISTING timeout, but cap it at 5 minutes."
+ (min 300 (* existing 2)))
+
+;; This may appear to hang at various places. It's assumed that when
+;; *Messages* contains "Waiting for socket ..." or similar, progress
+;; will be made eventually.
+
+(defun erc-server-delayed-check-reconnect (buffer)
+ "Wait for internet connectivity before trying to reconnect.
+Expect BUFFER to be the server buffer for the current connection."
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (setq erc--server-reconnect-timeout
+ (funcall erc--server-reconnect-timeout-scale-function
+ (or erc--server-reconnect-timeout
+ erc-server-reconnect-timeout)))
+ (let* ((reschedule (lambda (proc)
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (let ((erc-server-reconnect-timeout
+ erc--server-reconnect-timeout))
+ (delete-process proc)
+ (erc-display-message nil 'error buffer
+ "Nobody home...")
+ (erc-schedule-reconnect buffer 0))))))
+ (conchk-exp (time-add erc--server-reconnect-timeout-check
+ (current-time)))
+ (conchk-timer nil)
+ (conchk (lambda (proc)
+ (let ((status (process-status proc))
+ (xprdp (time-less-p conchk-exp (current-time))))
+ (when (or (not (eq 'connect status)) xprdp)
+ (cancel-timer conchk-timer))
+ (when (buffer-live-p buffer)
+ (cond (xprdp (erc-display-message
+ nil 'error buffer
+ "Timed out while dialing...")
+ (delete-process proc)
+ (funcall reschedule proc))
+ ((eq 'failed status)
+ (funcall reschedule proc)))))))
+ (sentinel (lambda (proc event)
+ (pcase event
+ ("open\n"
+ (run-at-time nil nil #'send-string proc
+ (format "PING %d\r\n"
+ (time-convert nil 'integer))))
+ ((or "connection broken by remote peer\n"
+ (rx bot "failed"))
+ (funcall reschedule proc)))))
+ (filter (lambda (proc _)
+ (delete-process proc)
+ (with-current-buffer buffer
+ (setq erc--server-reconnect-timeout nil))
+ (run-at-time nil nil #'erc-server-delayed-reconnect
+ buffer))))
+ (condition-case _
+ (let ((proc (funcall erc-session-connector
+ "*erc-connectivity-check*" nil
+ erc-session-server erc-session-port
+ :nowait t)))
+ (setq conchk-timer (run-at-time 1 1 conchk proc))
+ (set-process-filter proc filter)
+ (set-process-sentinel proc sentinel))
+ (file-error (funcall reschedule nil)))))))
+
(defun erc-server-filter-function (process string)
"The process filter for the ERC server."
(with-current-buffer (process-buffer process)
@@ -823,11 +926,16 @@ When `erc-server-reconnect-attempts' is a number,
increment
`erc-server-reconnect-count' by INCR unconditionally."
(let ((count (and (integerp erc-server-reconnect-attempts)
(- erc-server-reconnect-attempts
- (cl-incf erc-server-reconnect-count (or incr 1))))))
- (erc-display-message nil 'error (current-buffer) 'reconnecting
+ (cl-incf erc-server-reconnect-count (or incr 1)))))
+ (proc (buffer-local-value 'erc-server-process buffer)))
+ (erc-display-message nil 'error buffer 'reconnecting
?m erc-server-reconnect-timeout
?i (if count erc-server-reconnect-count "N")
?n (if count erc-server-reconnect-attempts "A"))
+ (set-process-sentinel proc #'ignore)
+ (set-process-filter proc nil)
+ (delete-process proc)
+ (erc-update-mode-line)
(setq erc-server-reconnecting nil
erc--server-reconnect-timer
(run-at-time erc-server-reconnect-timeout nil
@@ -1876,7 +1984,7 @@ ambiguous and only useful for tokens supporting a single
primitive value."
(if-let* ((table (or erc--isupport-params
(erc-with-server-buffer erc--isupport-params)))
- (value (erc-compat--with-memoization (gethash key table)
+ (value (with-memoization (gethash key table)
(when-let ((v (assoc (symbol-name key)
erc-server-parameters)))
(if (cdr v)
@@ -2236,6 +2344,11 @@ See `erc-display-server-message'." nil
(erc-display-message parsed '(notice error) 'active
's401 ?n nick/channel)))
+(define-erc-response-handler (402)
+ "No such server." nil
+ (erc-display-message parsed '(notice error) 'active
+ 's402 ?c (cadr (erc-response.command-args parsed))))
+
(define-erc-response-handler (403)
"No such channel." nil
(erc-display-message parsed '(notice error) 'active
@@ -2383,7 +2496,7 @@ See `erc-display-error-notice'." nil
;; (define-erc-response-handler (323 364 365 381 382 392 393 394 395
;; 200 201 202 203 204 205 206 208 209 211 212
213
;; 214 215 216 217 218 219 241 242 243 244 249
261
-;; 262 302 342 351 402 407 409 411 413 414 415
+;; 262 302 342 351 407 409 411 413 414 415
;; 423 424 436 441 443 444 467 471 472 473 KILL)
;; nil nil
;; (ignore proc parsed))
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index c28dddefa0e..33e69f3b0b8 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -52,14 +52,15 @@
;;;###autoload(autoload 'erc-button-mode "erc-button" nil t)
(define-erc-module button nil
"This mode buttonizes all messages according to `erc-button-alist'."
- ((add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append)
+ ((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-mode-hook #'erc-button-setup))
+ (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-mode-hook #'erc-button-setup)))
+ (erc--modify-local-map nil "<backtab>" #'erc-button-previous)))
;;; Variables
@@ -133,7 +134,7 @@ longer than `erc-fill-column'."
("[`‘]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)['’]"
1 t erc-button-describe-symbol 1)
;; pseudo links
- ("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t Info-goto-node 1)
+ ("\\(?:\\bInfo: ?\\|(info \\)[\"]\\(([^\"]+\\)[\"])?" 0 t info 1)
("\\b\\(Ward\\|Wiki\\|WardsWiki\\|TheWiki\\):\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)"
0 t (lambda (page)
(browse-url (concat "http://c2.com/cgi-bin/wiki?"; page)))
@@ -165,8 +166,17 @@ 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 expression which must eval to true for the button to
- be added.
+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.
CALLBACK is the function to call when the user push this button.
CALLBACK can also be a symbol. Its variable value will be used
@@ -176,7 +186,7 @@ PAR is a number of a regexp grouping whose text will be
passed to
CALLBACK. There can be several PAR arguments. If REGEXP is
`nicknames', these are ignored, and CALLBACK will be called with
the nickname matched as the argument."
- :package-version '(ERC . "5.5")
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(repeat
(list :tag "Button"
(choice :tag "Matches"
@@ -233,6 +243,8 @@ constituents.")
"Internal variable used to keep track of whether we've added the
global-level ERC button keys yet.")
+;; Maybe deprecate this function and `erc-button-keys-added' if they
+;; continue to go unused for a another version (currently 5.6).
(defun erc-button-setup ()
"Add ERC mode-level button movement keys. This is only done once."
;; Add keys.
@@ -275,22 +287,127 @@ specified by `erc-button-alist'."
(concat "\\<" (regexp-quote (car elem)) "\\>")
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)))
+
+(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))
+ (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))
+
+;; This variable is intended to serve as a "core" to be wrapped by
+;; (built-in) modules during setup. It's unclear whether
+;; `add-function's practice of removing existing advice before
+;; re-adding it is desirable when integrating modules since we're
+;; 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
+ "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.")
+
+(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)))
+
+(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'."
+ :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)))
+ (setq erc-button--phantom-users (make-hash-table :test #'equal)))
+ (remove-function (local 'erc-button--modify-nick-function)
+ #'erc-button--add-phantom-speaker)
+ (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))
(fun (nth 3 entry))
bounds word)
- (when (or (eq t form)
- (eval form t))
+ (when (eq form 'erc-button-buttonize-nicks)
+ (setq form (and (symbol-value form) erc-button--modify-nick-function)))
+ (when (or (functionp form)
+ (eq t form)
+ (and form (erc-button--maybe-warn-arbitrary-sexp form)))
(goto-char (point-min))
(while (erc-forward-word)
(when (setq bounds (erc-bounds-of-word-at-point))
(setq word (buffer-substring-no-properties
(car bounds) (cdr bounds)))
- (when (or (and (erc-server-buffer-p) (erc-get-server-user word))
- (and erc-channel-users (erc-get-channel-user word)))
- (erc-button-add-button (car bounds) (cdr bounds)
- fun t (list word))))))))
+ (let* ((erc-button-face erc-button-face)
+ (erc-button-mouse-face erc-button-mouse-face)
+ (erc-button-nickname-face erc-button-nickname-face)
+ (down (erc-downcase word))
+ (cuser (and erc-channel-users
+ (gethash down erc-channel-users)))
+ (user (or (and cuser (car cuser))
+ (and erc-server-users
+ (gethash down erc-server-users)))))
+ (when (or (not (functionp form))
+ (setq bounds
+ (funcall form bounds down user (cdr cuser))))
+ (erc-button-add-button (car bounds) (cdr bounds)
+ fun t (list word)))))))))
(defun erc-button-add-buttons-1 (regexp entry)
"Search through the buffer for matches to ENTRY and add buttons."
@@ -302,7 +419,14 @@ specified by `erc-button-alist'."
(fun (nth 3 entry))
(data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
(when (or (eq t form)
- (eval form t))
+ (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)))))
(defun erc-button-remove-old-buttons ()
@@ -511,6 +635,70 @@ 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)
+ "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)))
+
+;;;###autoload
+(defun erc-button--display-error-notice-with-keys (&optional parsed buffer
+ &rest strings)
+ "Add help keys to STRINGS for configuration-related admonishments.
+Return inserted result. Expect PARSED to be an `erc-response'
+object, a string, or nil. Expect BUFFER to be a buffer, a string,
+or nil. As a special case, allow PARSED to be a buffer as long
+as BUFFER is a string or nil. If STRINGS contains any trailing
+non-strings, concatenate leading string members before applying
+`format'. Otherwise, just concatenate everything."
+ (when (stringp buffer)
+ (push buffer strings)
+ (setq buffer nil))
+ (when (stringp parsed)
+ (push parsed strings)
+ (setq parsed nil))
+ (when (bufferp parsed)
+ (cl-assert (null buffer))
+ (setq buffer parsed
+ parsed nil))
+ (let* ((op (if (seq-every-p #'stringp (cdr strings))
+ #'concat
+ (let ((head (pop strings)))
+ (while (stringp (car strings))
+ (setq head (concat head (pop strings))))
+ (push head strings))
+ #'format))
+ (string (apply op strings))
+ (erc-insert-post-hook
+ (cons (lambda ()
+ (setq string (buffer-substring (point-min)
+ (1- (point-max)))))
+ erc-insert-post-hook))
+ (erc-button-alist
+ `((,(rx "\\[" (group (+ (not "]"))) "]") 0
+ erc-button--substitute-command-keys-in-region
+ erc-button-describe-symbol 1)
+ ,@erc-button-alist)))
+ (erc-display-message parsed '(notice error) (or buffer 'active) string)
+ string))
+
+;;;###autoload
+(defun erc-button--display-error-notice-with-keys-and-warn (&rest args)
+ "Like `erc-button--display-error-notice-with-keys' but also warn."
+ (let ((string (apply #'erc-button--display-error-notice-with-keys args)))
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (with-syntax-table lisp-mode-syntax-table
+ (skip-syntax-forward "^-"))
+ (forward-char)
+ (display-warning
+ 'erc (buffer-substring-no-properties (point) (point-max))))))
+
(provide 'erc-button)
;;; erc-button.el ends here
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el
index 650c5fa84ac..bb0921da7f0 100644
--- a/lisp/erc/erc-capab.el
+++ b/lisp/erc/erc-capab.el
@@ -89,6 +89,7 @@ character not found in IRC nicknames to avoid confusion."
;;; Define module:
;;;###autoload(autoload 'erc-capab-identify-mode "erc-capab" nil t)
+(put 'capab-identify 'erc-group 'erc-capab)
(define-erc-module capab-identify nil
"Handle dancer-ircd's CAPAB IDENTIFY-MSG and IDENTIFY-CTCP."
;; append so that `erc-server-parameters' is already set by `erc-server-005'
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 0279b0a0bc4..6c015c71ff9 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -31,12 +31,18 @@
(defvar erc-channel-users)
(defvar erc-dbuf)
(defvar erc-log-p)
+(defvar erc-modules)
(defvar erc-server-users)
(defvar erc-session-server)
(declare-function erc--get-isupport-entry "erc-backend" (key &optional single))
(declare-function erc-get-buffer "erc" (target &optional proc))
(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-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)
@@ -85,45 +91,52 @@
(contents "" :type string)
(tags '() :type list))
-;; TODO move goodies modules here after 29 is released.
-(defconst erc--features-to-modules
- '((erc-pcomplete completion pcomplete)
- (erc-capab capab-identify)
- (erc-join autojoin)
- (erc-page page ctcp-page)
- (erc-sound sound ctcp-sound)
- (erc-stamp stamp timestamp)
- (erc-services services nickserv))
- "Migration alist mapping a library feature to module names.
-Keys need not be unique: a library may define more than one
-module. Sometimes a module's downcased alias will be its
-canonical name.")
-
-(defconst erc--modules-to-features
- (let (pairs)
- (pcase-dolist (`(,feature . ,names) erc--features-to-modules)
- (dolist (name names)
- (push (cons name feature) pairs)))
- (nreverse pairs))
- "Migration alist mapping a module's name to its home library feature.")
-
-(defconst erc--module-name-migrations
- (let (pairs)
- (pcase-dolist (`(,_ ,canonical . ,rest) erc--features-to-modules)
- (dolist (obsolete rest)
- (push (cons obsolete canonical) pairs)))
- pairs)
- "Association list of obsolete module names to canonical names.")
-
+;; After dropping 28, we can use prefixed "erc-autoload" cookies.
(defun erc--normalize-module-symbol (symbol)
- "Return preferred SYMBOL for `erc-modules'."
- (setq symbol (intern (downcase (symbol-name symbol))))
- (or (cdr (assq symbol erc--module-name-migrations)) symbol))
+ "Return preferred SYMBOL for `erc--modules'."
+ (while-let ((canonical (get symbol 'erc--module))
+ ((not (eq canonical symbol))))
+ (setq symbol canonical))
+ symbol)
+
+(defvar erc--inside-mode-toggle-p nil
+ "Non-nil when a module's mode toggle is updating module membership.
+This serves as a flag to inhibit the mutual recursion that would
+otherwise occur between an ERC-defined minor-mode function, such
+as `erc-services-mode', and the custom-set function for
+`erc-modules'. For historical reasons, the latter calls
+`erc-update-modules', which, in turn, enables the minor-mode
+functions for all member modules. Also non-nil when a mode's
+widget runs its set function.")
+
+(defun erc--favor-changed-reverted-modules-state (name op)
+ "Be more nuanced in displaying Custom state of `erc-modules'.
+When `customized-value' differs from `saved-value', allow widget
+to behave normally and show \"SET for current session\", as
+though `customize-set-variable' or similar had been applied.
+However, when `customized-value' and `standard-value' match but
+differ from `saved-value', prefer showing \"CHANGED outside
+Customize\" to prevent the widget from seeing a `standard'
+instead of a `set' state, which precludes any actual saving."
+ ;; Although the button "Apply and save" is fortunately grayed out,
+ ;; `Custom-save' doesn't actually save (users must click the magic
+ ;; state button instead). The default behavior described in the doc
+ ;; string is intentional and was introduced by bug#12864 "Make state
+ ;; button interaction less confusing". However, it is unfriendly to
+ ;; rogue libraries (like ours) that insist on mutating user options
+ ;; as a matter of course.
+ (custom-load-symbol 'erc-modules)
+ (funcall (get 'erc-modules 'custom-set) 'erc-modules
+ (funcall op (erc--normalize-module-symbol name) erc-modules))
+ (when (equal (pcase (get 'erc-modules 'saved-value)
+ (`((quote ,saved) saved)))
+ erc-modules)
+ (customize-mark-as-set 'erc-modules)))
(defun erc--assemble-toggle (localp name ablsym mode val body)
(let ((arg (make-symbol "arg")))
`(defun ,ablsym ,(if localp `(&optional ,arg) '())
- ,(concat
+ ,(erc--fill-module-docstring
(if val "Enable" "Disable")
" ERC " (symbol-name name) " mode."
(when localp
@@ -137,14 +150,120 @@ canonical name.")
(,ablsym))
(setq ,mode ,val)
,@body)))
- `(,(if val
- `(cl-pushnew ',(erc--normalize-module-symbol name)
- erc-modules)
- `(setq erc-modules (delq ',(erc--normalize-module-symbol name)
- erc-modules)))
+ ;; No need for `default-value', etc. because a buffer-local
+ ;; `erc-modules' only influences the next session and
+ ;; doesn't survive the major-mode reset that soon follows.
+ `((unless
+ (or erc--inside-mode-toggle-p
+ ,@(let ((v `(memq ',(erc--normalize-module-symbol name)
+ erc-modules)))
+ `(,(if val v `(not ,v)))))
+ (let ((erc--inside-mode-toggle-p t))
+ (erc--favor-changed-reverted-modules-state
+ ',name #',(if val 'cons 'delq))))
(setq ,mode ,val)
,@body)))))
+;; This is a migration helper that determines a module's `:group'
+;; keyword argument from its name or alias. A (global) module's minor
+;; mode variable appears under the group's Custom menu. Like
+;; `erc--normalize-module-symbol', it must run when the module's
+;; definition (rather than that of `define-erc-module') is expanded.
+;; For corner cases in which this fails or the catch-all of `erc' is
+;; more inappropriate, (global) modules can declare a top-level
+;;
+;; (put 'foo 'erc-group 'erc-bar)
+;;
+;; where `erc-bar' is the group and `foo' is the normalized module.
+;; Do this *before* the module's definition. If `define-erc-module'
+;; ever accepts arbitrary keywords, passing an explicit `:group' will
+;; obviously be preferable.
+
+(defun erc--find-group (&rest symbols)
+ (catch 'found
+ (dolist (s symbols)
+ (let* ((downed (downcase (symbol-name s)))
+ (known (intern-soft (concat "erc-" downed))))
+ (when (and known
+ (or (get known 'group-documentation)
+ (rassq known custom-current-group-alist)))
+ (throw 'found known))
+ (when (setq known (intern-soft (concat "erc-" downed "-mode")))
+ (when-let ((found (custom-group-of-mode known)))
+ (throw 'found found))))
+ (when-let ((found (get (erc--normalize-module-symbol s) 'erc-group)))
+ (throw 'found found)))
+ 'erc))
+
+(defun erc--neuter-custom-variable-state (variable)
+ "Lie to Customize about VARIABLE's true state.
+Do so by always returning its standard value, namely nil."
+ ;; Make a module's global minor-mode toggle blind to Customize, so
+ ;; that `customize-variable-state' never sees it as "changed",
+ ;; regardless of its value. This snippet is
+ ;; `custom--standard-value' from Emacs 28+.
+ (cl-assert (null (eval (car (get variable 'standard-value)) t)))
+ nil)
+
+;; This exists as a separate, top-level function to prevent the byte
+;; compiler from warning about widget-related dependencies not being
+;; loaded at runtime.
+
+(defun erc--tick-module-checkbox (name &rest _) ; `name' must be normalized
+ (customize-variable-other-window 'erc-modules)
+ ;; Move to `erc-modules' section.
+ (while (not (eq (widget-type (widget-at)) 'checkbox))
+ (widget-move 1 t))
+ ;; This search for a checkbox can fail when `name' refers to a
+ ;; third-party module that modifies `erc-modules' (improperly) on
+ ;; load.
+ (let (w)
+ (while (and (eq (widget-type (widget-at)) 'checkbox)
+ (not (and (setq w (widget-get-sibling (widget-at)))
+ (eq (widget-value w) name))))
+ (setq w nil)
+ (widget-move 1 t)) ; the `suppress-echo' arg exists in 27.2
+ (unless w
+ (error "Failed to find %s in `erc-modules' checklist" name))
+ (widget-apply-action (widget-at))
+ (message "Hit %s to apply or %s to apply and save."
+ (substitute-command-keys "\\[Custom-set]")
+ (substitute-command-keys "\\[Custom-save]"))))
+
+(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"
+ :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))))
+
+(defun erc--fill-module-docstring (&rest strings)
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (insert "(defun foo ()\n"
+ (format "%S" (apply #'concat strings))
+ "\n(ignore))")
+ (goto-char (point-min))
+ (forward-line 2)
+ (let ((emacs-lisp-docstring-fill-column 65)
+ (sentence-end-double-space t))
+ (fill-paragraph))
+ (goto-char (point-min))
+ (nth 3 (read (current-buffer)))))
+
(defmacro define-erc-module (name alias doc enable-body disable-body
&optional local-p)
"Define a new minor mode using ERC conventions.
@@ -179,21 +298,20 @@ Example:
(declare (doc-string 3) (indent defun))
(let* ((sn (symbol-name name))
(mode (intern (format "erc-%s-mode" (downcase sn))))
- (group (intern (format "erc-%s" (downcase sn))))
(enable (intern (format "erc-%s-enable" (downcase sn))))
(disable (intern (format "erc-%s-disable" (downcase sn)))))
`(progn
(define-minor-mode
,mode
- ,(format "Toggle ERC %S mode.
+ ,(erc--fill-module-docstring (format "Toggle ERC %s mode.
With a prefix argument ARG, enable %s if ARG is positive,
and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil.
-%s" name name doc)
- ;; FIXME: We don't know if this group exists, so this `:group' may
- ;; actually just silence a valid warning about the fact that the var
- ;; is not associated with any group.
- :global ,(not local-p) :group (quote ,group)
+\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 `(:type ,(erc--prepare-custom-module-type name)))
(if ,mode
(,enable)
(,disable)))
@@ -249,11 +367,16 @@ See also `with-current-buffer'.
"Execute BODY in the current ERC server buffer.
If no server buffer exists, return nil."
(declare (indent 0) (debug (body)))
- (let ((buffer (make-symbol "buffer")))
+ (let ((varp (and (symbolp (car body))
+ (not (cdr body))
+ (special-variable-p (car body))))
+ (buffer (make-symbol "buffer")))
`(let ((,buffer (erc-server-buffer)))
(when (buffer-live-p ,buffer)
- (with-current-buffer ,buffer
- ,@body)))))
+ ,(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-compat.el b/lisp/erc/erc-compat.el
index 5601ede27a5..29892b78a39 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -32,7 +32,50 @@
;;; Code:
(require 'compat nil 'noerror)
-(eval-when-compile (require 'cl-lib) (require 'url-parse))
+(eval-when-compile (require 'cl-lib))
+
+;; Except for the "erc-" namespacing, these two definitions should be
+;; continuously updated to match the latest upstream ones verbatim.
+;; Although they're pretty simple, it's likely not worth checking for
+;; and possibly deferring to the non-prefixed versions.
+;;
+;; BEGIN Compat macros
+
+;;;; Macros for extended compatibility function calls
+
+(defmacro erc-compat-function (fun)
+ "Return compatibility function symbol for FUN.
+
+If the Emacs version provides a sufficiently recent version of
+FUN, the symbol FUN is returned itself. Otherwise the macro
+returns the symbol of a compatibility function which supports the
+behavior and calling convention of the current stable Emacs
+version. For example Compat 29.1 will provide compatibility
+functions which implement the behavior and calling convention of
+Emacs 29.1.
+
+See also `compat-call' to directly call compatibility functions."
+ (let ((compat (intern (format "compat--%s" fun))))
+ `#',(if (fboundp compat) compat fun)))
+
+(defmacro erc-compat-call (fun &rest args)
+ "Call compatibility function or macro FUN with ARGS.
+
+A good example function is `plist-get' which was extended with an
+additional predicate argument in Emacs 29.1. The compatibility
+function, which supports this additional argument, can be
+obtained via (compat-function plist-get) and called
+via (compat-call plist-get plist prop predicate). It is not
+possible to directly call (plist-get plist prop predicate) on
+Emacs older than 29.1, since the original `plist-get' function
+does not yet support the predicate argument. Note that the
+Compat library never overrides existing functions.
+
+See also `compat-function' to lookup compatibility functions."
+ (let ((compat (intern (format "compat--%s" fun))))
+ `(,(if (fboundp compat) compat fun) ,@args)))
+
+;; END Compat macros
;;;###autoload(autoload 'erc-define-minor-mode "erc-compat")
(define-obsolete-function-alias 'erc-define-minor-mode
@@ -368,16 +411,8 @@ If START or END is negative, it counts from the end."
;;;; Misc 29.1
-(defmacro erc-compat--with-memoization (table &rest forms)
- (declare (indent defun))
- (cond
- ((fboundp 'with-memoization)
- `(with-memoization ,table ,@forms)) ; 29.1
- ((fboundp 'cl--generic-with-memoization)
- `(cl--generic-with-memoization ,table ,@forms))
- (t `(progn ,@forms))))
-
(defvar url-irc-function)
+(declare-function url-type "url-parse" (cl-x))
(defun erc-compat--29-browse-url-irc (string &rest _)
(require 'url-irc)
@@ -409,6 +444,28 @@ If START or END is negative, it counts from the end."
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+
+;;;; Misc 28.1
+
+(defvar comint-file-name-quote-list)
+(defvar shell-file-name-quote-list)
+(declare-function shell--parse-pcomplete-arguments "shell" nil)
+
+(defun erc-compat--28-split-string-shell-command (string)
+ (require 'comint)
+ (require 'shell)
+ (with-temp-buffer
+ (insert string)
+ (let ((comint-file-name-quote-list shell-file-name-quote-list))
+ (car (shell--parse-pcomplete-arguments)))))
+
+(defmacro erc-compat--split-string-shell-command (string)
+ ;; Autoloaded in Emacs 28.
+ (list (if (fboundp 'split-string-shell-command)
+ 'split-string-shell-command
+ 'erc-compat--28-split-string-shell-command)
+ string))
+
(provide 'erc-compat)
;;; erc-compat.el ends here
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 4c557e0e0f9..2012bcadae1 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -43,7 +43,7 @@
;; /dcc chat nick - Either accept pending chat offer from nick, or offer
;; DCC chat to nick
;; /dcc close type [nick] - Close DCC connection (SEND/GET/CHAT) with nick
-;; /dcc get [-t][-s] nick [file] - Accept DCC offer from nick
+;; /dcc get [-t][-s] nick [--] file - Accept DCC offer from nick
;; /dcc list - List all DCC offers/connections
;; /dcc send nick file - Offer DCC SEND to nick
@@ -389,12 +389,18 @@ If this is nil, then the current value of
`default-directory' is used."
:type '(choice (const :value nil :tag "Default directory") directory))
;;;###autoload
-(defun erc-cmd-DCC (cmd &rest args)
+(defun erc-cmd-DCC (line &rest compat-args)
"Parser for /dcc command.
This figures out the dcc subcommand and calls the appropriate routine to
handle it. The function dispatched should be named \"erc-dcc-do-FOO-command\",
where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
- (when cmd
+ (let (cmd args)
+ ;; Called as library function (i.e., not directly as /dcc)
+ (if compat-args
+ (setq cmd line
+ args compat-args)
+ (setq args (delete "" (erc-compat--split-string-shell-command line))
+ cmd (pop args)))
(let ((fn (intern-soft (concat "erc-dcc-do-" (upcase cmd) "-command"))))
(if fn
(apply fn erc-server-process args)
@@ -404,8 +410,16 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
(apropos "erc-dcc-do-.*-command")
t))))
+(put 'erc-cmd-DCC 'do-not-parse-args t)
(autoload 'pcomplete-erc-all-nicks "erc-pcomplete")
+;;;###autoload(put 'erc-cmd-DCC 'erc--cmd-help 'erc-dcc--cmd-help)
+(defun erc-dcc--cmd-help (&rest args)
+ (describe-function
+ (or (and args (intern-soft (concat "erc-dcc-do-"
+ (upcase (car args)) "-command")))
+ 'erc-cmd-DCC)))
+
;;;###autoload
(defun pcomplete/erc-mode/DCC ()
"Provide completion for the /DCC command."
@@ -430,15 +444,20 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
(eq (plist-get elt :type) 'GET))
erc-dcc-list)))
('send (pcomplete-erc-all-nicks))))
+ (when (equal "get" (downcase (pcomplete-arg 'first 1)))
+ (pcomplete-opt "-"))
(pcomplete-here
(pcase (intern (downcase (pcomplete-arg 'first 1)))
- ('get (mapcar (lambda (elt) (plist-get elt :file))
+ ('get (mapcar (lambda (elt)
+ (combine-and-quote-strings (list (plist-get elt :file))))
(cl-remove-if-not
(lambda (elt)
(and (eq (plist-get elt :type) 'GET)
(erc-nick-equal-p (erc-extract-nick
(plist-get elt :nick))
- (pcomplete-arg 1))))
+ (pcase (pcomplete-arg 1)
+ ("--" (pcomplete-arg 2))
+ (v v)))))
erc-dcc-list)))
('close (mapcar #'erc-dcc-nick
(cl-remove-if-not
@@ -504,16 +523,33 @@ At least one of TYPE and NICK must be provided."
?n (erc-extract-nick (plist-get ret :nick))))))
t))
-(defun erc-dcc-do-GET-command (proc nick &rest file)
- "Do a DCC GET command. NICK is the person who is sending the file.
-FILE is the filename. If FILE is split into multiple arguments,
-re-join the arguments, separated by a space.
-PROC is the server process."
- (let* ((args (seq-group-by (lambda (s) (eq ?- (aref s 0))) (cons nick file)))
+(defun erc-dcc-do-GET-command (proc &rest args)
+ "Perform a DCC GET command.
+Recognize input conforming to the following usage syntax:
+
+ /DCC GET [-t|-s] nick [--] filename
+
+ nick The person who is sending the file.
+ filename The filename to be downloaded. Can be split into multiple
+ arguments that are then joined by a space.
+ flags \"-t\" sets `:turbo' in `erc-dcc-list'
+ \"-s\" sets `:secure' in `erc-dcc-list'
+ \"--\" indicates end of options
+ All of which are optional.
+
+Expect PROC to be the server process and ARGS to contain
+everything after the subcommand \"GET\" in the usage description
+above."
+ ;; Despite the advertised syntax above, we currently respect flags
+ ;; in these positions: [flag] nick [flag] filename [flag]
+ (let* ((trailing (and-let* ((trailing (member "--" args)))
+ (setq args (butlast args (length trailing)))
+ (cdr trailing)))
+ (args (seq-group-by (lambda (s) (eq ?- (aref s 0))) args))
(flags (prog1 (cdr (assq t args))
- (setq args (cdr (assq nil args))
- nick (pop args)
- file (and args (mapconcat #'identity args " ")))))
+ (setq args (nconc (cdr (assq nil args)) trailing))))
+ (nick (pop args))
+ (file (and args (mapconcat #'identity args " ")))
(elt (erc-dcc-member :nick nick :type 'GET :file file))
(filename (or file (plist-get elt :file) "unknown")))
(if elt
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e10b7d790f6..c29d292abce 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -28,6 +28,9 @@
;; `erc-fill-mode' to switch it on. Customize `erc-fill-function' to
;; change the style.
+;; TODO: redo `erc-fill-wrap-nudge' using transient after ERC drops
+;; support for Emacs 27.
+
;;; Code:
(require 'erc)
@@ -38,30 +41,18 @@
:group 'erc)
;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t)
-(define-minor-mode erc-fill-mode
- "Toggle ERC fill mode.
-With a prefix argument ARG, enable ERC fill mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
+(define-erc-module fill nil
+ "Manage filling in ERC buffers.
ERC fill mode is a global minor mode. When enabled, messages in
the channel buffers are filled."
- :global t
- (if erc-fill-mode
- (erc-fill-enable)
- (erc-fill-disable)))
-
-(defun erc-fill-enable ()
- "Setup hooks for `erc-fill-mode'."
- (interactive)
- (add-hook 'erc-insert-modify-hook #'erc-fill)
- (add-hook 'erc-send-modify-hook #'erc-fill))
-
-(defun erc-fill-disable ()
- "Cleanup hooks, disable `erc-fill-mode'."
- (interactive)
- (remove-hook 'erc-insert-modify-hook #'erc-fill)
- (remove-hook 'erc-send-modify-hook #'erc-fill))
+ ;; FIXME ensure a consistent ordering relative to hook members from
+ ;; other modules. Ideally, this module's processing should happen
+ ;; after "morphological" modifications to a message's text but
+ ;; before superficial decorations.
+ ((add-hook 'erc-insert-modify-hook #'erc-fill)
+ (add-hook 'erc-send-modify-hook #'erc-fill))
+ ((remove-hook 'erc-insert-modify-hook #'erc-fill)
+ (remove-hook 'erc-send-modify-hook #'erc-fill)))
(defcustom erc-fill-prefix nil
"Values used as `fill-prefix' for `erc-fill-variable'.
@@ -91,16 +82,29 @@ Static Filling with `erc-fill-static-center' of 27:
These two styles are implemented using `erc-fill-variable' and
`erc-fill-static'. You can, of course, define your own filling
function. Narrowing to the region in question is in effect while your
-function is called."
+function is called.
+
+A third style resembles static filling but \"wraps\" instead of
+fills, thanks to `visual-line-mode' mode, which ERC automatically
+enables when this option is `erc-fill-wrap' or when
+`erc-fill-wrap-mode' is active. Set `erc-fill-static-center' to
+your preferred initial \"prefix\" width. For adjusting the width
+during a session, see the command `erc-fill-wrap-nudge'."
:type '(choice (const :tag "Variable Filling" erc-fill-variable)
(const :tag "Static Filling" erc-fill-static)
+ (const :tag "Dynamic word-wrap" erc-fill-wrap)
function))
(defcustom erc-fill-static-center 27
- "Column around which all statically filled messages will be centered.
-This column denotes the point where the ` ' character between
-<nickname> and the entered text will be put, thus aligning nick
-names right and text left."
+ "Number of columns to \"outdent\" the first line of a message.
+During early message handing, ERC prepends a span of
+non-whitespace characters to every message, such as a bracketed
+\"<nickname>\" or an `erc-notice-prefix'. The
+`erc-fill-function' variants `erc-fill-static' and
+`erc-fill-wrap' look to this option to determine the amount of
+padding to apply to that portion until the filled (or wrapped)
+message content aligns with the indicated column. See also
+https://en.wikipedia.org/wiki/Hanging_indent.";
:type 'integer)
(defcustom erc-fill-variable-maximum-indentation 17
@@ -130,7 +134,7 @@ You can put this on `erc-insert-modify-hook' and/or
`erc-send-modify-hook'."
(defun erc-fill-static ()
"Fills a text such that messages start at column `erc-fill-static-center'."
- (save-match-data
+ (save-restriction
(goto-char (point-min))
(looking-at "^\\(\\S-+\\)")
(let ((nick (match-string 1)))
@@ -167,6 +171,326 @@ You can put this on `erc-insert-modify-hook' and/or
`erc-send-modify-hook'."
(erc-fill-regarding-timestamp))))
(erc-restore-text-properties)))
+(defvar-local erc-fill--wrap-value nil)
+(defvar-local erc-fill--wrap-visual-keys nil)
+
+(defcustom erc-fill-wrap-use-pixels t
+ "Whether to calculate padding in pixels when possible.
+A value of nil means ERC should use columns, which may happen
+regardless, depending on the Emacs version. This option only
+matters when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type 'boolean)
+
+(defcustom erc-fill-wrap-visual-keys 'non-input
+ "Whether to retain keys defined by `visual-line-mode'.
+A value of t tells ERC to use movement commands defined by
+`visual-line-mode' everywhere in an ERC buffer along with visual
+editing commands in the input area. A value of nil means to
+never do so. A value of `non-input' tells ERC to act like the
+value is nil in the input area and t elsewhere. This option only
+plays a role when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const nil) (const t) (const non-input)))
+
+(defcustom erc-fill-wrap-merge t
+ "Whether to consolidate messages from the same speaker.
+This tells ERC to omit redundant speaker labels for subsequent
+messages less than a day apart."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type 'boolean)
+
+(defun erc-fill--wrap-move (normal-cmd visual-cmd arg)
+ (funcall (pcase erc-fill--wrap-visual-keys
+ ('non-input
+ (if (>= (point) erc-input-marker) normal-cmd visual-cmd))
+ ('t visual-cmd)
+ (_ normal-cmd))
+ arg))
+
+(defun erc-fill--wrap-kill-line (arg)
+ "Defer to `kill-line' or `kill-visual-line'."
+ (interactive "P")
+ ;; ERC buffers are read-only outside of the input area, but we run
+ ;; `kill-line' anyway so that users can see the error.
+ (erc-fill--wrap-move #'kill-line #'kill-visual-line arg))
+
+(defun erc-fill--wrap-beginning-of-line (arg)
+ "Defer to `move-beginning-of-line' or `beginning-of-visual-line'."
+ (interactive "^p")
+ (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)))
+
+(defun erc-fill--wrap-end-of-line (arg)
+ "Defer to `move-end-of-line' or `end-of-visual-line'."
+ (interactive "^p")
+ (erc-fill--wrap-move #'move-end-of-line #'end-of-visual-line arg))
+
+(defun erc-fill-wrap-cycle-visual-movement (arg)
+ "Cycle through `erc-fill-wrap-visual-keys' styles ARG times.
+Go from nil to t to `non-input' and back around, but set internal
+state instead of mutating `erc-fill-wrap-visual-keys'. When ARG
+is 0, reset to value of `erc-fill-wrap-visual-keys'."
+ (interactive "^p")
+ (when (zerop arg)
+ (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys))
+ (while (not (zerop arg))
+ (cl-incf arg (- (abs arg)))
+ (setq erc-fill--wrap-visual-keys (pcase erc-fill--wrap-visual-keys
+ ('nil t)
+ ('t 'non-input)
+ ('non-input nil))))
+ (message "erc-fill-wrap movement: %S" erc-fill--wrap-visual-keys))
+
+(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
+ :doc "Keymap for ERC's `fill-wrap' module."
+ :parent visual-line-mode-map
+ "<remap> <kill-line>" #'erc-fill--wrap-kill-line
+ "<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
+ "<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
+ "C-c a" #'erc-fill-wrap-cycle-visual-movement
+ ;; Not sure if this is problematic because `erc-bol' takes no args.
+ "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
+
+(defvar erc-match-mode)
+(defvar erc-button-mode)
+(defvar erc-match--hide-fools-offset-bounds)
+
+(defun erc-fill--make-module-dependency-msg (module)
+ (concat "Enabling default global module `" module "' needed by local"
+ " module `fill-wrap'. This will impact \C-]all\C-] ERC"
+ " sessions. Add `" module "' to `erc-modules' to avoid this"
+ " warning. See Info:\"(erc) Modules\" for more."))
+
+;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill)
+(define-erc-module fill-wrap nil
+ "Fill style leveraging `visual-line-mode'.
+This module displays nickname labels for speakers as overhanging
+leftward (and thus right-aligned) to a common offset, as
+determined by the option `erc-fill-static-center'. It depends on
+the `fill' and `button' modules and assumes the option
+`erc-insert-timestamp-function' is `erc-insert-timestamp-right'
+or `erc-insert-timestamp-left-and-right' (recommended) so that it
+can display right-hand stamps in the right margin. A value of
+`erc-insert-timestamp-left' is unsupported. This local module
+depends on the global `fill' module. To use it, either include
+`fill-wrap' in `erc-modules' or set `erc-fill-function' to
+`erc-fill-wrap' (recommended). You can also manually invoke one
+of the minor-mode toggles as usual."
+ ((let (msg)
+ (unless erc-fill-mode
+ (unless (memq 'fill erc-modules)
+ (setq msg
+ ;; FIXME use `erc-button--display-error-notice-with-keys'
+ ;; when bug#60933 is ready.
+ (erc-fill--make-module-dependency-msg "fill")))
+ (erc-fill-mode +1))
+ (when erc-fill-wrap-merge
+ (require 'erc-button)
+ (unless erc-button-mode
+ (unless (memq 'button erc-modules)
+ (setq msg (concat msg (and msg " ")
+ (erc-fill--make-module-dependency-msg "button"))))
+ (erc-with-server-buffer
+ (erc-button-mode +1))))
+ ;; 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))
+ (when-let* ((vars (or erc--server-reconnecting erc--target-priors))
+ ((alist-get 'erc-fill-wrap-mode vars)))
+ (setq erc-fill--wrap-visual-keys (alist-get 'erc-fill--wrap-visual-keys
+ vars)
+ erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars)))
+ (add-function :filter-args (local 'erc-stamp--insert-date-function)
+ #'erc-fill--wrap-stamp-insert-prefixed-date)
+ (when (or erc-stamp-mode (memq 'stamp erc-modules))
+ (erc-stamp--display-margin-mode +1))
+ (when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules))
+ (require 'erc-match)
+ (setq erc-match--hide-fools-offset-bounds t))
+ (setq erc-fill--wrap-value
+ (or erc-fill--wrap-value erc-fill-static-center))
+ (visual-line-mode +1)
+ (unless (local-variable-p 'erc-fill--wrap-visual-keys)
+ (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys))
+ (when msg
+ (erc-display-error-notice nil msg))))
+ ((when erc-stamp--display-margin-mode
+ (erc-stamp--display-margin-mode -1))
+ (kill-local-variable 'erc-fill--wrap-value)
+ (kill-local-variable 'erc-fill-function)
+ (kill-local-variable 'erc-fill--wrap-visual-keys)
+ (remove-function (local 'erc-stamp--insert-date-function)
+ #'erc-fill--wrap-stamp-insert-prefixed-date)
+ (visual-line-mode -1))
+ 'local)
+
+(defvar-local erc-fill--wrap-length-function nil
+ "Function to determine length of overhanging characters.
+It should return an EXPR as defined by the Info node `(elisp)
+Pixel Specification'. This value should represent the width of
+the overhang with all faces applied, including any enclosing
+brackets (which are not normally fontified) and a trailing space.
+It can also return nil to tell ERC to fall back to the default
+behavior of taking the length from the first \"word\". This
+variable can be converted to a public one if needed by third
+parties.")
+
+(defvar-local erc-fill--wrap-last-msg nil)
+(defvar-local erc-fill--wrap-max-lull (* 24 60 60))
+
+(defun erc-fill--wrap-continued-message-p ()
+ (prog1 (and-let*
+ ((m (or erc-fill--wrap-last-msg
+ (setq erc-fill--wrap-last-msg (point-min-marker))
+ nil))
+ ((< (1+ (point-min)) (- (point) 2)))
+ (props (save-restriction
+ (widen)
+ (when (eq 'erc-timestamp (field-at-pos m))
+ (set-marker m (field-end m)))
+ (and (eq 'PRIVMSG (get-text-property m 'erc-command))
+ (not (eq (get-text-property m 'font-lock-face)
+ 'erc-action-face))
+ (cons (get-text-property m 'erc-timestamp)
+ (get-text-property (1+ m) 'erc-data)))))
+ (ts (pop props))
+ ((not (time-less-p (erc-stamp--current-time) ts)))
+ ((time-less-p (time-subtract (erc-stamp--current-time) ts)
+ erc-fill--wrap-max-lull))
+ (nick (buffer-substring-no-properties
+ (1+ (point-min)) (- (point) 2)))
+ ((equal (car props) (erc-downcase nick)))))
+ (set-marker erc-fill--wrap-last-msg (point-min))))
+
+(defun erc-fill--wrap-stamp-insert-prefixed-date (args)
+ "Apply `line-prefix' property to args."
+ (let* ((ts-left (car args)))
+ (put-text-property 0 (length ts-left) 'line-prefix
+ `(space :width
+ (- erc-fill--wrap-value
+ ,(length (string-trim-left ts-left))))
+ ts-left))
+ args)
+
+(defun erc-fill-wrap ()
+ "Use text props to mimic the effect of `erc-fill-static'.
+See `erc-fill-wrap-mode' for details."
+ (unless erc-fill-wrap-mode
+ (erc-fill-wrap-mode +1))
+ (save-excursion
+ (goto-char (point-min))
+ (let ((len (or (and erc-fill--wrap-length-function
+ (funcall erc-fill--wrap-length-function))
+ (progn
+ (skip-syntax-forward "^-")
+ (forward-char)
+ (cond ((and erc-fill-wrap-merge
+ (erc-fill--wrap-continued-message-p))
+ (put-text-property (point-min) (point)
+ 'display "")
+ 0)
+ ((and erc-fill-wrap-use-pixels
+ (fboundp 'buffer-text-pixel-size))
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (list (car (buffer-text-pixel-size)))))
+ (t (- (point) (point-min))))))))
+ ;; Leaving out the final newline doesn't seem to affect anything.
+ (erc-put-text-properties (point-min) (point-max)
+ '(line-prefix wrap-prefix) nil
+ `((space :width (- erc-fill--wrap-value ,len))
+ (space :width erc-fill--wrap-value))))))
+
+;; 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
+;; case would be to fix lines affected by toggling a display-oriented
+;; mode, like `display-line-numbers-mode'.
+
+(defun erc-fill--wrap-fix (&optional value)
+ "Re-wrap from `point-min' to `point-max'.
+That is, recalculate the width of all accessible lines and reset
+local prefix VALUE when non-nil."
+ (save-excursion
+ (when value
+ (setq erc-fill--wrap-value value))
+ (let ((inhibit-field-text-motion t)
+ (inhibit-read-only t))
+ (goto-char (point-min))
+ (while (and (zerop (forward-line))
+ (< (point) (min (point-max) erc-insert-marker)))
+ (save-restriction
+ (narrow-to-region (line-beginning-position) (line-end-position))
+ (erc-fill-wrap))))))
+
+(defun erc-fill--wrap-nudge (arg)
+ (when (zerop arg)
+ (setq arg (- erc-fill-static-center erc-fill--wrap-value)))
+ (cl-incf erc-fill--wrap-value arg)
+ arg)
+
+(defun erc-fill-wrap-nudge (arg)
+ "Adjust `erc-fill-wrap' by ARG columns.
+Offer to repeat command in a manner similar to
+`text-scale-adjust'.
+
+ \\`=' Increase indentation by one column
+ \\`-' Decrease indentation by one column
+ \\`0' Reset indentation to the default
+ \\`+' Shift right margin rightward (shrink) by one column
+ \\`_' Shift right margin leftward (grow) by one column
+ \\`)' Reset the right margin to the default
+
+Note that misalignment may occur when messages contain
+decorations applied by third-party modules. See
+`erc-fill--wrap-fix' for a temporary workaround."
+ (interactive "p")
+ (unless erc-fill--wrap-value
+ (cl-assert (not erc-fill-wrap-mode))
+ (user-error "Minor mode `erc-fill-wrap-mode' disabled"))
+ (unless (get-buffer-window)
+ (user-error "Command called in an undisplayed buffer"))
+ (let* ((total (erc-fill--wrap-nudge arg))
+ (win-ratio (/ (float (- (window-point) (window-start)))
+ (- (window-end nil t) (window-start)))))
+ (when (zerop arg)
+ (setq arg 1))
+ (erc-compat-call
+ set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (key '(?= ?- ?0))
+ (let ((a (pcase key
+ (?0 0)
+ (?- (- (abs arg)))
+ (_ (abs arg)))))
+ (define-key map (vector (list key))
+ (lambda ()
+ (interactive)
+ (cl-incf total (erc-fill--wrap-nudge a))
+ (recenter (round (* win-ratio (window-height))))))))
+ (dolist (key '(?\) ?_ ?+))
+ (let ((a (pcase key
+ (?\) 0)
+ (?_ (- (abs arg)))
+ (?+ (abs arg)))))
+ (define-key map (vector (list key))
+ (lambda ()
+ (interactive)
+ (erc-stamp--adjust-right-margin (- a))
+ (recenter (round (* win-ratio (window-height))))))))
+ map)
+ t
+ (lambda ()
+ (message "Fill prefix: %d (%+d col%s)"
+ erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
+ "Use %k for further adjustment"
+ 1)
+ (recenter (round (* win-ratio (window-height))))))
+
(defun erc-fill-regarding-timestamp ()
"Fills a text such that messages start at column `erc-fill-static-center'."
(fill-region (point-min) (point-max) t t)
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 05a21019042..6235de5f1c0 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -29,30 +29,13 @@
;;; Code:
-;;; Imenu support
-
(eval-when-compile (require 'cl-lib))
-(require 'erc-common)
-
-(defvar erc-controls-highlight-regexp)
-(defvar erc-controls-remove-regexp)
-(defvar erc-input-marker)
-(defvar erc-insert-marker)
-(defvar erc-server-process)
-(defvar erc-modules)
-(defvar erc-log-p)
-
-(declare-function erc-buffer-list "erc" (&optional predicate proc))
-(declare-function erc-error "erc" (&rest args))
-(declare-function erc-extract-command-from-line "erc" (line))
-(declare-function erc-beg-of-input-line "erc" nil)
+(require 'erc)
-(defun erc-imenu-setup ()
- "Setup Imenu support in an ERC buffer."
- (setq-local imenu-create-index-function #'erc-create-imenu-index))
+(declare-function fringe-columns "fringe" (side &optional real))
+(declare-function pulse-available-p "pulse" nil)
+(declare-function pulse-momentary-highlight-overlay "pulse" (o &optional face))
-(add-hook 'erc-mode-hook #'erc-imenu-setup)
-(autoload 'erc-create-imenu-index "erc-imenu" "Imenu index creation function")
;;; Automatically scroll to bottom
(defcustom erc-input-line-position nil
@@ -65,6 +48,7 @@ argument to `recenter'."
:group 'erc-display
:type '(choice integer (const nil)))
+;;;###autoload(autoload 'erc-scrolltobottom-mode "erc-goodies" nil t)
(define-erc-module scrolltobottom nil
"This mode causes the prompt to stay at the end of the window."
((add-hook 'erc-mode-hook #'erc-add-scroll-to-bottom)
@@ -116,6 +100,7 @@ variable `erc-input-line-position'."
(recenter (or erc-input-line-position -1)))))))
;;; Make read only
+;;;###autoload(autoload 'erc-readonly-mode "erc-goodies" nil t)
(define-erc-module readonly nil
"This mode causes all inserted text to be read-only."
((add-hook 'erc-insert-post-hook #'erc-make-read-only)
@@ -131,6 +116,7 @@ Put this function on `erc-insert-post-hook' and/or
`erc-send-post-hook'."
(put-text-property (point-min) (point-max) 'rear-nonsticky t))
;;; Move to prompt when typing text
+;;;###autoload(autoload 'erc-move-to-prompt-mode "erc-goodies" nil t)
(define-erc-module move-to-prompt nil
"This mode causes the point to be moved to the prompt when typing text."
((add-hook 'erc-mode-hook #'erc-move-to-prompt-setup)
@@ -155,11 +141,160 @@ Put this function on `erc-insert-post-hook' and/or
`erc-send-post-hook'."
(add-hook 'pre-command-hook #'erc-move-to-prompt nil t))
;;; Keep place in unvisited channels
+;;;###autoload(autoload 'erc-keep-place-mode "erc-goodies" nil t)
(define-erc-module keep-place nil
"Leave point above un-viewed text in other channels."
((add-hook 'erc-insert-pre-hook #'erc-keep-place))
((remove-hook 'erc-insert-pre-hook #'erc-keep-place)))
+(defcustom erc-keep-place-indicator-style t
+ "Flavor of visual indicator applied to kept place.
+For use with the `keep-place-indicator' module. A value of `arrow'
+displays an arrow in the left fringe or margin. When it's
+`face', ERC adds the face `erc-keep-place-indicator-line' to the
+appropriate line. A value of t does both."
+ :group 'erc
+ :package-version '(ERC . "5.6")
+ :type '(choice (const t) (const server) (const target)))
+
+(defcustom erc-keep-place-indicator-buffer-type t
+ "ERC buffer type in which to display `keep-place-indicator'.
+A value of t means \"all\" ERC buffers."
+ :group 'erc
+ :package-version '(ERC . "5.6")
+ :type '(choice (const t) (const server) (const target)))
+
+(defcustom erc-keep-place-indicator-follow nil
+ "Whether to sync visual kept place to window's top when reading.
+For use with `erc-keep-place-indicator-mode'."
+ :group 'erc
+ :package-version '(ERC . "5.6")
+ :type 'boolean)
+
+(defface erc-keep-place-indicator-line
+ '((((class color) (min-colors 88) (background light)
+ (supports :underline (:style wave)))
+ (:underline (:color "PaleGreen3" :style wave)))
+ (((class color) (min-colors 88) (background dark)
+ (supports :underline (:style wave)))
+ (:underline (:color "PaleGreen1" :style wave)))
+ (t :underline t))
+ "Face for option `erc-keep-place-indicator-style'."
+ :group 'erc-faces)
+
+(defface erc-keep-place-indicator-arrow
+ '((((class color) (min-colors 88) (background light))
+ (:foreground "PaleGreen3"))
+ (((class color) (min-colors 88) (background dark))
+ (:foreground "PaleGreen1"))
+ (t :inherit fringe))
+ "Face for arrow value of option `erc-keep-place-indicator-style'."
+ :group 'erc-faces)
+
+(defvar-local erc--keep-place-indicator-overlay nil
+ "Overlay for `erc-keep-place-indicator-mode'.")
+
+(defun erc--keep-place-indicator-on-window-configuration-change ()
+ "Maybe sync `erc--keep-place-indicator-overlay'.
+Specifically, do so unless switching to or from another window in
+the active frame."
+ (when erc-keep-place-indicator-follow
+ (unless (or (minibuffer-window-active-p (minibuffer-window))
+ (eq (window-old-buffer) (current-buffer)))
+ (when (< (overlay-end erc--keep-place-indicator-overlay)
+ (window-start)
+ erc-insert-marker)
+ (erc-keep-place-move (window-start))))))
+
+(defun erc--keep-place-indicator-setup ()
+ "Initialize buffer for maintaining `erc--keep-place-indicator-overlay'."
+ (require 'fringe)
+ (setq erc--keep-place-indicator-overlay
+ (if-let* ((vars (or erc--server-reconnecting erc--target-priors))
+ ((alist-get 'erc-keep-place-indicator-mode vars)))
+ (alist-get 'erc--keep-place-indicator-overlay vars)
+ (make-overlay 0 0)))
+ (add-hook 'window-configuration-change-hook
+ #'erc--keep-place-indicator-on-window-configuration-change nil t)
+ (when-let* (((memq erc-keep-place-indicator-style '(t arrow)))
+ (display (if (zerop (fringe-columns 'left))
+ `((margin left-margin) ,overlay-arrow-string)
+ '(left-fringe right-triangle
+ erc-keep-place-indicator-arrow)))
+ (bef (propertize " " 'display display)))
+ (overlay-put erc--keep-place-indicator-overlay 'before-string bef))
+ (when (memq erc-keep-place-indicator-style '(t face))
+ (overlay-put erc--keep-place-indicator-overlay 'face
+ 'erc-keep-place-indicator-line)))
+
+;;;###autoload(put 'keep-place-indicator 'erc--feature 'erc-goodies)
+(define-erc-module keep-place-indicator nil
+ "`keep-place' with a fringe arrow and/or highlighted face."
+ ((unless erc-keep-place-mode
+ (unless (memq 'keep-place erc-modules)
+ ;; FIXME use `erc-button--display-error-notice-with-keys'
+ ;; to display this message when bug#60933 is ready.
+ (erc-display-error-notice
+ nil (concat
+ "Local module `keep-place-indicator' needs module `keep-place'."
+ " Enabling now. This will affect \C-]all\C-] ERC sessions."
+ " Add `keep-place' to `erc-modules' to silence this message.")))
+ (erc-keep-place-mode +1))
+ (if (pcase erc-keep-place-indicator-buffer-type
+ ('target erc--target)
+ ('server (not erc--target))
+ ('t t))
+ (erc--keep-place-indicator-setup)
+ (setq erc-keep-place-indicator-mode nil)))
+ ((when erc--keep-place-indicator-overlay
+ (delete-overlay erc--keep-place-indicator-overlay)
+ (remove-hook 'window-configuration-change-hook
+ #'erc--keep-place-indicator-on-window-configuration-change t)
+ (kill-local-variable 'erc--keep-place-indicator-overlay)))
+ 'local)
+
+(defun erc-keep-place-move (pos)
+ "Move keep-place indicator to current line or POS.
+For use with `keep-place-indicator' module. When called
+interactively, interpret POS as an offset. Specifically, when
+POS is a raw prefix arg, like (4), move the indicator to the
+window's last line. When it's the minus sign, put it on the
+window's first line. Interpret an integer as an offset in lines."
+ (interactive
+ (progn
+ (unless erc-keep-place-indicator-mode
+ (user-error "`erc-keep-place-indicator-mode' not enabled"))
+ (list (pcase current-prefix-arg
+ ((and (pred integerp) v)
+ (save-excursion
+ (let ((inhibit-field-text-motion t))
+ (forward-line v)
+ (point))))
+ (`(,_) (1- (min erc-insert-marker (window-end))))
+ ('- (min (1- erc-insert-marker) (window-start)))))))
+ (save-excursion
+ (let ((inhibit-field-text-motion t))
+ (when pos
+ (goto-char pos))
+ (move-overlay erc--keep-place-indicator-overlay
+ (line-beginning-position)
+ (line-end-position)))))
+
+(defun erc-keep-place-goto ()
+ "Jump to keep-place indicator.
+For use with `keep-place-indicator' module."
+ (interactive
+ (prog1 nil
+ (unless erc-keep-place-indicator-mode
+ (user-error "`erc-keep-place-indicator-mode' not enabled"))
+ (deactivate-mark)
+ (push-mark)))
+ (goto-char (overlay-start erc--keep-place-indicator-overlay))
+ (recenter (truncate (* (window-height) 0.25)) t)
+ (require 'pulse)
+ (when (pulse-available-p)
+ (pulse-momentary-highlight-overlay erc--keep-place-indicator-overlay)))
+
(defun erc-keep-place (_ignored)
"Move point away from the last line in a non-selected ERC buffer."
(when (and (not (eq (window-buffer (selected-window))
@@ -168,6 +303,11 @@ Put this function on `erc-insert-post-hook' and/or
`erc-send-post-hook'."
(deactivate-mark)
(goto-char (erc-beg-of-input-line))
(forward-line -1)
+ (when erc-keep-place-indicator-mode
+ (unless (or (minibuffer-window-active-p (selected-window))
+ (and (frame-visible-p (selected-frame))
+ (get-buffer-window (current-buffer) (selected-frame))))
+ (erc-keep-place-move nil)))
;; if `switch-to-buffer-preserve-window-point' is set,
;; we cannot rely on point being saved, and must commit
;; it to window-prev-buffers.
@@ -193,6 +333,7 @@ Put this function on `erc-insert-post-hook' and/or
`erc-send-post-hook'."
If a command's function symbol is in this list, the typed command
does not appear in the ERC buffer after the user presses ENTER.")
+;;;###autoload(autoload 'erc-noncommands-mode "erc-goodies" nil t)
(define-erc-module noncommands nil
"This mode distinguishes non-commands.
Commands listed in `erc-insert-this' know how to display
@@ -251,6 +392,12 @@ The value `erc-interpret-controls-p' must also be t for
this to work."
"ERC inverse face."
:group 'erc-faces)
+(defface erc-spoiler-face
+ '((((background light)) :foreground "DimGray" :background "DimGray")
+ (((background dark)) :foreground "LightGray" :background "LightGray"))
+ "ERC spoiler face."
+ :group 'erc-faces)
+
(defface erc-underline-face '((t :underline t))
"ERC underline face."
:group 'erc-faces)
@@ -353,19 +500,38 @@ The value `erc-interpret-controls-p' must also be t for
this to work."
"ERC face."
:group 'erc-faces)
+;; https://lists.gnu.org/archive/html/emacs-erc/2021-07/msg00005.html
+(defvar erc--controls-additional-colors
+ ["#470000" "#472100" "#474700" "#324700" "#004700" "#00472c"
+ "#004747" "#002747" "#000047" "#2e0047" "#470047" "#47002a"
+ "#740000" "#743a00" "#747400" "#517400" "#007400" "#007449"
+ "#007474" "#004074" "#000074" "#4b0074" "#740074" "#740045"
+ "#b50000" "#b56300" "#b5b500" "#7db500" "#00b500" "#00b571"
+ "#00b5b5" "#0063b5" "#0000b5" "#7500b5" "#b500b5" "#b5006b"
+ "#ff0000" "#ff8c00" "#ffff00" "#b2ff00" "#00ff00" "#00ffa0"
+ "#00ffff" "#008cff" "#0000ff" "#a500ff" "#ff00ff" "#ff0098"
+ "#ff5959" "#ffb459" "#ffff71" "#cfff60" "#6fff6f" "#65ffc9"
+ "#6dffff" "#59b4ff" "#5959ff" "#c459ff" "#ff66ff" "#ff59bc"
+ "#ff9c9c" "#ffd39c" "#ffff9c" "#e2ff9c" "#9cff9c" "#9cffdb"
+ "#9cffff" "#9cd3ff" "#9c9cff" "#dc9cff" "#ff9cff" "#ff94d3"
+ "#000000" "#131313" "#282828" "#363636" "#4d4d4d" "#656565"
+ "#818181" "#9f9f9f" "#bcbcbc" "#e2e2e2" "#ffffff"])
+
(defun erc-get-bg-color-face (n)
"Fetches the right face for background color N (0-15)."
(if (stringp n) (setq n (string-to-number n)))
(if (not (numberp n))
(prog1 'default
(erc-error "erc-get-bg-color-face: n is NaN: %S" n))
- (when (> n 16)
+ (when (> n 99)
(erc-log (format " Wrong color: %s" n))
(setq n (mod n 16)))
(cond
((and (>= n 0) (< n 16))
(intern (concat "bg:erc-color-face" (number-to-string n))))
- (t (erc-log (format " Wrong color: %s" n)) 'default))))
+ ((< 15 n 99)
+ (list :background (aref erc--controls-additional-colors (- n 16))))
+ (t (erc-log (format " Wrong color: %s" n)) '(default)))))
(defun erc-get-fg-color-face (n)
"Fetches the right face for foreground color N (0-15)."
@@ -373,20 +539,44 @@ The value `erc-interpret-controls-p' must also be t for
this to work."
(if (not (numberp n))
(prog1 'default
(erc-error "erc-get-fg-color-face: n is NaN: %S" n))
- (when (> n 16)
+ (when (> n 99)
(erc-log (format " Wrong color: %s" n))
(setq n (mod n 16)))
(cond
((and (>= n 0) (< n 16))
(intern (concat "fg:erc-color-face" (number-to-string n))))
- (t (erc-log (format " Wrong color: %s" n)) 'default))))
+ ((< 15 n 99)
+ (list :foreground (aref erc--controls-additional-colors (- n 16))))
+ (t (erc-log (format " Wrong color: %s" n)) '(default)))))
+;;;###autoload(autoload 'erc-irccontrols-mode "erc-goodies" nil t)
(define-erc-module irccontrols nil
"This mode enables the interpretation of IRC control chars."
((add-hook 'erc-insert-modify-hook #'erc-controls-highlight)
- (add-hook 'erc-send-modify-hook #'erc-controls-highlight))
+ (add-hook 'erc-send-modify-hook #'erc-controls-highlight)
+ (erc--modify-local-map t "C-c C-c" #'erc-toggle-interpret-controls))
((remove-hook 'erc-insert-modify-hook #'erc-controls-highlight)
- (remove-hook 'erc-send-modify-hook #'erc-controls-highlight)))
+ (remove-hook 'erc-send-modify-hook #'erc-controls-highlight)
+ (erc--modify-local-map nil "C-c C-c" #'erc-toggle-interpret-controls)))
+
+;; These patterns were moved here to circumvent compiler warnings but
+;; otherwise translated verbatim from their original string-literal
+;; definitions (minus a small bug fix to satisfy newly added tests).
+(defvar erc-controls-remove-regexp
+ (rx (or ?\C-b ?\C-\] ?\C-_ ?\C-v ?\C-g ?\C-o
+ (: ?\C-c (? (any "0-9")) (? (any "0-9"))
+ (? (group ?, (any "0-9") (? (any "0-9")))))))
+ "Regular expression matching control characters to remove.")
+
+;; Before the change to `rx', group 3 used to be a sibling of group 2.
+;; This was assumed to be a bug. A few minor simplifications were
+;; also performed. If incorrect, please admonish.
+(defvar erc-controls-highlight-regexp
+ (rx (group (or ?\C-b ?\C-\] ?\C-v ?\C-_ ?\C-g ?\C-o
+ (: ?\C-c (? (group (** 1 2 (any "0-9")))
+ (? (group ?, (group (** 1 2 (any "0-9")))))))))
+ (group (* (not (any ?\C-b ?\C-c ?\C-g ?\n ?\C-o ?\C-v ?\C-\] ?\C-_)))))
+ "Regular expression matching control chars to highlight.")
(defun erc-controls-interpret (str)
"Return a copy of STR after dealing with IRC control characters.
@@ -440,6 +630,7 @@ See `erc-interpret-controls-p' and
`erc-interpret-mirc-color' for options."
s))
(t s)))))
+;;;###autoload
(defun erc-controls-strip (str)
"Return a copy of STR with all IRC control characters removed."
(when str
@@ -448,16 +639,6 @@ See `erc-interpret-controls-p' and
`erc-interpret-mirc-color' for options."
(setq s (replace-match "" nil nil s)))
s)))
-(defvar erc-controls-remove-regexp
-
"\C-b\\|\C-]\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?"
- "Regular expression which matches control characters to remove.")
-
-(defvar erc-controls-highlight-regexp
- (concat "\\(\C-b\\|\C-]\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|"
- "\C-c\\([0-9][0-9]?\\)?\\(,\\([0-9][0-9]?\\)\\)?\\)"
- "\\([^\C-b\C-]\C-v\C-_\C-c\C-g\C-o\n]*\\)")
- "Regular expression which matches control chars and the text to highlight.")
-
(defun erc-controls-highlight ()
"Highlight IRC control chars in the buffer.
This is useful for `erc-insert-modify-hook' and `erc-send-modify-hook'.
@@ -514,6 +695,13 @@ Also see `erc-interpret-controls-p' and
`erc-interpret-mirc-color'."
"Prepend properties from IRC control characters between FROM and TO.
If optional argument STR is provided, apply to STR, otherwise prepend
properties
to a region in the current buffer."
+ (if (and fg bg (equal fg bg))
+ (progn
+ (setq fg 'erc-spoiler-face
+ bg nil)
+ (put-text-property from to 'mouse-face 'erc-inverse-face str))
+ (when fg (setq fg (erc-get-fg-color-face fg)))
+ (when bg (setq bg (erc-get-bg-color-face bg))))
(font-lock-prepend-text-property
from
to
@@ -531,10 +719,10 @@ to a region in the current buffer."
'(erc-underline-face)
nil)
(if fg
- (list (erc-get-fg-color-face fg))
+ (list fg)
nil)
(if bg
- (list (erc-get-bg-color-face bg))
+ (list bg)
nil))
str)
str)
@@ -553,6 +741,7 @@ Else interpretation is turned off."
(if erc-interpret-controls-p "ON" "OFF")))
;; Smiley
+;;;###autoload(autoload 'erc-smiley-mode "erc-goodies" nil t)
(define-erc-module smiley nil
"This mode translates text-smileys such as :-) into pictures.
This requires the function `smiley-region', which is defined in
@@ -569,6 +758,7 @@ This function should be used with `erc-insert-modify-hook'."
(smiley-region (point-min) (point-max))))
;; Unmorse
+;;;###autoload(autoload 'erc-unmorse-mode "erc-goodies" nil t)
(define-erc-module unmorse nil
"This mode causes morse code in the current channel to be unmorsed."
((add-hook 'erc-insert-modify-hook #'erc-unmorse))
@@ -611,3 +801,7 @@ servers. If called from a program, PROC specifies the
server process."
(provide 'erc-goodies)
;;; erc-goodies.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
+;; End:
diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el
index 6699afe36a0..612814ac6da 100644
--- a/lisp/erc/erc-ibuffer.el
+++ b/lisp/erc/erc-ibuffer.el
@@ -32,6 +32,7 @@
(require 'ibuffer)
(require 'ibuf-ext)
(require 'erc)
+(require 'erc-goodies) ; `erc-controls-interpret'
(defgroup erc-ibuffer nil
"The Ibuffer group for ERC."
diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el
index 6223cd3d06f..526afd32249 100644
--- a/lisp/erc/erc-imenu.el
+++ b/lisp/erc/erc-imenu.el
@@ -52,7 +52,8 @@ Don't rely on this function, read it first!"
(forward-line 1)
(looking-at " "))
(forward-line 1))
- (end-of-line) (point)))))
+ (end-of-line) (point))))
+ (inhibit-read-only t))
(with-temp-buffer
(insert str)
(goto-char (point-min))
@@ -124,6 +125,26 @@ Don't rely on this function, read it first!"
index-alist))
index-alist))
+(defvar-local erc-imenu--create-index-function nil
+ "Previous local value of `imenu-create-index-function', if any.")
+
+(defun erc-imenu-setup ()
+ "Wire up support for Imenu in an ERC buffer."
+ (when (and (local-variable-p 'imenu-create-index-function)
+ imenu-create-index-function)
+ (setq erc-imenu--create-index-function imenu-create-index-function))
+ (setq imenu-create-index-function #'erc-create-imenu-index))
+
+;;;###autoload(autoload 'erc-imenu-mode "erc-imenu" nil t)
+(define-erc-module imenu nil
+ "Simple Imenu integration for ERC."
+ ((add-hook 'erc-mode-hook #'erc-imenu-setup))
+ ((remove-hook 'erc-mode-hook #'erc-imenu-setup)
+ (erc-with-all-buffers-of-server erc-server-process nil
+ (when erc-imenu--create-index-function
+ (setq imenu-create-index-function erc-imenu--create-index-function)
+ (kill-local-variable 'erc-imenu--create-index-function)))))
+
(provide 'erc-imenu)
;;; erc-imenu.el ends here
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index 2cb9031640d..2b58a7c56ed 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -198,6 +198,7 @@ This should ideally, be a \"catch-all\" coding system, like
The function should take one argument, which is the text to filter."
:type '(choice (function "Function")
+ (function-item erc-stamp-prefix-log-filter)
(const :tag "No filtering" nil)))
@@ -230,7 +231,8 @@ also be a predicate function. To only log when you are not
set away, use:
;; append, so that 'erc-initialize-log-marker runs first
(add-hook 'erc-connect-pre-hook #'erc-log-setup-logging 'append)
(dolist (buffer (erc-buffer-list))
- (erc-log-setup-logging buffer)))
+ (erc-log-setup-logging buffer))
+ (erc--modify-local-map t "C-c C-l" #'erc-save-buffer-in-logs))
;; disable
((remove-hook 'erc-insert-post-hook #'erc-save-buffer-in-logs)
(remove-hook 'erc-send-post-hook #'erc-save-buffer-in-logs)
@@ -241,9 +243,8 @@ also be a predicate function. To only log when you are not
set away, use:
(remove-hook 'erc-part-hook #'erc-conditional-save-buffer)
(remove-hook 'erc-connect-pre-hook #'erc-log-setup-logging)
(dolist (buffer (erc-buffer-list))
- (erc-log-disable-logging buffer))))
-
-(define-key erc-mode-map "\C-c\C-l" #'erc-save-buffer-in-logs)
+ (erc-log-disable-logging buffer))
+ (erc--modify-local-map nil "C-c C-l" #'erc-save-buffer-in-logs)))
;;; functionality referenced from erc.el
(defun erc-log-setup-logging (buffer)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 52ee5c855f3..82b821503a8 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -52,8 +52,13 @@ they are hidden or highlighted. This is controlled via the
variables
`erc-current-nick-highlight-type'. For all these highlighting types,
you can decide whether the entire message or only the sending nick is
highlighted."
- ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append))
- ((remove-hook 'erc-insert-modify-hook #'erc-match-message)))
+ ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append)
+ (add-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec)
+ (erc--modify-local-map t "C-c C-k" #'erc-go-to-log-matches-buffer))
+ ((remove-hook 'erc-insert-modify-hook #'erc-match-message)
+ (remove-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec)
+ (erc-match--modify-invisibility-spec)
+ (erc--modify-local-map nil "C-c C-k" #'erc-go-to-log-matches-buffer)))
;; Remaining customizations
@@ -647,15 +652,22 @@ See `erc-log-match-format'."
(get-buffer (car buffer-cons))))))
(switch-to-buffer buffer-name)))
-(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer)
+(defvar-local erc-match--hide-fools-offset-bounds nil)
(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide foolish comments.
This function should be called from `erc-text-matched-hook'."
- (when (eq match-type 'fool)
- (erc-put-text-properties (point-min) (point-max)
- '(invisible intangible)
- (current-buffer))))
+ (when (eq match-type 'fool)
+ (if erc-match--hide-fools-offset-bounds
+ (let ((beg (point-min))
+ (end (point-max)))
+ (save-restriction
+ (widen)
+ (put-text-property (1- beg) (1- end) 'invisible 'erc-match)))
+ ;; The docs say `intangible' is deprecated, but this has been
+ ;; like this for ages. Should verify unneeded and remove if so.
+ (erc-put-text-properties (point-min) (point-max)
+ '(invisible intangible)))))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
@@ -663,6 +675,13 @@ This function is meant to be called from
`erc-text-matched-hook'."
(when (member match-type erc-beep-match-types)
(beep)))
+(defun erc-match--modify-invisibility-spec ()
+ "Add an ellipsis property to the local spec."
+ (if erc-match-mode
+ (add-to-invisibility-spec 'erc-match)
+ (erc-with-all-buffers-of-server nil nil
+ (remove-from-invisibility-spec 'erc-match))))
+
(provide 'erc-match)
;;; erc-match.el ends here
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 95fd8990c99..dd481032e7e 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -67,6 +67,9 @@
(declare-function erc-server-process-alive "erc-backend" (&optional buffer))
(declare-function erc-set-active-buffer "erc" (buffer))
+(declare-function erc-button--display-error-notice-with-keys
+ (parsed &rest strings))
+
;; Variables
(defgroup erc-networks nil
@@ -1292,7 +1295,6 @@ shutting down the connection."
erc-server-announced-name "\" in `erc-networks-alist'"
" or consider calling `erc-tls' with the keyword `:id'."
" See Info:\"(erc) Network Identifier\" for more.")))
- (require 'info)
(erc-display-error-notice parsed m)
(if erc-networks--allow-unknown-network
(progn
@@ -1311,12 +1313,11 @@ shutting down the connection."
Copy source (prefix) from MOTD-ish message as a last resort."
;; The 004 handler never ran; see 2004-03-10 Diane Murray in change log
(unless erc-server-announced-name
- (setq erc-server-announced-name (erc-response.sender parsed))
- (erc-display-error-notice
- parsed (concat "Failed to determine server name. Using \""
- erc-server-announced-name "\" instead."
- " If this was unexpected, consider reporting it via "
- (substitute-command-keys "\\[erc-bug]") ".")))
+ (require 'erc-button)
+ (erc-button--display-error-notice-with-keys
+ parsed "Failed to determine server name. Using \""
+ (setq erc-server-announced-name (erc-response.sender parsed)) "\" instead"
+ ". If this was unexpected, consider reporting it via \\[erc-bug]" "."))
nil)
(defun erc-unset-network-name (_nick _ip _reason)
@@ -1494,9 +1495,9 @@ to be a false alarm. If `erc-reuse-buffers' is nil, let
(memq (erc--target-symbol erc--target)
erc-networks--bouncer-targets)))
proc)
- (let ((m (concat "Unexpected state detected. Please report via "
- (substitute-command-keys "\\[erc-bug]") ".")))
- (erc-display-error-notice parsed m))))
+ (require 'erc-button)
+ (erc-button--display-error-notice-with-keys
+ parsed "Unexpected state detected. Please report via \\[erc-bug].")))
;; For now, retain compatibility with erc-server-NNN-functions.
(or (erc-networks--ensure-announced proc parsed)
@@ -1514,7 +1515,6 @@ to be a false alarm. If `erc-reuse-buffers' is nil, let
"Emit warning when the `networks' module hasn't been loaded.
Ideally, do so upon opening the network process."
(unless (or erc--target erc-networks-mode)
- (require 'info nil t)
(let ((m (concat "Required module `networks' not loaded. If this "
" was unexpected, please add it to `erc-modules'.")))
;; Assume the server buffer has been marked as active.
diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el
index 308b3784ca5..a94678e5132 100644
--- a/lisp/erc/erc-page.el
+++ b/lisp/erc/erc-page.el
@@ -30,10 +30,13 @@
(require 'erc)
+(declare-function erc-controls-interpret "erc-goodies" (str))
+
(defgroup erc-page nil
"React to CTCP PAGE messages."
:group 'erc)
+;;;###autoload(put 'ctcp-page 'erc--module 'page)
;;;###autoload(autoload 'erc-page-mode "erc-page")
(define-erc-module page ctcp-page
"Process CTCP PAGE requests from IRC."
@@ -69,6 +72,7 @@ SENDER and MSG, so that might be easier to use."
This will call `erc-page-function', if defined, or it will just print
a message and `beep'. In addition to that, the page message is also
inserted into the server buffer."
+ (require 'erc-goodies) ; for `erc-controls-interpret'
(when (and erc-page-mode
(string-match "PAGE\\(\\s-+.*\\)?$" msg))
(let* ((m (match-string 1 msg))
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index 0bce856018c..7eb7431fb91 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -56,6 +56,8 @@ add this string to nicks completed."
"If t, order nickname completions with the most recent speakers first."
:type 'boolean)
+;;;###autoload(put 'Completion 'erc--module 'completion)
+;;;###autoload(put 'pcomplete 'erc--module 'completion)
;;;###autoload(autoload 'erc-completion-mode "erc-pcomplete" nil t)
(define-erc-module pcomplete Completion
"In ERC Completion mode, the TAB key does completion whenever possible."
diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el
index 9265691c2d7..bfe17285a68 100644
--- a/lisp/erc/erc-sasl.el
+++ b/lisp/erc/erc-sasl.el
@@ -369,9 +369,12 @@ This doesn't solicit or validate a suite of supported
mechanisms."
data (sasl-step-data step))
(when (string= data "")
(setq data nil))
- (when data
- (setq data (erc--unfun (base64-encode-string data t))))
- (erc-server-send (concat "AUTHENTICATE " (or data "+"))))))
+ (setq data (if data (erc--unfun (base64-encode-string data t)) "+"))
+ (while (not (string-empty-p data))
+ (let ((end (min 400 (length data))))
+ ;; For now, assume this is unlikely to block
+ (erc-server-send (concat "AUTHENTICATE " (substring data 0 end)))
+ (setq data (concat (substring data end) (and (= end 400) "+"))))))))
(defun erc-sasl--destroy (proc)
(run-hook-with-args 'erc-quit-hook proc)
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index 2e6959cc3f0..5408ba405db 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -102,6 +102,7 @@ You can also use \\[erc-nickserv-identify-mode] to change
modes."
(when (featurep 'erc-services)
(erc-nickserv-identify-mode val))))
+;;;###autoload(put 'nickserv 'erc--module 'services)
;;;###autoload(autoload 'erc-services-mode "erc-services" nil t)
(define-erc-module services nickserv
"This mode automates communication with services."
diff --git a/lisp/erc/erc-sound.el b/lisp/erc/erc-sound.el
index 0abdbfd959c..9da9202f0cf 100644
--- a/lisp/erc/erc-sound.el
+++ b/lisp/erc/erc-sound.el
@@ -47,6 +47,7 @@
(require 'erc)
+;;;###autoload(put 'ctcp-sound 'erc--module 'sound)
;;;###autoload(autoload 'erc-sound-mode "erc-sound")
(define-erc-module sound ctcp-sound
"In ERC sound mode, the client will respond to CTCP SOUND requests
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index 5fca14e2365..a9443e0ea17 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -36,6 +36,7 @@
;;; Code:
(require 'erc)
+(require 'erc-goodies)
(require 'speedbar)
(condition-case nil (require 'dframe) (error nil))
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 0aa1590f801..8bca9bdb56b 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,6 +55,9 @@ If nil, timestamping is turned off."
:type '(choice (const nil)
(string)))
+;; FIXME remove surrounding whitespace from default value and have
+;; `erc-insert-timestamp-left-and-right' add it before insertion.
+
(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
@@ -68,7 +71,7 @@ If nil, timestamping is turned off."
:type '(choice (const nil)
(string)))
-(defcustom erc-timestamp-format-right " [%H:%M]"
+(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
@@ -77,9 +80,14 @@ This timestamp is used for timestamps on the right side of
the
screen when `erc-insert-timestamp-function' is set to
`erc-insert-timestamp-left-and-right'.
-If nil, timestamping is turned off."
+Unlike `erc-timestamp-format' and `erc-timestamp-format-left', if
+the value of this option is nil, it falls back to using the value
+of `erc-timestamp-format'."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil)
(string)))
+(make-obsolete-variable 'erc-timestamp-format-right
+ 'erc-timestamp-format "30.1")
(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right
"Function to use to insert timestamps.
@@ -147,39 +155,67 @@ from entering them and instead jump over them."
"ERC timestamp face."
:group 'erc-faces)
+;; New libraries should only autoload the minor mode for a module's
+;; preferred name (rather than its alias).
+
+;;;###autoload(put 'timestamp 'erc--module 'stamp)
;;;###autoload(autoload 'erc-timestamp-mode "erc-stamp" nil t)
(define-erc-module stamp timestamp
"This mode timestamps messages in the channel buffers."
((add-hook 'erc-mode-hook #'erc-munge-invisibility-spec)
(add-hook 'erc-insert-modify-hook #'erc-add-timestamp t)
- (add-hook 'erc-send-modify-hook #'erc-add-timestamp t))
+ (add-hook 'erc-send-modify-hook #'erc-add-timestamp t)
+ (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect))
((remove-hook 'erc-mode-hook #'erc-munge-invisibility-spec)
(remove-hook 'erc-insert-modify-hook #'erc-add-timestamp)
- (remove-hook 'erc-send-modify-hook #'erc-add-timestamp)))
+ (remove-hook 'erc-send-modify-hook #'erc-add-timestamp)
+ (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect)))
+
+(defun erc-stamp--recover-on-reconnect ()
+ (when-let ((priors (or erc--server-reconnecting erc--target-priors)))
+ (dolist (var '(erc-timestamp-last-inserted
+ erc-timestamp-last-inserted-left
+ erc-timestamp-last-inserted-right))
+ (when-let (existing (alist-get var priors))
+ (set var existing)))))
+
+(defvar erc-stamp--current-time nil
+ "The current time when calling `erc-insert-timestamp-function'.
+Specifically, this is the same lisp time object used to create
+the stamp passed to `erc-insert-timestamp-function'.")
+
+(cl-defgeneric erc-stamp--current-time ()
+ "Return a lisp time object to associate with an IRC message.
+This becomes the message's `erc-timestamp' text property, which
+may not be unique, `equal'-wise."
+ (erc-current-time))
+
+(cl-defmethod erc-stamp--current-time :around ()
+ (or erc-stamp--current-time (cl-call-next-method)))
(defun erc-add-timestamp ()
"Add timestamp and text-properties to message.
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
- (unless (get-text-property (point) 'invisible)
- (let ((ct (current-time)))
- (if (fboundp erc-insert-timestamp-function)
- (funcall erc-insert-timestamp-function
- (erc-format-timestamp ct erc-timestamp-format))
- (error "Timestamp function unbound"))
+ (unless (get-text-property (point-min) 'invisible)
+ (let* ((ct (erc-stamp--current-time))
+ (erc-stamp--current-time ct))
+ (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)
erc-away-timestamp-format
(erc-away-time)
(not erc-timestamp-format))
(funcall erc-insert-away-timestamp-function
(erc-format-timestamp ct erc-away-timestamp-format)))
- (add-text-properties (point-min) (point-max)
+ (add-text-properties (point-min) (1- (point-max))
;; It's important for the function to
;; be different on different entries (bug#22700).
(list 'cursor-sensor-functions
- (list (lambda (_window _before dir)
- (erc-echo-timestamp dir ct))))))))
+ ;; Regions are no longer contiguous ^
+ '(erc--echo-ts-csf) 'erc-timestamp ct)))))
(defvar-local erc-timestamp-last-window-width nil
"The width of the last window that showed the current buffer.
@@ -217,14 +253,110 @@ the correct column."
(integer :tag "Column number")
(const :tag "Unspecified" nil)))
-(defcustom erc-timestamp-use-align-to (eq window-system 'x)
+(defcustom erc-timestamp-use-align-to (and (display-graphic-p) t)
"If non-nil, use the :align-to display property to align the stamp.
This gives better results when variable-width characters (like
Asian language characters and math symbols) precede a timestamp.
-A side effect of enabling this is that there will only be one
-space before a right timestamp in any saved logs."
- :type 'boolean)
+This option only matters when `erc-insert-timestamp-function' is
+set to `erc-insert-timestamp-right' or that option's default,
+`erc-insert-timestamp-left-and-right'. If the value is a
+positive integer, alignment occurs that many columns from the
+right edge. If the value is `margin', the stamp appears in the
+right margin when visible.
+
+Enabling this option produces a side effect in that stamps aren't
+indented in saved logs. When its value is an integer, this
+option adds a space after the end of a message if the stamp
+doesn't already start with one. And when its value is t, it adds
+a single space, unconditionally. And while this option never
+adds a space when its value is `margin', ERC does offer a
+workaround in `erc-stamp-prefix-log-filter', which strips
+trailing stamps from messages and puts them before every line."
+ :type '(choice boolean integer (const margin))
+ :package-version '(ERC . "5.6")) ; FIXME sync on release
+
+(defcustom erc-stamp-right-margin-width nil
+ "Width in columns of the right margin.
+When this option is nil, pretend its value is one column greater
+than the `string-width' of the formatted `erc-timestamp-format'.
+This option only matters when `erc-timestamp-use-align-to' is set
+to `margin'."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const nil) integer))
+
+(defun erc-stamp--display-margin-force (orig &rest r)
+ (let ((erc-timestamp-use-align-to 'margin))
+ (apply orig r)))
+
+(defun erc-stamp--adjust-right-margin (cols)
+ "Adjust right margin by COLS.
+When COLS is zero, reset width to `erc-stamp-right-margin-width'
+or one col more than the `string-width' of
+`erc-timestamp-format'."
+ (let ((width
+ (if (zerop cols)
+ (or erc-stamp-right-margin-width
+ (1+ (string-width (or erc-timestamp-last-inserted-right
+ (erc-format-timestamp
+ (current-time)
+ erc-timestamp-format)))))
+ (+ right-margin-width cols))))
+ (setq right-margin-width width
+ right-fringe-width 0)
+ (set-window-margins nil left-margin-width width)
+ (set-window-fringes nil left-fringe-width 0)))
+
+;;;###autoload
+(defun erc-stamp-prefix-log-filter (text)
+ "Prefix every message in the buffer with a stamp.
+Remove trailing stamps as well. For now, hard code the format to
+\"ZNC\"-log style, which is [HH:MM:SS]. Expect to be used as a
+`erc-log-filter-function' when `erc-timestamp-use-align-to' is
+non-nil."
+ (insert text)
+ (goto-char (point-min))
+ (while
+ (progn
+ (when-let* (((< (point) (pos-eol)))
+ (end (1- (pos-eol)))
+ ((eq 'erc-timestamp (field-at-pos end)))
+ (beg (field-beginning end))
+ ;; Skip a line that's just a timestamp.
+ ((> beg (point))))
+ (delete-region beg (1+ end)))
+ (when-let (time (get-text-property (point) 'erc-timestamp))
+ (insert (format-time-string "[%H:%M:%S] " time)))
+ (zerop (forward-line))))
+ "")
+
+(declare-function erc--remove-text-properties "erc" (string))
+
+;; If people want to use this directly, we can convert it into
+;; a local module.
+(define-minor-mode erc-stamp--display-margin-mode
+ "Internal minor mode for built-in modules integrating with `stamp'.
+It binds `erc-timestamp-use-align-to' to `margin' around calls to
+`erc-insert-timestamp-function' in the current buffer, and sets
+the right window margin to `erc-stamp-right-margin-width'. It
+also arranges to remove most text properties when a user kills
+message text so that stamps will be visible when yanked."
+ :interactive nil
+ (if erc-stamp--display-margin-mode
+ (progn
+ (erc-stamp--adjust-right-margin 0)
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (add-function :around (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force))
+ (remove-function (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (remove-function (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force)
+ (kill-local-variable 'right-margin-width)
+ (kill-local-variable 'right-fringe-width)
+ (set-window-margins nil left-margin-width nil)
+ (set-window-fringes nil left-fringe-width nil)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
@@ -243,6 +375,7 @@ space before a right timestamp in any saved logs."
If `erc-timestamp-use-align-to' is t, use the :align-to display
property to get to the POSth column."
+ (declare (obsolete "inlined and removed from client code path" "30.1"))
(if (not erc-timestamp-use-align-to)
(indent-to pos)
(insert " ")
@@ -253,6 +386,8 @@ property to get to the POSth column."
;; Silence byte-compiler
(defvar erc-fill-column)
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
STRING is the timestamp to insert. This function is a possible
@@ -304,30 +439,57 @@ printed just after each line's text (no alignment)."
;; some margin of error if what is displayed on the line differs
;; from the number of characters on the line.
(setq col (+ col (ceiling (/ (- col (- (point)
(line-beginning-position))) 1.6))))
- (if (< col pos)
- (erc-insert-aligned string pos)
- (newline)
- (indent-to pos)
- (setq from (point))
- (insert string))
+ ;; For compatibility reasons, the `erc-timestamp' field includes
+ ;; intervening white space unless a hard break is warranted.
+ (pcase erc-timestamp-use-align-to
+ ((and 't (guard (< col pos)))
+ (insert " ")
+ (put-text-property from (point) 'display `(space :align-to ,pos)))
+ ((pred integerp) ; (cl-type (integer 0 *))
+ (insert " ")
+ (when (eq ?\s (aref string 0))
+ (setq string (substring string 1)))
+ (let ((s (+ erc-timestamp-use-align-to (string-width string))))
+ (put-text-property from (point) 'display
+ `(space :align-to (- right ,s)))))
+ ('margin
+ (put-text-property 0 (length string)
+ 'display `((margin right-margin) ,string)
+ string))
+ ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
+ (_ (indent-to pos)))
+ (insert string)
+ (dolist (p erc-stamp--inherited-props)
+ (when-let ((v (get-text-property (1- from) p)))
+ (put-text-property from (point) p v)))
(erc-put-text-property from (point) 'field 'erc-timestamp)
(erc-put-text-property from (point) 'rear-nonsticky t)
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
-(defun erc-insert-timestamp-left-and-right (_string)
- "This is another function that can be used with
`erc-insert-timestamp-function'.
-If the date is changed, it will print a blank line, the date, and
-another blank line. If the time is changed, it will then print
-it off to the right."
- (let* ((ct (current-time))
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
- (ts-right (erc-format-timestamp ct erc-timestamp-format-right)))
+(defvar erc-stamp--insert-date-function #'insert
+ "Function to insert left \"left-right date\" stamp.
+A local module might use this to modify text properties,
+`insert-before-markers' or renarrow the region after insertion.")
+
+(defun erc-insert-timestamp-left-and-right (string)
+ "Insert a stamp on either side when it changes.
+When the deprecated option `erc-timestamp-format-right' is nil,
+use STRING, which originates from `erc-timestamp-format', for the
+right-hand stamp. Use `erc-timestamp-format-left' for the
+left-hand stamp and expect it to change less frequently."
+ (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ (ts-right (with-suppressed-warnings
+ ((obsolete erc-timestamp-format-right))
+ (if erc-timestamp-format-right
+ (erc-format-timestamp ct erc-timestamp-format-right)
+ string))))
;; insert left timestamp
(unless (string-equal ts-left erc-timestamp-last-inserted-left)
(goto-char (point-min))
(erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left)
- (insert ts-left)
+ (funcall erc-stamp--insert-date-function ts-left)
(setq erc-timestamp-last-inserted-left ts-left))
;; insert right timestamp
(let ((erc-timestamp-only-if-changed-flag t)
@@ -336,12 +498,13 @@ it off to the right."
(setq erc-timestamp-last-inserted-right ts-right))))
;; for testing: (setq erc-timestamp-only-if-changed-flag nil)
+(defvar erc-stamp--tz nil)
(defun erc-format-timestamp (time format)
"Return TIME formatted as string according to FORMAT.
Return the empty string if FORMAT is nil."
(if format
- (let ((ts (format-time-string format time)))
+ (let ((ts (format-time-string format time erc-stamp--tz)))
(erc-put-text-property 0 (length ts)
'font-lock-face 'erc-timestamp-face ts)
(erc-put-text-property 0 (length ts) 'invisible 'timestamp ts)
@@ -400,11 +563,16 @@ enabled when the message was inserted."
(defun erc-echo-timestamp (dir stamp)
"Print timestamp text-property of an IRC message."
- (when (and erc-echo-timestamps (eq 'entered dir))
+ ;; Could also pass an &optional `zone' arg to `format-time-string'.
+ (interactive (list 'entered (get-text-property (point) 'erc-timestamp)))
+ (when (eq 'entered dir)
(when stamp
(message "%s" (format-time-string erc-echo-timestamp-format
stamp)))))
+(defun erc--echo-ts-csf (_window _before dir)
+ (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp)))
+
(provide 'erc-stamp)
;;; erc-stamp.el ends here
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 7fd7b53602e..e060b7039bd 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -921,7 +921,11 @@ is relative to `erc-track-switch-direction'."
(unless (eq major-mode 'erc-mode)
(setq erc-track-last-non-erc-buffer (current-buffer)))
;; and jump to the next active channel
- (funcall fun (erc-track-get-active-buffer arg)))
+ (if-let ((buf (erc-track-get-active-buffer arg))
+ ((buffer-live-p buf)))
+ (funcall fun buf)
+ (erc-modified-channels-update)
+ (erc-track--switch-buffer fun arg)))
;; if no active channels, switch back to what we were doing before
((and erc-track-last-non-erc-buffer
erc-track-switch-from-erc
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 69bdb5d71b1..284990e2d43 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -12,8 +12,8 @@
;; David Edmondson (dme@dme.org)
;; Michael Olson (mwolson@gnu.org)
;; Kelvin White (kwhite@gnu.org)
-;; Version: 5.5
-;; Package-Requires: ((emacs "27.1") (compat "29.1.3.4"))
+;; Version: 5.6-git
+;; Package-Requires: ((emacs "27.1") (compat "29.1.4.1"))
;; Keywords: IRC, chat, client, Internet
;; URL: https://www.gnu.org/software/emacs/erc.html
@@ -58,20 +58,16 @@
;;; Code:
-(load "erc-loaddefs" 'noerror 'nomessage)
+(eval-and-compile (load "erc-loaddefs" 'noerror 'nomessage))
(require 'erc-networks)
(require 'erc-backend)
(require 'cl-lib)
(require 'format-spec)
-(require 'pp)
-(require 'thingatpt)
(require 'auth-source)
-(require 'time-date)
-(require 'iso8601)
-(eval-when-compile (require 'subr-x) (require 'url-parse))
+(eval-when-compile (require 'subr-x))
-(defconst erc-version "5.5"
+(defconst erc-version "5.6-git"
"This version of ERC.")
(defvar erc-official-location
@@ -87,7 +83,8 @@
("5.3" . "23.1")
("5.4" . "28.1")
("5.4.1" . "29.1")
- ("5.5" . "29.1")))
+ ("5.5" . "29.1")
+ ("5.6" . "30.1")))
(defgroup erc nil
"Emacs Internet Relay Chat client."
@@ -140,6 +137,17 @@
(defvar motif-version-string)
(defvar gtk-version-string)
+(declare-function decoded-time-period "time-date" (time))
+(declare-function iso8601-parse-duration "iso8601" (string))
+(declare-function word-at-point "thingatpt" (&optional no-properties))
+(autoload 'word-at-point "thingatpt") ; for hl-nicks
+
+(declare-function url-host "url-parse" (cl-x))
+(declare-function url-password "url-parse" (cl-x))
+(declare-function url-portspec "url-parse" (cl-x))
+(declare-function url-type "url-parse" (cl-x))
+(declare-function url-user "url-parse" (cl-x))
+
;; tunable connection and authentication parameters
(defcustom erc-server nil
@@ -391,6 +399,24 @@ Each function should accept two arguments, NEW-NICK and
OLD-NICK."
:group 'erc-hooks
:type 'hook)
+(defcustom erc-nickname-in-use-functions nil
+ "Function to run before trying for a different nickname.
+Called with two arguments: the desired but just rejected nickname
+and the alternate nickname about to be requested. Use cases
+include special handling during connection registration and
+wrestling with nickname services. For example, value
+`erc-regain-nick-on-connect' is aimed at dealing with reaping
+lingering connections that may prevent you from being issued a
+requested nick immediately when reconnecting. It's meant to be
+used with an `erc-server-reconnect-function' value of
+`erc-server-delayed-check-reconnect' alongside SASL
+authentication."
+ :package-version '(ERC . "5.6")
+ :group 'erc-hooks
+ :type '(choice (function-item erc-regain-nick-on-connect)
+ function
+ (const nil)))
+
(defcustom erc-connect-pre-hook '(erc-initialize-log-marker)
"Hook called just before `erc' calls `erc-connect'.
Functions are passed a buffer as the first argument."
@@ -1189,7 +1215,6 @@ which the local user typed."
(define-key map [home] #'erc-bol)
(define-key map "\C-c\C-a" #'erc-bol)
(define-key map "\C-c\C-b" #'erc-switch-to-buffer)
- (define-key map "\C-c\C-c" #'erc-toggle-interpret-controls)
(define-key map "\C-c\C-d" #'erc-input-action)
(define-key map "\C-c\C-e" #'erc-toggle-ctcp-autoresponse)
(define-key map "\C-c\C-f" #'erc-toggle-flood-control)
@@ -1213,6 +1238,19 @@ which the local user typed."
map)
"ERC keymap.")
+(defun erc--modify-local-map (mode &rest bindings)
+ "Modify `erc-mode-map' on behalf of a global module.
+Add or remove `key-valid-p' BINDINGS when toggling MODE."
+ (declare (indent 1))
+ (while (pcase-let* ((`(,key ,def . ,rest) bindings)
+ (existing (keymap-lookup erc-mode-map key)))
+ (if mode
+ (when (or (not existing) (eq existing #'undefined))
+ (keymap-set erc-mode-map key def))
+ (when (eq existing def)
+ (keymap-unset erc-mode-map key t)))
+ (setq bindings rest))))
+
;; Faces
; Honestly, I have a horrible sense of color and the "defaults" below
@@ -1469,6 +1507,7 @@ 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.
@@ -1489,6 +1528,19 @@ 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."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :group 'erc-buffers
+ :type '(choice (const :tag "Use value of `erc-join-buffer'" 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 new and don't display existing" bury)
+ (const :tag "Use current buffer" buffer)))
+
(defcustom erc-reconnect-display nil
"How (and whether) to display a channel buffer upon reconnecting.
@@ -1521,19 +1573,35 @@ This only has effect when `erc-join-buffer' is set to
`frame'."
(defcustom erc-reuse-frames t
"Determines whether new frames are always created.
-Non-nil means that a new frame is not created to display an ERC
-buffer if there is already a window displaying it. This only has
-effect when `erc-join-buffer' is set to `frame'."
+
+A value of t means only create a frame for undisplayed buffers.
+`displayed' means use any existing, potentially hidden frame
+already displaying a buffer from the same network context or,
+failing that, a frame showing any ERC buffer. As a last resort,
+`displayed' defaults to the selected frame, except for brand new
+connections, for which the invoking frame is always used. When
+this option is nil, a new frame is always created.
+
+Regardless of its value, this option is ignored unless
+`erc-join-buffer' is set to `frame'. And like most options in
+the `erc-buffer' customize group, this has no effect on server
+buffers while reconnecting because those are always buried."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:group 'erc-buffers
- :type 'boolean)
+ :type '(choice boolean
+ (const displayed)))
(defun erc-channel-p (channel)
"Return non-nil if CHANNEL seems to be an IRC channel name."
(cond ((stringp channel)
- (memq (aref channel 0) '(?# ?& ?+ ?!)))
- ((and (bufferp channel) (buffer-live-p channel))
- (with-current-buffer channel
- (erc-channel-p (erc-default-target))))
+ (memq (aref channel 0)
+ (if-let ((types (erc--get-isupport-entry 'CHANTYPES 'single)))
+ (append types nil)
+ '(?# ?& ?+ ?!))))
+ ((and-let* (((bufferp channel))
+ ((buffer-live-p channel))
+ (target (buffer-local-value 'erc--target channel)))
+ (erc-channel-p (erc--target-string target))))
(t nil)))
;; For the sake of compatibility, a historical quirk concerning this
@@ -1816,9 +1884,9 @@ buffer rather than a server buffer.")
;; each item is in the format '(old . new)
(delete-dups (mapcar #'erc--normalize-module-symbol mods)))
-(defcustom erc-modules '(netsplit fill button match track completion readonly
- networks ring autojoin noncommands
irccontrols
- move-to-prompt stamp menu list)
+(defcustom erc-modules '( autojoin button completion fill imenu irccontrols
+ list match menu move-to-prompt netsplit
+ networks noncommands readonly ring stamp track)
"A list of modules which ERC should enable.
If you set the value of this without using `customize' remember to call
\(erc-update-modules) after you change it. When using `customize', modules
@@ -1826,12 +1894,20 @@ removed from the list will be disabled."
:get (lambda (sym)
;; replace outdated names with their newer equivalents
(erc-migrate-modules (symbol-value sym)))
- :initialize #'custom-initialize-default
+ ;; Expect every built-in module to have the symbol property
+ ;; `erc--module' set to its canonical symbol (often itself).
+ :initialize (lambda (symbol exp)
+ ;; Use `cdddr' because (set :greedy t . ,entries)
+ (dolist (entry (cdddr (get 'erc-modules 'custom-type)))
+ (when-let* (((eq (car entry) 'const))
+ (s (cadddr entry))) ; (const :tag "..." ,s)
+ (put s 'erc--module s)))
+ (custom-initialize-reset symbol exp))
:set (lambda (sym val)
;; disable modules which have just been removed
(when (and (boundp 'erc-modules) erc-modules val)
(dolist (module erc-modules)
- (unless (member module val)
+ (unless (memq module val)
(let ((f (intern-soft (format "erc-%s-mode" module))))
(when (and (fboundp f) (boundp f))
(when (symbol-value f)
@@ -1843,10 +1919,19 @@ removed from the list will be disabled."
(when (symbol-value f)
(funcall f 0))
(kill-local-variable f)))))))))
- (set sym val)
+ (let (built-in third-party)
+ (dolist (v val)
+ (setq v (erc--normalize-module-symbol v))
+ (if (get v 'erc--module)
+ (push v built-in)
+ (push v third-party)))
+ ;; Calling `set-default-toplevel-value' complicates testing
+ (set sym (append (sort built-in #'string-lessp)
+ (nreverse third-party))))
;; this test is for the case where erc hasn't been loaded yet
(when (fboundp 'erc-update-modules)
- (erc-update-modules)))
+ (unless erc--inside-mode-toggle-p
+ (erc-update-modules))))
:type
'(set
:greedy t
@@ -1857,10 +1942,10 @@ removed from the list will be disabled."
capab-identify)
(const :tag "completion: Complete nicknames and commands (programmable)"
completion)
- (const :tag "hecomplete: Complete nicknames and commands (obsolete, use
\"completion\")" hecomplete)
(const :tag "dcc: Provide Direct Client-to-Client support" dcc)
(const :tag "fill: Wrap long lines" fill)
(const :tag "identd: Launch an identd server on port 8113" identd)
+ (const :tag "imenu: A simple Imenu integration" imenu)
(const :tag "irccontrols: Highlight or remove IRC control characters"
irccontrols)
(const :tag "keep-place: Leave point above un-viewed text" keep-place)
@@ -1874,11 +1959,11 @@ removed from the list will be disabled."
(const :tag "networks: Provide data about IRC networks" networks)
(const :tag "noncommands: Don't display non-IRC commands after evaluation"
noncommands)
+ (const :tag "notifications: Desktop alerts on PRIVMSG or mentions"
+ notifications)
(const :tag
"notify: Notify when the online status of certain users changes"
notify)
- (const :tag "notifications: Send notifications on PRIVMSG or nickname
mentions"
- notifications)
(const :tag "page: Process CTCP PAGE requests from IRC" page)
(const :tag "readonly: Make displayed lines read-only" readonly)
(const :tag "replace: Replace text in messages" replace)
@@ -1891,13 +1976,14 @@ removed from the list will be disabled."
(const :tag "smiley: Convert smileys to pretty icons" smiley)
(const :tag "sound: Play sounds when you receive CTCP SOUND requests"
sound)
- (const :tag "stamp: Add timestamps to messages" stamp)
(const :tag "spelling: Check spelling" spelling)
+ (const :tag "stamp: Add timestamps to messages" stamp)
(const :tag "track: Track channel activity in the mode-line" track)
(const :tag "truncate: Truncate buffers to a certain size" truncate)
(const :tag "unmorse: Translate morse code in messages" unmorse)
(const :tag "xdcc: Act as an XDCC file-server" xdcc)
(repeat :tag "Others" :inline t symbol))
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:group 'erc)
(defun erc-update-modules ()
@@ -1906,18 +1992,57 @@ Except ignore all local modules, which were introduced
in ERC 5.5."
(erc--update-modules)
nil)
+(defun erc--find-mode (sym)
+ (setq sym (erc--normalize-module-symbol sym))
+ (if-let* ((mode (intern-soft (concat "erc-" (symbol-name sym) "-mode")))
+ ((or (boundp mode)
+ (and (fboundp mode)
+ (autoload-do-load (symbol-function mode) mode)))))
+ mode
+ (and (require (or (get sym 'erc--feature)
+ (intern (concat "erc-" (symbol-name sym))))
+ nil 'noerror)
+ (setq mode (intern-soft (concat "erc-" (symbol-name sym) "-mode")))
+ (fboundp mode)
+ mode)))
+
(defun erc--update-modules ()
(let (local-modes)
(dolist (module erc-modules local-modes)
- (require (or (alist-get module erc--modules-to-features)
- (intern (concat "erc-" (symbol-name module))))
- nil 'noerror) ; some modules don't have a corresponding feature
- (let ((mode (intern-soft (concat "erc-" (symbol-name module) "-mode"))))
- (unless (and mode (fboundp mode))
- (error "`%s' is not a known ERC module" module))
- (if (custom-variable-p mode)
- (funcall mode 1)
- (push mode local-modes))))))
+ (if-let ((mode (erc--find-mode module)))
+ (if (custom-variable-p mode)
+ (funcall mode 1)
+ (push mode local-modes))
+ (error "`%s' is not a known ERC module" module)))))
+
+(defun erc--setup-buffer-first-window (frame a b)
+ (catch 'found
+ (walk-window-tree
+ (lambda (w)
+ (when (cond ((functionp a) (with-current-buffer (window-buffer w)
+ (funcall a b)))
+ (t (eq (buffer-local-value a (window-buffer w)) b)))
+ (throw 'found t)))
+ frame nil 0)))
+
+(defun erc--display-buffer-use-some-frame (buffer alist)
+ "Maybe display BUFFER in an existing frame for the same connection.
+If performed, return window used; otherwise, return nil. Forward ALIST
+to display-buffer machinery."
+ (when-let*
+ ((idp (lambda (value)
+ (and erc-networks--id
+ (erc-networks--id-equal-p erc-networks--id value))))
+ (procp (lambda (frame)
+ (erc--setup-buffer-first-window frame idp erc-networks--id)))
+ (ercp (lambda (frame)
+ (erc--setup-buffer-first-window frame 'major-mode 'erc-mode)))
+ ((or (cdr (frame-list)) (funcall ercp (selected-frame)))))
+ ;; Workaround to avoid calling `window--display-buffer' directly
+ (or (display-buffer-use-some-frame buffer
+ `((frame-predicate . ,procp) ,@alist))
+ (display-buffer-use-some-frame buffer
+ `((frame-predicate . ,ercp) ,@alist)))))
(defun erc-setup-buffer (buffer)
"Consults `erc-join-buffer' to find out how to display `BUFFER'."
@@ -1934,15 +2059,21 @@ Except ignore all local modules, which were introduced
in ERC 5.5."
('bury
nil)
('frame
- (when (or (not erc-reuse-frames)
- (not (get-buffer-window buffer t)))
+ (cond
+ ((and (eq erc-reuse-frames 'displayed)
+ (not (get-buffer-window buffer t)))
+ (display-buffer buffer '((erc--display-buffer-use-some-frame)
+ (inhibit-switch-frame . t)
+ (inhibit-same-window . t))))
+ ((or (not erc-reuse-frames)
+ (not (get-buffer-window buffer t)))
(let ((frame (make-frame (or erc-frame-alist
default-frame-alist))))
(raise-frame frame)
(select-frame frame))
(switch-to-buffer buffer)
(when erc-frame-dedicated-flag
- (set-window-dedicated-p (selected-window) t))))
+ (set-window-dedicated-p (selected-window) t)))))
(_
(if (active-minibuffer-window)
(display-buffer buffer)
@@ -1967,6 +2098,35 @@ nil."
(cons (nreverse (car out)) (nreverse (cdr out))))
(list new-modes)))
+;; This function doubles as a convenient helper for use in unit tests.
+;; Prior to 5.6, its contents lived in `erc-open'.
+
+(defun erc--initialize-markers (old-point continued-session)
+ "Ensure prompt and its bounding markers have been initialized."
+ ;; FIXME erase assertions after code review and additional testing.
+ (setq erc-insert-marker (make-marker)
+ erc-input-marker (make-marker))
+ (if continued-session
+ (progn
+ ;; Trust existing markers.
+ (set-marker erc-insert-marker
+ (alist-get 'erc-insert-marker continued-session))
+ (set-marker erc-input-marker
+ (alist-get 'erc-input-marker continued-session))
+ (goto-char erc-insert-marker)
+ (cl-assert (= (field-end) erc-input-marker))
+ (goto-char old-point)
+ (erc--unhide-prompt))
+ (cl-assert (not (get-text-property (point) 'erc-prompt)))
+ ;; In the original version from `erc-open', the snippet that
+ ;; handled these newline insertions appeared twice close in
+ ;; proximity, which was probably unintended. Nevertheless, we
+ ;; preserve the double newlines here for historical reasons.
+ (insert "\n\n")
+ (set-marker erc-insert-marker (point))
+ (erc-display-prompt)
+ (cl-assert (= (point) (point-max)))))
+
(defun erc-open (&optional server port nick full-name
connect passwd tgt-list channel process
client-certificate user id)
@@ -2000,10 +2160,13 @@ Returns the buffer for the given server or channel."
(old-recon-count erc-server-reconnect-count)
(old-point nil)
(delayed-modules nil)
- (continued-session (and erc--server-reconnecting
- (with-suppressed-warnings
- ((obsolete erc-reuse-buffers))
- erc-reuse-buffers))))
+ (continued-session (or erc--server-reconnecting
+ erc--target-priors
+ (and-let* (((not target))
+ (m (buffer-local-value
+ 'erc-input-marker buffer))
+ ((marker-position m)))
+ (buffer-local-variables buffer)))))
(when connect (run-hook-with-args 'erc-before-connect server port nick))
(set-buffer buffer)
(setq old-point (point))
@@ -2021,21 +2184,6 @@ Returns the buffer for the given server or channel."
(buffer-local-value 'erc-server-announced-name old-buffer)))
;; connection parameters
(setq erc-server-process process)
- (setq erc-insert-marker (make-marker))
- (setq erc-input-marker (make-marker))
- ;; go to the end of the buffer and open a new line
- ;; (the buffer may have existed)
- (goto-char (point-max))
- (forward-line 0)
- (when (or continued-session (get-text-property (point) 'erc-prompt))
- (setq continued-session t)
- (set-marker erc-input-marker
- (or (next-single-property-change (point) 'erc-prompt)
- (point-max))))
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (set-marker erc-insert-marker (point))
;; stack of default recipients
(setq erc-default-recipients tgt-list)
(when target
@@ -2082,20 +2230,7 @@ Returns the buffer for the given server or channel."
(get-buffer-create (concat "*ERC-DEBUG: " server "*"))))
(erc-determine-parameters server port nick full-name user passwd)
-
- ;; FIXME consolidate this prompt-setup logic with the pass above.
-
- ;; set up prompt
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (if continued-session
- (progn (goto-char old-point)
- (erc--unhide-prompt))
- (set-marker erc-insert-marker (point))
- (erc-display-prompt)
- (goto-char (point-max)))
-
+ (erc--initialize-markers old-point continued-session)
(save-excursion (run-mode-hooks)
(dolist (mod (car delayed-modules)) (funcall mod +1))
(dolist (var (cdr delayed-modules)) (set var nil)))
@@ -2177,29 +2312,12 @@ parameters SERVER and NICK."
(setq input (concat "irc://" input)))
input)
-;; A temporary means of addressing the problem of ERC's namesake entry
-;; point defaulting to a non-TLS connection with its default server
-;; (bug#60428).
-(defun erc--warn-unencrypted ()
- ;; Remove unconditionally to avoid wrong context due to races from
- ;; simultaneous dialing or aborting (e.g., via `keybaord-quit').
- (remove-hook 'erc--server-post-connect-hook #'erc--warn-unencrypted)
- (when (and (process-contact erc-server-process :nowait)
- (equal erc-session-server erc-default-server)
- (eql erc-session-port erc-default-port))
- ;; FIXME use the autoloaded `info' instead of `Info-goto-node' in
- ;; `erc-button-alist'.
- (require 'info nil t)
- (erc-display-error-notice
- nil (concat "This connection is unencrypted. Please use `erc-tls'"
- " from now on. See Info:\"(erc) connecting\" for more."))))
-
;;;###autoload
(defun erc-select-read-args ()
- "Prompt the user for values of nick, server, port, and password."
- (require 'url-parse)
+ "Prompt the user for values of nick, server, port, and password.
+With prefix arg, also prompt for user and full name."
(let* ((input (let ((d (erc-compute-server)))
- (read-string (format "Server (default is %S): " d)
+ (read-string (format "Server or URL (default is %S): " d)
nil 'erc-server-history-list d)))
;; For legacy reasons, also accept a URL without a scheme.
(url (url-generic-parse-url (erc--ensure-url input)))
@@ -2217,20 +2335,47 @@ parameters SERVER and NICK."
(let ((d (erc-compute-nick)))
(read-string (format "Nickname (default is %S): " d)
nil 'erc-nick-history-list d))))
+ (user (and current-prefix-arg
+ (let ((d (erc-compute-user (url-user url))))
+ (read-string (format "User (default is %S): " d)
+ nil nil d))))
+ (full (and current-prefix-arg
+ (let ((d (erc-compute-full-name (url-user url))))
+ (read-string (format "Full name (default is %S): " d)
+ nil nil d))))
(passwd (let* ((p (with-suppressed-warnings ((obsolete erc-password))
(or (url-password url) erc-password)))
(m (if p
(format "Server password (default is %S): " p)
"Server password (optional): ")))
- (if erc-prompt-for-password (read-passwd m nil p) p))))
+ (if erc-prompt-for-password (read-passwd m nil p) p)))
+ (opener (and (or sp (eql port erc-default-port-tls)
+ (and (equal server erc-default-server)
+ (not (string-prefix-p "irc://" input))
+ (eql port erc-default-port)
+ (y-or-n-p "Connect using TLS instead? ")
+ (setq port erc-default-port-tls)))
+ #'erc-open-tls-stream))
+ env)
+ (when erc-interactive-display
+ (push `(erc-join-buffer . ,erc-interactive-display) env))
+ (when opener
+ (push `(erc-server-connect-function . ,opener) env))
(when (and passwd (string= "" passwd))
(setq passwd nil))
- (when (and (equal server erc-default-server)
- (eql port erc-default-port)
- (not (eql port erc-default-port-tls)) ; not `erc-tls'
- (not (string-prefix-p "irc://" input))) ; not yanked URL
- (add-hook 'erc--server-post-connect-hook #'erc--warn-unencrypted))
- (list :server server :port port :nick nick :password passwd)))
+ `( :server ,server :port ,port :nick ,nick ,@(and user `(:user ,user))
+ ,@(and passwd `(:password ,passwd)) ,@(and full `(:full-name ,full))
+ ,@(and env `(&interactive-env ,env)))))
+
+(defmacro erc--with-entrypoint-environment (env &rest body)
+ "Run BODY with bindings from ENV alist."
+ (declare (indent 1))
+ (let ((syms (make-symbol "syms"))
+ (vals (make-symbol "vals")))
+ `(let (,syms ,vals)
+ (pcase-dolist (`(,k . ,v) ,env) (push k ,syms) (push v ,vals))
+ (cl-progv ,syms ,vals
+ ,@body))))
;;;###autoload
(cl-defun erc (&key (server (erc-compute-server))
@@ -2239,7 +2384,9 @@ parameters SERVER and NICK."
(user (erc-compute-user))
password
(full-name (erc-compute-full-name))
- id)
+ id
+ ;; Used by interactive form
+ ((&interactive-env --interactive-env--)))
"ERC is a powerful, modular, and extensible IRC client.
This function is the main entry point for ERC.
@@ -2262,9 +2409,12 @@ then the server and full-name will be set to those
values,
whereas `erc-compute-port' and `erc-compute-nick' will be invoked
for the values of the other parameters.
-See `erc-tls' for the meaning of ID."
+See `erc-tls' for the meaning of ID.
+
+\(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)"
(interactive (erc-select-read-args))
- (erc-open server port nick full-name t password nil nil nil nil user id))
+ (erc--with-entrypoint-environment --interactive-env--
+ (erc-open server port nick full-name t password nil nil nil nil user id)))
;;;###autoload
(defalias 'erc-select #'erc)
@@ -2278,7 +2428,9 @@ See `erc-tls' for the meaning of ID."
password
(full-name (erc-compute-full-name))
client-certificate
- id)
+ id
+ ;; Used by interactive form
+ ((&interactive-env --interactive-env--)))
"ERC is a powerful, modular, and extensible IRC client.
This function is the main entry point for ERC over TLS.
@@ -2320,12 +2472,22 @@ Example usage:
When present, ID should be a symbol or a string to use for naming
the server buffer and identifying the connection unequivocally.
-See Info node `(erc) Network Identifier' for details. Like USER
-and CLIENT-CERTIFICATE, this parameter cannot be specified
-interactively."
+See Info node `(erc) Network Identifier' for details. Like
+CLIENT-CERTIFICATE, this parameter cannot be specified
+interactively.
+
+\(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)"
(interactive (let ((erc-default-port erc-default-port-tls))
(erc-select-read-args)))
- (let ((erc-server-connect-function 'erc-open-tls-stream))
+ ;; Bind `erc-server-connect-function' to `erc-open-tls-stream'
+ ;; around `erc-open' when a non-default value hasn't been specified
+ ;; by the user or the interactive form. And don't bother checking
+ ;; for advice, indirect functions, autoloads, etc.
+ (unless (or (assq 'erc-server-connect-function --interactive-env--)
+ (not (eq erc-server-connect-function #'erc-open-network-stream)))
+ (push '(erc-server-connect-function . erc-open-tls-stream)
+ --interactive-env--))
+ (erc--with-entrypoint-environment --interactive-env--
(erc-open server port nick full-name t password
nil nil nil client-certificate user id)))
@@ -2521,6 +2683,16 @@ this option to nil."
:type 'boolean
:group 'erc)
+(define-inline erc--assert-input-bounds ()
+ (inline-quote
+ (progn (when (and (processp erc-server-process)
+ (eq (current-buffer) (process-buffer erc-server-process)))
+ ;; It's believed that these only need syncing immediately
+ ;; following the first two insertions in a server buffer.
+ (set-marker (process-mark erc-server-process) erc-insert-marker))
+ (cl-assert (< erc-insert-marker erc-input-marker))
+ (cl-assert (= (field-end erc-insert-marker) erc-input-marker)))))
+
(defun erc-display-line-1 (string buffer)
"Display STRING in `erc-mode' BUFFER.
Auxiliary function used in `erc-display-line'. The line gets filtered to
@@ -2530,8 +2702,7 @@ Afterwards, `erc-insert-modify' and
`erc-insert-post-hook' get called.
If STRING is nil, the function does nothing."
(when string
(with-current-buffer (or buffer (process-buffer erc-server-process))
- (let ((insert-position (or (marker-position erc-insert-marker)
- (point-max))))
+ (let ((insert-position (marker-position erc-insert-marker)))
(let ((string string) ;; FIXME! Can this be removed?
(buffer-undo-list t)
(inhibit-read-only t))
@@ -2556,6 +2727,7 @@ If STRING is nil, the function does nothing."
(widen)
(goto-char insert-position)
(insert-before-markers string)
+ (erc--assert-input-bounds)
;; run insertion hook, with point at restored location
(save-restriction
(narrow-to-region insert-position (point))
@@ -2563,7 +2735,8 @@ If STRING is nil, the function does nothing."
(run-hooks 'erc-insert-post-hook)
(when erc-remove-parsed-property
(remove-text-properties (point-min) (point-max)
- '(erc-parsed nil))))))))
+ '(erc-parsed nil))))
+ (erc--assert-input-bounds)))))
(run-hooks 'erc-insert-done-hook)
(erc-update-undo-list (- (or (marker-position erc-insert-marker)
(point-max))
@@ -2868,7 +3041,9 @@ See also `erc-format-message' and `erc-display-line'."
(erc-display-line string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
- (erc-put-text-property 0 (length string) 'rear-sticky t string)
+ (put-text-property
+ 0 (length string) 'erc-command
+ (erc--get-eq-comparable-cmd (erc-response.command parsed)) string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags
parsed)
string))
@@ -3054,6 +3229,8 @@ returns the time spec converted to a number of seconds."
(string-to-number period))
;; Parse as a time spec.
(t
+ (require 'time-date)
+ (require 'iso8601)
(let ((time (condition-case nil
(iso8601-parse-duration
(concat (cond
@@ -3203,7 +3380,7 @@ VERSION and so on. It is called with ARGS."
(erc-send-ctcp-message nick str)
t))
-(defun erc-cmd-HELP (&optional func)
+(defun erc-cmd-HELP (&optional func &rest rest)
"Popup help information.
If FUNC contains a valid function or variable, help about that
@@ -3236,6 +3413,10 @@ For a list of user commands (/join /part, ...):
nil)))))
(if sym
(cond
+ ((get sym 'erc--cmd-help)
+ (when (autoloadp (symbol-function sym))
+ (autoload-do-load (symbol-function sym)))
+ (apply (get sym 'erc--cmd-help) rest))
((boundp sym) (describe-variable sym))
((fboundp sym) (describe-function sym))
(t nil))
@@ -4046,6 +4227,22 @@ means that the user has a +o flag in the channel's
access list)."
(t (erc-server-send "TIME"))))
(defalias 'erc-cmd-DATE #'erc-cmd-TIME)
+(defun erc-cmd-MOTD (&optional target)
+ "Ask server to send the current MOTD.
+Some IRCds simply ignore TARGET."
+ (letrec ((oneoff (lambda (proc parsed)
+ (with-current-buffer (erc-server-buffer)
+ (cl-assert (eq (current-buffer) (process-buffer proc)))
+ (remove-hook 'erc-server-402-functions h402 t)
+ (remove-hook 'erc-server-376-functions h376 t)
+ (remove-hook 'erc-server-422-functions h422 t))
+ (erc-server-MOTD proc parsed)
+ t))
+ (h402 (erc-once-with-server-event 402 oneoff))
+ (h376 (erc-once-with-server-event 376 oneoff))
+ (h422 (erc-once-with-server-event 422 oneoff)))
+ (erc-server-send (concat "MOTD" (and target " ") target))))
+
(defun erc-cmd-TOPIC (topic)
"Set or request the topic for a channel.
LINE has the format: \"#CHANNEL TOPIC\", \"#CHANNEL\", \"TOPIC\"
@@ -4246,6 +4443,30 @@ Eventually add a # in front of it, if that turns it into
a valid channel name."
channel
(concat "#" channel)))
+(defvar erc--own-property-names
+ '( tags erc-parsed display ; core
+ ;; `erc-display-prompt'
+ rear-nonsticky erc-prompt field front-sticky read-only
+ ;; stamp
+ cursor-intangible cursor-sensor-functions isearch-open-invisible
+ ;; match
+ invisible intangible
+ ;; button
+ erc-callback erc-data mouse-face keymap
+ ;; fill-wrap
+ line-prefix wrap-prefix)
+ "Props added by ERC that should not survive killing.
+Among those left behind by default are `font-lock-face' and
+`erc-secret'.")
+
+(defun erc--remove-text-properties (string)
+ "Remove text properties in STRING added by ERC.
+Specifically, remove any that aren't members of
+`erc--own-property-names'."
+ (remove-list-of-text-properties 0 (length string)
+ erc--own-property-names string)
+ string)
+
(defun erc-grab-region (start end)
"Copy the region between START and END in a recreatable format.
@@ -4297,7 +4518,7 @@ If FACE is non-nil, it will be used to propertize the
prompt. If it is nil,
(setq prompt (propertize prompt
'rear-nonsticky t
'erc-prompt t
- 'field t
+ 'field 'erc-prompt
'front-sticky t
'read-only t))
(erc-put-text-property 0 (1- (length prompt))
@@ -4507,6 +4728,7 @@ To change how this query window is displayed, use `let'
to bind
(with-current-buffer server-buffer
(erc--open-target target)))
+(defvaralias 'erc-receive-query-display 'erc-auto-query)
(defcustom erc-auto-query '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.
@@ -4573,6 +4795,34 @@ E.g. \"Read error to Nick [user@some.host]: 110\" would
be shortened to
(match-string 1 reason))
reason))
+(defun erc-regain-nick-on-connect (want temp)
+ "Try at most once to grab nickname WANT after settling for TEMP.
+Only do so during connection registration, likely prior to
+authenticating with SASL. Assume the prior connection was lost
+due to connectivity failure and that the server hasn't yet
+noticed. Also assume that the server won't process any
+authentication-related messages until it has accepted a mulligan
+nick or at least sent a 433 and thus triggered
+`erc-nickname-in-use-functions'. Expect authentication to have
+succeeded by the time a logical IRC connection has been
+established and that the contending connection may otherwise
+still be alive and require manual intervention involving
+NickServ."
+ (unless erc-server-connected
+ (letrec ((after-connect
+ (lambda (_ nick)
+ (remove-hook 'erc-after-connect after-connect t)
+ (when (equal temp nick)
+ (erc-cmd-NICK want))))
+ (on-900
+ (lambda (_ parsed)
+ (remove-hook 'erc-server-900-functions on-900 t)
+ (unless erc-server-connected
+ (when (equal (car (erc-response.command-args parsed)) temp)
+ (add-hook 'erc-after-connect after-connect nil t)))
+ nil)))
+ (add-hook 'erc-server-900-functions on-900 nil t))))
+
(defun erc-nickname-in-use (nick reason)
"If NICK is unavailable, tell the user the REASON.
@@ -4606,6 +4856,7 @@ See also `erc-display-error-notice'."
;; established a connection yet
(- 9 (length erc-nick-uniquifier))))
erc-nick-uniquifier)))
+ (run-hook-with-args 'erc-nickname-in-use-functions nick newnick)
(erc-cmd-NICK newnick)
(erc-display-error-notice
nil
@@ -5669,7 +5920,7 @@ See also variable `erc-notice-highlight-type'."
(erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s)
s)
-(defun erc-put-text-property (start end property value &optional object)
+(defalias 'erc-put-text-property 'put-text-property
"Set text-property for an object (usually a string).
START and END define the characters covered.
PROPERTY is the text-property set, usually the symbol `face'.
@@ -5679,14 +5930,9 @@ OBJECT is a string which will be modified and returned.
OBJECT is modified without being copied first.
You can redefine or `defadvice' this function in order to add
-EmacsSpeak support."
- (put-text-property start end property value object))
+EmacsSpeak support.")
-(defun erc-list (thing)
- "Return THING if THING is a list, or a list with THING as its element."
- (if (listp thing)
- thing
- (list thing)))
+(defalias 'erc-list 'ensure-list)
(defun erc-parse-user (string)
"Parse STRING as a user specification (nick!login@host).
@@ -5843,8 +6089,7 @@ When the returned value is a string, pass it to
`erc-error'.")
(progn ; unprogn this during next major surgery
(erc-set-active-buffer (current-buffer))
;; Kill the input and the prompt
- (delete-region (erc-beg-of-input-line)
- (erc-end-of-input-line))
+ (delete-region erc-input-marker (erc-end-of-input-line))
(unwind-protect
(erc-send-input str 'skip-ws-chk)
;; Fix the buffer if the command didn't kill it
@@ -5852,12 +6097,7 @@ When the returned value is a string, pass it to
`erc-error'.")
(with-current-buffer old-buf
(save-restriction
(widen)
- (goto-char (point-max))
- (when (processp erc-server-process)
- (set-marker (process-mark erc-server-process)
(point)))
- (set-marker erc-insert-marker (point))
(let ((buffer-modified (buffer-modified-p)))
- (erc-display-prompt)
(set-buffer-modified-p buffer-modified))))))
;; Only when last hook has been run...
@@ -5943,21 +6183,21 @@ Return non-nil only if we actually send anything."
(defun erc-display-msg (line)
"Display LINE as a message of the user to the current target at point."
(when erc-insert-this
- (let ((insert-position (point)))
- (insert (erc-format-my-nick))
- (let ((beg (point)))
- (insert line)
- (erc-put-text-property beg (point)
- 'font-lock-face 'erc-input-face))
- (insert "\n")
- (when (processp erc-server-process)
- (set-marker (process-mark erc-server-process) (point)))
- (set-marker erc-insert-marker (point))
- (save-excursion
+ (save-excursion
+ (erc--assert-input-bounds)
+ (let ((insert-position (marker-position erc-insert-marker))
+ beg)
+ (goto-char insert-position)
+ (insert-before-markers (erc-format-my-nick))
+ (setq beg (point))
+ (insert-before-markers line)
+ (erc-put-text-property beg (point) 'font-lock-face 'erc-input-face)
+ (insert-before-markers "\n")
(save-restriction
(narrow-to-region insert-position (point))
(run-hooks 'erc-send-modify-hook)
- (run-hooks 'erc-send-post-hook))))))
+ (run-hooks 'erc-send-post-hook))
+ (erc--assert-input-bounds)))))
(defun erc-command-symbol (command)
"Return the ERC command symbol for COMMAND if it exists and is bound."
@@ -6836,8 +7076,6 @@ shortened server name instead."
(cond (lag (format "lag:%.0f" lag))
(t ""))))
-;; erc-goodies is required at end of this file.
-
;; TODO when ERC drops Emacs 28, replace the expressions in the format
;; spec below with functions.
(defun erc-update-mode-line-buffer (buffer)
@@ -7131,6 +7369,7 @@ All windows are opened in the current frame."
(s379 . "%c: Forwarded to %f")
(s391 . "The time at %s is %t")
(s401 . "%n: No such nick/channel")
+ (s402 . "%c: No such server")
(s403 . "%c: No such channel")
(s404 . "%c: Cannot send to channel")
(s405 . "%c: You have joined too many channels")
@@ -7280,10 +7519,11 @@ This function should be on `erc-kill-channel-hook'."
(defun erc-restore-text-properties ()
"Restore the property `erc-parsed' for the region."
- (let ((parsed-posn (erc-find-parsed-property)))
- (put-text-property
- (point-min) (point-max)
- 'erc-parsed (when parsed-posn (erc-get-parsed-vector parsed-posn)))))
+ (when-let* ((parsed-posn (erc-find-parsed-property))
+ (found (erc-get-parsed-vector parsed-posn)))
+ (put-text-property (point-min) (point-max) 'erc-parsed found)
+ (when-let ((tags (get-text-property parsed-posn 'tags)))
+ (put-text-property (point-min) (point-max) 'tags tags))))
(defun erc-get-parsed-vector (point)
"Return the whole parsed vector on POINT."
@@ -7303,6 +7543,13 @@ This function should be on `erc-kill-channel-hook'."
(and vect
(erc-response.command vect)))
+(defun erc--get-eq-comparable-cmd (command)
+ "Return a symbol or a fixnum representing a message's COMMAND.
+See also `erc-message-type'."
+ ;; IRC numerics are three-digit numbers, possibly with leading 0s.
+ ;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o))
+ (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n))
+
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
@@ -7386,6 +7633,4 @@ Customize `erc-url-connect-function' to override this."
(provide 'erc)
-;; FIXME this is a temporary stopgap for Emacs 29.
-(require 'erc-goodies)
;;; erc.el ends here
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index ed4c8a04db7..550b5ed0e6a 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -1650,68 +1650,67 @@ a prefix argument reverses the meaning of that
variable."
(error "No buffer with name %s" name)
(goto-char buf-point)))))
+(declare-function diff-check-labels "diff" (&optional force))
+(declare-function diff-file-local-copy "diff" (file-or-buf))
(declare-function diff-sentinel "diff"
(code &optional old-temp-file new-temp-file))
(defun ibuffer-diff-buffer-with-file-1 (buffer)
- (let ((bufferfile (buffer-local-value 'buffer-file-name buffer))
- (tempfile (make-temp-file "buffer-content-")))
- (when bufferfile
- (unwind-protect
- (progn
- (with-current-buffer buffer
- (write-region nil nil tempfile nil 'nomessage))
- (let* ((old (expand-file-name bufferfile))
- (new (expand-file-name tempfile))
- (oldtmp (file-local-copy old))
- (newtmp (file-local-copy new))
- (switches diff-switches)
- (command
- (mapconcat
- 'identity
- `(,diff-command
- ;; Use explicitly specified switches
- ,@(if (listp switches) switches (list switches))
- ,@(if (or old new)
- (list "-L" (shell-quote-argument old)
- "-L" (shell-quote-argument
- (format "Buffer %s" (buffer-name
buffer)))))
- ,(shell-quote-argument (or oldtmp old))
- ,(shell-quote-argument (or newtmp new)))
- " ")))
- (let ((inhibit-read-only t))
- (insert command "\n")
- (diff-sentinel
- (call-process shell-file-name nil
- (current-buffer) nil
- shell-command-switch command))
- (insert "\n")))))
- (sit-for 0)
- (when (file-exists-p tempfile)
- (delete-file tempfile)))))
+ "Compare BUFFER with its associated file, if any.
+Unlike `diff-no-select', insert output into current buffer
+without erasing it."
+ (when-let ((old (buffer-file-name buffer)))
+ (defvar diff-use-labels)
+ (let* ((new buffer)
+ (oldtmp (diff-file-local-copy old))
+ (newtmp (diff-file-local-copy new))
+ (switches diff-switches)
+ (command
+ (string-join
+ `(,diff-command
+ ,@(if (listp switches) switches (list switches))
+ ,@(and (eq diff-use-labels t)
+ (list "--label" (shell-quote-argument old)
+ "--label" (shell-quote-argument (format "%S"
new))))
+ ,(shell-quote-argument (or oldtmp old))
+ ,(shell-quote-argument (or newtmp new)))
+ " "))
+ (inhibit-read-only t))
+ (insert ?\n command ?\n)
+ (diff-sentinel (call-process shell-file-name nil t nil
+ shell-command-switch command)
+ oldtmp newtmp)
+ (goto-char (point-max)))
+ (redisplay)))
;;;###autoload
(defun ibuffer-diff-with-file ()
"View the differences between marked buffers and their associated files.
If no buffers are marked, use buffer at point.
-This requires the external program \"diff\" to be in your `exec-path'."
+This requires the external program `diff-command' to be in your
+`exec-path'."
(interactive)
(require 'diff)
- (let ((marked-bufs (ibuffer-get-marked-buffers)))
- (when (null marked-bufs)
- (setq marked-bufs (list (ibuffer-current-buffer t))))
- (with-current-buffer (get-buffer-create "*Ibuffer Diff*")
- (setq buffer-read-only nil)
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (buffer-enable-undo (current-buffer))
+ (let ((marked-bufs (or (ibuffer-get-marked-buffers)
+ (list (ibuffer-current-buffer t))))
+ (diff-buf (get-buffer-create "*Ibuffer Diff*")))
+ (with-current-buffer diff-buf
+ (setq buffer-read-only t)
+ (buffer-disable-undo)
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (buffer-enable-undo)
(diff-mode)
+ (diff-check-labels)
(dolist (buf marked-bufs)
(unless (buffer-live-p buf)
(error "Buffer %s has been killed" buf))
- (ibuffer-diff-buffer-with-file-1 buf))
- (setq buffer-read-only t)))
- (switch-to-buffer "*Ibuffer Diff*"))
+ (ibuffer-diff-buffer-with-file-1 buf))
+ (goto-char (point-min))
+ (when (= (following-char) ?\n)
+ (let ((inhibit-read-only t))
+ (delete-char 1))))
+ (pop-to-buffer-same-window diff-buf)))
;;;###autoload
(defun ibuffer-copy-filename-as-kill (&optional arg)
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 6134ab9150c..3f00281e155 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -3118,56 +3118,55 @@ for which LSP on-type-formatting should be requested."
(mapconcat #'eglot--format-markup
(if (vectorp contents) contents (list contents)) "\n"))
-(defun eglot--sig-info (sig &optional _activep sig-help-active-param)
- (eglot--dbind ((SignatureInformation) label documentation parameters
activeParameter)
+(defun eglot--sig-info (sig &optional sig-active briefp)
+ (eglot--dbind ((SignatureInformation)
+ ((:label siglabel))
+ ((:documentation sigdoc)) parameters activeParameter)
sig
(with-temp-buffer
- (save-excursion (insert label))
- (let ((active-param (or activeParameter sig-help-active-param))
- params-start params-end)
- ;; Ad-hoc attempt to parse label as <name>(<params>)
+ (save-excursion (insert siglabel))
+ ;; Ad-hoc attempt to parse label as <name>(<params>)
(when (looking-at "\\([^(]*\\)(\\([^)]+\\))")
- (setq params-start (match-beginning 2) params-end (match-end 2))
(add-face-text-property (match-beginning 1) (match-end 1)
'font-lock-function-name-face))
- ;; Decide whether to add one-line-summary to signature line
- (when (and (stringp documentation)
- (string-match "[[:space:]]*\\([^.\r\n]+[.]?\\)"
- documentation))
- (setq documentation (match-string 1 documentation))
- (unless (string-prefix-p (string-trim documentation) label)
- (goto-char (point-max))
- (insert ": " (eglot--format-markup documentation))))
- ;; Decide what to do with the active parameter...
- (when (and active-param (< -1 active-param (length parameters)))
- (eglot--dbind ((ParameterInformation) label documentation)
- (aref parameters active-param)
- ;; ...perhaps highlight it in the formals list
- (when params-start
- (goto-char params-start)
- (pcase-let
- ((`(,beg ,end)
- (if (stringp label)
- (let ((case-fold-search nil))
- (and (re-search-forward
- (concat "\\<" (regexp-quote label) "\\>")
- params-end t)
- (list (match-beginning 0) (match-end 0))))
- (mapcar #'1+ (append label nil)))))
- (if (and beg end)
- (add-face-text-property
- beg end
- 'eldoc-highlight-function-argument))))
- ;; ...and/or maybe add its doc on a line by its own.
- (when documentation
- (goto-char (point-max))
- (insert "\n"
- (propertize
- (if (stringp label)
- label
- (apply #'buffer-substring (mapcar #'1+ label)))
- 'face 'eldoc-highlight-function-argument)
- ": " (eglot--format-markup documentation))))))
+ ;; Add documentation, indented so we can distinguish multiple
signatures
+ (when-let (doc (and (not briefp) sigdoc (eglot--format-markup sigdoc)))
+ (goto-char (point-max))
+ (insert "\n" (replace-regexp-in-string "^" " " doc)))
+ ;; Now to the parameters
+ (cl-loop
+ with active-param = (or sig-active activeParameter)
+ for i from 0 for parameter across parameters do
+ (eglot--dbind ((ParameterInformation)
+ ((:label parlabel))
+ ((:documentation pardoc)))
+ parameter
+ ;; ...perhaps highlight it in the formals list
+ (when (and (eq i active-param))
+ (save-excursion
+ (goto-char (point-min))
+ (pcase-let
+ ((`(,beg ,end)
+ (if (stringp parlabel)
+ (let ((case-fold-search nil))
+ (and (search-forward parlabel (line-end-position) t)
+ (list (match-beginning 0) (match-end 0))))
+ (mapcar #'1+ (append parlabel nil)))))
+ (if (and beg end)
+ (add-face-text-property
+ beg end
+ 'eldoc-highlight-function-argument)))))
+ ;; ...and/or maybe add its doc on a line by its own.
+ (let (fpardoc)
+ (when (and pardoc (not briefp)
+ (not (string-empty-p
+ (setq fpardoc (eglot--format-markup pardoc)))))
+ (insert "\n "
+ (propertize
+ (if (stringp parlabel) parlabel
+ (apply #'substring siglabel (mapcar #'1+ parlabel)))
+ 'face (and (eq i active-param)
'eldoc-highlight-function-argument))
+ ": " fpardoc)))))
(buffer-string))))
(defun eglot-signature-eldoc-function (cb)
@@ -3179,14 +3178,18 @@ for which LSP on-type-formatting should be requested."
:textDocument/signatureHelp (eglot--TextDocumentPositionParams)
:success-fn
(eglot--lambda ((SignatureHelp)
- signatures activeSignature activeParameter)
+ signatures activeSignature (activeParameter 0))
(eglot--when-buffer-window buf
(let ((active-sig (and (cl-plusp (length signatures))
(aref signatures (or activeSignature 0)))))
(if (not active-sig) (funcall cb nil)
- (funcall cb
- (mapconcat #'eglot--sig-info signatures "\n")
- :echo (eglot--sig-info active-sig t
activeParameter))))))
+ (funcall
+ cb (mapconcat (lambda (s)
+ (eglot--sig-info s (and (eq s active-sig)
+ activeParameter)
+ nil))
+ signatures "\n")
+ :echo (eglot--sig-info active-sig activeParameter t))))))
:deferred :textDocument/signatureHelp))
t))
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 5bad1ce41a8..9ade47331df 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -1438,8 +1438,8 @@ literals (Bug#20852)."
'(defun zot ()
(mapcar #'list '(1 2 3))
nil)
- '((mapcar mapcar))
- "Warning: .mapcar. called for effect")
+ '((ignored-return-value mapcar))
+ "Warning: value from call to `mapcar' is unused; use `mapc' or `dolist'
instead")
(test-suppression
'(defun zot ()
diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el
index bd8a9fc7951..7fb5f82e784 100644
--- a/test/lisp/erc/erc-dcc-tests.el
+++ b/test/lisp/erc/erc-dcc-tests.el
@@ -60,6 +60,8 @@
erc-input-marker (make-marker)
erc-insert-marker (make-marker)
erc-server-current-nick "dummy")
+ (erc-display-prompt)
+ (set-marker erc-insert-marker (pos-bol))
(set-process-query-on-exit-flag erc-server-process nil)
(should-not erc-dcc-list)
(erc-ctcp-query-DCC erc-server-process
@@ -100,7 +102,7 @@
(ert-deftest erc-dcc-handle-ctcp-send--turbo ()
(erc-dcc-tests--dcc-handle-ctcp-send t))
-(ert-deftest erc-dcc-do-GET-command ()
+(defun erc-dcc-tests--erc-dcc-do-GET-command (file &optional sep)
(with-temp-buffer
(let* ((proc (start-process "fake" (current-buffer) "sleep" "10"))
(elt (list :nick "tester!~tester@fake.irc"
@@ -109,7 +111,7 @@
:parent proc
:ip "127.0.0.1"
:port "9899"
- :file "foo.bin"
+ :file file
:size 1405135128))
(erc-dcc-list (list elt))
;;
@@ -124,7 +126,7 @@
erc-server-current-nick "dummy")
(set-process-query-on-exit-flag proc nil)
(cl-letf (((symbol-function 'read-file-name)
- (lambda (&rest _) "foo.bin"))
+ (lambda (&rest _) file))
((symbol-function 'erc-dcc-get-file)
(lambda (&rest r) (push r calls))))
(goto-char (point-max))
@@ -134,38 +136,44 @@
(ert-info ("No turbo")
(should-not (plist-member elt :turbo))
(goto-char erc-input-marker)
- (insert "/dcc GET tester foo.bin")
+ (insert "/dcc GET tester " (or sep "") (prin1-to-string file))
(erc-send-current-line)
(should-not (plist-member (car erc-dcc-list) :turbo))
- (should (equal (pop calls) (list elt "foo.bin" proc))))
+ (should (equal (pop calls) (list elt file proc))))
(ert-info ("Arg turbo in pos 2")
(should-not (plist-member elt :turbo))
(goto-char erc-input-marker)
- (insert "/dcc GET -t tester foo.bin")
+ (insert "/dcc GET -t tester " (or sep "") (prin1-to-string file))
(erc-send-current-line)
(should (eq t (plist-get (car erc-dcc-list) :turbo)))
- (should (equal (pop calls) (list elt "foo.bin" proc))))
+ (should (equal (pop calls) (list elt file proc))))
(ert-info ("Arg turbo in pos 4")
(setq elt (plist-put elt :turbo nil)
erc-dcc-list (list elt))
(goto-char erc-input-marker)
- (insert "/dcc GET tester -t foo.bin")
+ (insert "/dcc GET tester -t " (or sep "") (prin1-to-string file))
(erc-send-current-line)
(should (eq t (plist-get (car erc-dcc-list) :turbo)))
- (should (equal (pop calls) (list elt "foo.bin" proc))))
+ (should (equal (pop calls) (list elt file proc))))
(ert-info ("Arg turbo in pos 6")
(setq elt (plist-put elt :turbo nil)
erc-dcc-list (list elt))
(goto-char erc-input-marker)
- (insert "/dcc GET tester foo.bin -t")
+ (insert "/dcc GET tester " (prin1-to-string file) " -t" (or sep ""))
(erc-send-current-line)
- (should (eq t (plist-get (car erc-dcc-list) :turbo)))
- (should (equal (pop calls) (list elt "foo.bin" proc))))))))
+ (should (eq (if sep nil t) (plist-get (car erc-dcc-list) :turbo)))
+ (should (equal (pop calls) (if sep nil (list elt file proc)))))))))
+
+(ert-deftest erc-dcc-do-GET-command ()
+ (erc-dcc-tests--erc-dcc-do-GET-command "foo.bin")
+ (erc-dcc-tests--erc-dcc-do-GET-command "foo - file.bin")
+ (erc-dcc-tests--erc-dcc-do-GET-command "foo -t file.bin")
+ (erc-dcc-tests--erc-dcc-do-GET-command "-t" "-- "))
-(defun erc-dcc-tests--pcomplete-common (test-fn)
+(defun erc-dcc-tests--pcomplete-common (test-fn &optional file)
(with-current-buffer (get-buffer-create "*erc-dcc-do-GET-command*")
(let* ((inhibit-message noninteractive)
(proc (start-process "fake" (current-buffer) "sleep" "10"))
@@ -175,7 +183,7 @@
:parent proc
:ip "127.0.0.1"
:port "9899"
- :file "foo.bin"
+ :file (or file "foo.bin")
:size 1405135128))
;;
erc-accidental-paste-threshold-seconds
@@ -211,6 +219,20 @@
(beginning-of-line)
(should (search-forward "/dcc get tester foo.bin" nil t))))))
+(ert-deftest pcomplete/erc-mode/DCC--get-quoted ()
+ (erc-dcc-tests--pcomplete-common
+ (lambda ()
+ (insert "/dcc get ")
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get tester" nil t)))
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get tester \"foo bar.bin\"" nil t))))
+ "foo bar.bin"))
+
(ert-deftest pcomplete/erc-mode/DCC--get-1flag ()
(erc-dcc-tests--pcomplete-common
(lambda ()
@@ -282,4 +304,23 @@
(beginning-of-line)
(should (search-forward "/dcc get -t -s tester foo.bin" nil t))))))
+(ert-deftest pcomplete/erc-mode/DCC--get-sep ()
+ (erc-dcc-tests--pcomplete-common
+ (lambda ()
+ (insert "/dcc get ")
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get tester" nil t)))
+ (insert "-")
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get tester -- " nil t)))
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get tester -- -t" nil t))))
+ "-t"))
+
;;; erc-dcc-tests.el ends here
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
new file mode 100644
index 00000000000..f249be8fb86
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,313 @@
+;;; erc-fill-tests.el --- Tests for erc-fill -*- 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:
+
+;; FIXME these tests are brittle and error prone. Replace with
+;; scenarios.
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-fill)
+
+(defvar erc-fill-tests--buffers nil)
+(defvar erc-fill-tests--time-vals (lambda () 0))
+
+(defun erc-fill-tests--insert-privmsg (speaker &rest msg-parts)
+ (declare (indent 1))
+ (let ((msg (erc-format-privmessage speaker
+ (apply #'concat msg-parts) nil t)))
+ (put-text-property 0 (length msg) 'erc-command 'PRIVMSG msg)
+ (erc-display-message nil nil (current-buffer) msg)))
+
+(defun erc-fill-tests--wrap-populate (test)
+ (let ((original-window-buffer (window-buffer (selected-window)))
+ (erc-stamp--tz t)
+ (erc-fill-function 'erc-fill-wrap)
+ (pre-command-hook pre-command-hook)
+ (inhibit-message noninteractive)
+ erc-insert-post-hook
+ extended-command-history
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (cl-letf (((symbol-function 'erc-stamp--current-time)
+ (lambda () (funcall erc-fill-tests--time-vals)))
+ ((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))))
+ (with-current-buffer
+ (car (push (erc-open "localhost" 6667 "tester" "Tester" 'connect
+ nil nil nil nil nil "tester" 'foonet)
+ erc-fill-tests--buffers))
+ (setq erc-network 'foonet
+ erc-server-connected t)
+ (with-current-buffer (erc--open-target "#chan")
+ (set-window-buffer (selected-window) (current-buffer))
+
+ (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. "
+ "If you do not wish for everything you send to be readable "
+ "by the server owner(s), please disconnect."))
+
+ (erc-fill-tests--insert-privmsg "alice"
+ "bob: come, you are a tedious fool: to the purpose. "
+ "What was done to Elbow's wife, that he hath cause to complain of?
"
+ "Come me to what was done to her.")
+
+ ;; Introduce an artificial gap in properties `line-prefix' and
+ ;; `wrap-prefix' and later ensure they're not incremented twice.
+ (save-excursion
+ (forward-line -1)
+ (search-forward "? ")
+ (with-silent-modifications
+ (remove-text-properties (1- (point)) (point)
+ '(line-prefix t wrap-prefix t))))
+
+ (erc-fill-tests--insert-privmsg "bob"
+ "alice: Either your unparagoned mistress is dead, "
+ "or she's outprized by a trifle.")
+
+ ;; Defend against non-local exits from `ert-skip'
+ (unwind-protect
+ (funcall test)
+ (set-window-buffer (selected-window) original-window-buffer)
+ (when noninteractive
+ (while-let ((buf (pop erc-fill-tests--buffers)))
+ (kill-buffer buf))
+ (kill-buffer))))))))
+
+(defun erc-fill-tests--wrap-check-prefixes (&rest prefixes)
+ ;; Check that prefix props are applied over correct intervals.
+ (save-excursion
+ (goto-char (point-min))
+ (dolist (prefix prefixes)
+ (should (search-forward prefix nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width erc-fill--wrap-value)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width erc-fill--wrap-value))))))
+
+;; Set this variable to t to generate new snapshots after carefully
+;; reviewing the output of *each* snapshot (not just first and last).
+;; Obviously, only run one test at a time.
+(defvar erc-fill-tests--save-p nil)
+
+(defun erc-fill-tests--compare (name)
+ (when (display-graphic-p)
+ (setq name (concat name "-graphic")))
+ (let* ((dir (expand-file-name "fill/snapshots/" (ert-resource-directory)))
+ (expect-file (file-name-with-extension (expand-file-name name dir)
+ "eld"))
+ (erc--own-property-names
+ (seq-difference `(font-lock-face ,@erc--own-property-names)
+ '(field display wrap-prefix line-prefix)
+ #'eq))
+ (print-circle t)
+ (print-escape-newlines t)
+ (print-escape-nonascii t)
+ (got (erc--remove-text-properties
+ (buffer-substring (point-min) erc-insert-marker)))
+ (repr (string-replace "erc-fill--wrap-value"
+ (number-to-string erc-fill--wrap-value)
+ (prin1-to-string got))))
+ (with-current-buffer (generate-new-buffer name)
+ (push name erc-fill-tests--buffers)
+ (with-silent-modifications
+ (insert (setq got (read repr))))
+ (erc-mode))
+ (if erc-fill-tests--save-p
+ (with-temp-file expect-file
+ (insert repr))
+ (if (file-exists-p expect-file)
+ ;; Compare set-equal over intervals
+ (should (equal-including-properties
+ (read repr)
+ (read (with-temp-buffer
+ (insert-file-contents-literally expect-file)
+ (buffer-string)))))
+ (message "Snapshot file missing: %S" expect-file)))))
+
+;; To inspect variable pitch, set `erc-mode-hook' to
+;;
+;; (lambda () (face-remap-add-relative 'default :family "Sans Serif"))
+;;
+;; or similar.
+
+(ert-deftest erc-fill-wrap--monospace ()
+ :tags '(:unstable)
+ (unless (>= emacs-major-version 29)
+ (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
+
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
+ (erc-fill-tests--compare "monospace-01-start")
+
+ (ert-info ("Shift right by one (plus)")
+ ;; Args are all `erc-fill-wrap-nudge' +1 because interactive "p"
+ (ert-with-message-capture messages
+ ;; M-x erc-fill-wrap-nudge RET =
+ (ert-simulate-command '(erc-fill-wrap-nudge 2))
+ (should (string-match (rx "for further adjustment") messages)))
+ (should (= erc-fill--wrap-value 29))
+ (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
+ (erc-fill-tests--compare "monospace-02-right"))
+
+ (ert-info ("Shift left by five")
+ ;; "M-x erc-fill-wrap-nudge RET -----"
+ (ert-simulate-command '(erc-fill-wrap-nudge -4))
+ (should (= erc-fill--wrap-value 25))
+ (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
+ (erc-fill-tests--compare "monospace-03-left"))
+
+ (ert-info ("Reset")
+ ;; M-x erc-fill-wrap-nudge RET 0
+ (ert-simulate-command '(erc-fill-wrap-nudge 0))
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
+ (erc-fill-tests--compare "monospace-04-reset")))))
+
+(ert-deftest erc-fill-wrap--merge ()
+ :tags '(:unstable)
+ (unless (>= emacs-major-version 29)
+ (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
+
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ ;; Set this here so that the first few messages are from 1970
+ (let ((erc-fill-tests--time-vals (lambda () 1680332400)))
+ (erc-fill-tests--insert-privmsg "bob" "zero.")
+ (erc-fill-tests--insert-privmsg "alice" "one.")
+ (erc-fill-tests--insert-privmsg "alice" "two.")
+ (erc-fill-tests--insert-privmsg "bob" "three.")
+ (erc-fill-tests--insert-privmsg "bob" "four."))
+
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes
+ "*** " "<alice> " "<bob> "
+ "<bob> " "<alice> " "<alice> " "<bob> " "<bob> ")
+ (erc-fill-tests--compare "merge-01-start")
+
+ (ert-info ("Shift right by one (plus)")
+ (ert-simulate-command '(erc-fill-wrap-nudge 2))
+ (should (= erc-fill--wrap-value 29))
+ (erc-fill-tests--wrap-check-prefixes
+ "*** " "<alice> " "<bob> "
+ "<bob> " "<alice> " "<alice> " "<bob> " "<bob> ")
+ (erc-fill-tests--compare "merge-02-right")))))
+
+(ert-deftest erc-fill-wrap-visual-keys--body ()
+ :tags '(:unstable)
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (ert-info ("Value: non-input")
+ (should (eq erc-fill--wrap-visual-keys 'non-input))
+ (goto-char (point-min))
+ (should (search-forward "that he hath" nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))
+ (execute-kbd-macro "\C-e")
+ (should (search-backward "tedious fool" nil t))
+ (should-not (looking-back "done to her\\."))
+ (forward-char)
+ (execute-kbd-macro "\C-e")
+ (should (search-forward "done to her." nil t)))
+
+ (ert-info ("Value: nil")
+ (execute-kbd-macro "\C-ca")
+ (should-not erc-fill--wrap-visual-keys)
+ (goto-char (point-min))
+ (should (search-forward "in debug mode" nil t))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at (rx "*** ")))
+ (execute-kbd-macro "\C-e")
+ (should (eql ?\] (char-before (point)))))
+
+ (ert-info ("Value: t")
+ (execute-kbd-macro "\C-ca")
+ (should (eq erc-fill--wrap-visual-keys t))
+ (goto-char (point-min))
+ (should (search-forward "that he hath" nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))
+ (should (search-backward "tedious fool" nil t))
+ (execute-kbd-macro "\C-e")
+ (should-not (looking-back (rx "done to her\\.")))
+ (should (search-forward "done to her." nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))))))
+
+(ert-deftest erc-fill-wrap-visual-keys--prompt ()
+ :tags '(:unstable)
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (goto-char erc-input-marker)
+ (insert "This buffer is for text that is not saved, and for Lisp "
+ "evaluation. To create a file, visit it with C-x C-f and "
+ "enter text in its buffer.")
+
+ (ert-info ("Value: non-input")
+ (should (eq erc-fill--wrap-visual-keys 'non-input))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at "This buffer"))
+ (execute-kbd-macro "\C-e")
+ (should (looking-back "its buffer\\."))
+ (execute-kbd-macro "\C-a")
+ (execute-kbd-macro "\C-k")
+ (should (eobp)))
+
+ (ert-info ("Value: nil") ; same
+ (execute-kbd-macro "\C-ca")
+ (should-not erc-fill--wrap-visual-keys)
+ (execute-kbd-macro "\C-y")
+ (should (looking-back "its buffer\\."))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at "This buffer"))
+ (execute-kbd-macro "\C-k")
+ (should (eobp)))
+
+ (ert-info ("Value: non-input")
+ (execute-kbd-macro "\C-ca")
+ (should (eq erc-fill--wrap-visual-keys t))
+ (execute-kbd-macro "\C-y")
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at "This buffer"))
+ (execute-kbd-macro "\C-p")
+ (should-not (looking-back "its buffer\\."))
+ (should (search-forward "its buffer." nil t))
+ (should (search-backward "ERC> " nil t))
+ (execute-kbd-macro "\C-a")))))
+
+;;; erc-fill-tests.el ends here
diff --git a/test/lisp/erc/erc-goodies-tests.el
b/test/lisp/erc/erc-goodies-tests.el
new file mode 100644
index 00000000000..a1f53c5bf88
--- /dev/null
+++ b/test/lisp/erc/erc-goodies-tests.el
@@ -0,0 +1,334 @@
+;;; erc-goodies-tests.el --- Tests for erc-goodies -*- 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 'ert-x)
+(require 'erc-goodies)
+(declare-function erc--initialize-markers "erc" (old-point continued) t)
+
+(defun erc-goodies-tests--assert-face (beg end-str present &optional absent)
+ (setq beg (+ beg (point-min)))
+ (let ((end (+ beg (1- (length end-str)))))
+ (while (and beg (< beg end))
+ (let* ((val (get-text-property beg 'font-lock-face))
+ (ft (flatten-tree (ensure-list val))))
+ (dolist (p (ensure-list present))
+ (if (consp p)
+ (should (member p val))
+ (should (memq p ft))))
+ (dolist (a (ensure-list absent))
+ (if (consp a)
+ (should-not (member a val))
+ (should-not (memq a ft))))
+ (setq beg (text-property-not-all beg (point-max)
+ 'font-lock-face val))))))
+
+;; These are from the "Examples" section of
+;; https://modern.ircdocs.horse/formatting.html
+
+(ert-deftest erc-controls-highlight--examples ()
+ ;; FIXME remove after adding
+ (unless (fboundp 'erc--initialize-markers)
+ (ert-skip "Missing required function"))
+ (should (eq t erc-interpret-controls-p))
+ (let ((erc-insert-modify-hook '(erc-controls-highlight))
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (setq-local erc-interpret-mirc-color t)
+ (erc--initialize-markers (point) nil)
+
+ (let* ((m "I love \C-c3IRC!\C-c It is the \C-c7best protocol ever!")
+ (msg (erc-format-privmessage "bob" m nil t)))
+ (erc-display-message nil nil (current-buffer) msg))
+ (forward-line -1)
+ (should (search-forward "<bob> " nil t))
+ (save-restriction
+ (narrow-to-region (point) (pos-eol))
+ (erc-goodies-tests--assert-face
+ 0 "I love" 'erc-default-face 'fg:erc-color-face3)
+ (erc-goodies-tests--assert-face
+ 7 " IRC!" 'fg:erc-color-face3)
+ (erc-goodies-tests--assert-face
+ 11 " It is the " 'erc-default-face 'fg:erc-color-face7)
+ (erc-goodies-tests--assert-face
+ 22 "best protocol ever!" 'fg:erc-color-face7))
+
+ (let* ((m "This is a \C-]\C-c13,9cool \C-cmessage")
+ (msg (erc-format-privmessage "alice" m nil t)))
+ (erc-display-message nil nil (current-buffer) msg))
+ (should (search-forward "<alice> " nil t))
+ (save-restriction
+ (narrow-to-region (point) (pos-eol))
+ (erc-goodies-tests--assert-face
+ 0 "this is a " 'erc-default-face 'erc-italic-face)
+ (erc-goodies-tests--assert-face
+ 10 "cool " '(erc-italic-face fg:erc-color-face13 bg:erc-color-face9))
+ (erc-goodies-tests--assert-face
+ 15 "message" 'erc-italic-face
+ '(fg:erc-color-face13 bg:erc-color-face9)))
+
+ (let* ((m "IRC \C-bis \C-c4,12so \C-cgreat\C-o!")
+ (msg (erc-format-privmessage "bob" m nil t)))
+ (erc-display-message nil nil (current-buffer) msg))
+ (should (search-forward "<bob> " nil t))
+ (save-restriction
+ (narrow-to-region (point) (pos-eol))
+ (erc-goodies-tests--assert-face
+ 0 "IRC " 'erc-default-face 'erc-bold-face)
+ (erc-goodies-tests--assert-face
+ 4 "is " 'erc-bold-face '(fg:erc-color-face4 bg:erc-color-face12))
+ (erc-goodies-tests--assert-face
+ 7 "so " '(erc-bold-face fg:erc-color-face4 bg:erc-color-face12))
+ (erc-goodies-tests--assert-face
+ 10 "great" 'erc-bold-face '(fg:erc-color-face4 bg:erc-color-face12))
+ (erc-goodies-tests--assert-face
+ 15 "!" 'erc-default-face 'erc-bold-face))
+
+ (let* ((m (concat "Rules: Don't spam 5\C-c13,8,6\C-c,7,8, "
+ "and especially not \C-b9\C-b\C-]!"))
+ (msg (erc-format-privmessage "alice" m nil t)))
+ (erc-display-message nil nil (current-buffer) msg))
+ (should (search-forward "<alice> " nil t))
+ (save-restriction
+ (narrow-to-region (point) (pos-eol))
+ (erc-goodies-tests--assert-face
+ 0 "Rules: Don't spam 5" 'erc-default-face
+ '(fg:erc-color-face13 bg:erc-color-face8))
+ (erc-goodies-tests--assert-face
+ 19 ",6" '(fg:erc-color-face13 bg:erc-color-face8))
+ (erc-goodies-tests--assert-face
+ 21 ",7,8, and especially not " 'erc-default-face
+ '(fg:erc-color-face13 bg:erc-color-face8 erc-bold-face))
+ (erc-goodies-tests--assert-face
+ 44 "9" 'erc-bold-face 'erc-italic-face)
+ (erc-goodies-tests--assert-face
+ 45 "!" 'erc-italic-face 'erc-bold-face))
+
+ (when noninteractive
+ (kill-buffer)))))
+
+;; Like the test above, this is most intuitive when run interactively.
+;; Hovering over the redacted area should reveal its underlying text
+;; in a high-contrast face.
+
+(ert-deftest erc-controls-highlight--inverse ()
+ ;; FIXME remove after adding
+ (unless (fboundp 'erc--initialize-markers)
+ (ert-skip "Missing required function"))
+ (should (eq t erc-interpret-controls-p))
+ (let ((erc-insert-modify-hook '(erc-controls-highlight))
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (setq-local erc-interpret-mirc-color t)
+ (erc--initialize-markers (point) nil)
+
+ (let* ((m "Spoiler: \C-c0,0Hello\C-c1,1World!")
+ (msg (erc-format-privmessage "bob" m nil t)))
+ (erc-display-message nil nil (current-buffer) msg))
+ (forward-line -1)
+ (should (search-forward "<bob> " nil t))
+ (save-restriction
+ (narrow-to-region (point) (pos-eol))
+ (should (eq (get-text-property (+ 9 (point)) 'mouse-face)
+ 'erc-inverse-face))
+ (should (eq (get-text-property (1- (pos-eol)) 'mouse-face)
+ 'erc-inverse-face))
+ (erc-goodies-tests--assert-face
+ 0 "Spoiler: " 'erc-default-face
+ '(fg:erc-color-face0 bg:erc-color-face0))
+ (erc-goodies-tests--assert-face
+ 9 "Hello" '(erc-spoiler-face)
+ '( fg:erc-color-face0 bg:erc-color-face0
+ fg:erc-color-face1 bg:erc-color-face1))
+ (erc-goodies-tests--assert-face
+ 18 " World" '(erc-spoiler-face)
+ '( fg:erc-color-face0 bg:erc-color-face0
+ fg:erc-color-face1 bg:erc-color-face1 )))
+ (when noninteractive
+ (kill-buffer)))))
+
+(defvar erc-goodies-tests--motd
+ ;; This is from ergo's MOTD
+ '((":- - this is \2bold text\17.")
+ (":- - this is \35italics text\17.")
+ (":- - this is \0034red\3 and \0032blue\3 text.")
+ (":- - this is \0034,12red text with a light blue background\3.")
+ (":- - this is a normal escaped dollarsign: $")
+ (":- ")
+ (":- "
+ "\0031,0 00 \0030,1 01 \0030,2 02 \0030,3 03 "
+ "\0031,4 04 \0030,5 05 \0030,6 06 \0031,7 07 ")
+ (":- "
+ "\0031,8 08 \0031,9 09 \0030,10 10 \0031,11 11 "
+ "\0030,12 12 \0031,13 13 \0031,14 14 \0031,15 15 ")
+ (":- ")
+ (":- "
+ "\0030,16 16 \0030,17 17 \0030,18 18 \0030,19 19 "
+ "\0030,20 20 \0030,21 21 \0030,22 22 \0030,23 23 "
+ "\0030,24 24 \0030,25 25 \0030,26 26 \0030,27 27 ")
+ (":- "
+ "\0030,28 28 \0030,29 29 \0030,30 30 \0030,31 31 "
+ "\0030,32 32 \0030,33 33 \0030,34 34 \0030,35 35 "
+ "\0030,36 36 \0030,37 37 \0030,38 38 \0030,39 39 ")
+ (":- "
+ "\0030,40 40 \0030,41 41 \0030,42 42 \0030,43 43 "
+ "\0030,44 44 \0030,45 45 \0030,46 46 \0030,47 47 "
+ "\0030,48 48 \0030,49 49 \0030,50 50 \0030,51 51 ")
+ (":- "
+ "\0030,52 52 \0030,53 53 \0031,54 54 \0031,55 55 "
+ "\0031,56 56 \0031,57 57 \0031,58 58 \0030,59 59 "
+ "\0030,60 60 \0030,61 61 \0030,62 62 \0030,63 63 ")
+ (":- "
+ "\0030,64 64 \0031,65 65 \0031,66 66 \0031,67 67 "
+ "\0031,68 68 \0031,69 69 \0031,70 70 \0031,71 71 "
+ "\0030,72 72 \0030,73 73 \0030,74 74 \0030,75 75 ")
+ (":- "
+ "\0031,76 76 \0031,77 77 \0031,78 78 \0031,79 79 "
+ "\0031,80 80 \0031,81 81 \0031,82 82 \0031,83 83 "
+ "\0031,84 84 \0031,85 85 \0031,86 86 \0031,87 87 ")
+ (":- "
+ "\0030,88 88 \0030,89 89 \0030,90 90 \0030,91 91 "
+ "\0030,92 92 \0030,93 93 \0030,94 94 \0030,95 95 "
+ "\0031,96 96 \0031,97 97 \0031,98 98 \399,99 99 ")
+ (":- ")))
+
+(ert-deftest erc-controls-highlight--motd ()
+ ;; FIXME remove after adding
+ (unless (fboundp 'erc--initialize-markers)
+ (ert-skip "Missing required function"))
+ (should (eq t erc-interpret-controls-p))
+ (let ((erc-insert-modify-hook '(erc-controls-highlight))
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (setq-local erc-interpret-mirc-color t)
+ (erc--initialize-markers (point) nil)
+
+ (dolist (parts erc-goodies-tests--motd)
+ (erc-display-message nil 'notice (current-buffer) (string-join parts)))
+
+ ;; Spot check
+ (goto-char (point-min))
+ (should (search-forward " 16 " nil t))
+ (save-restriction
+ (narrow-to-region (point) (pos-eol))
+ (erc-goodies-tests--assert-face
+ 0 " 17 " '(fg:erc-color-face0 (:background "#472100")))
+ (erc-goodies-tests--assert-face
+ 4 " 18 " '(fg:erc-color-face0 (:background "#474700"))
+ '((:background "#472100"))))
+
+ (should (search-forward " 71 " nil t))
+ (save-restriction
+ (narrow-to-region (point) (pos-eol))
+ (erc-goodies-tests--assert-face
+ 0 " 72 " '(fg:erc-color-face0 (:background "#5959ff")))
+ (erc-goodies-tests--assert-face
+ 4 " 73 " '(fg:erc-color-face0 (:background "#c459ff"))
+ '((:background "#5959ff"))))
+
+ (goto-char (point-min))
+ (when noninteractive
+ (kill-buffer)))))
+
+
+;; Among other things, this test also asserts that a local module's
+;; minor-mode toggle is allowed to disable its mode variable as
+;; needed.
+
+(ert-deftest erc-keep-place-indicator-mode ()
+ ;; FIXME remove after adding
+ (unless (fboundp 'erc--initialize-markers)
+ (ert-skip "Missing required function"))
+ (with-current-buffer (get-buffer-create "*erc-keep-place-indicator-mode*")
+ (erc-mode)
+ (erc--initialize-markers (point) nil)
+ (let ((assert-off
+ (lambda ()
+ (should-not erc-keep-place-indicator-mode)
+ (should-not (local-variable-p 'window-configuration-change-hook))
+ (should-not erc--keep-place-indicator-overlay)))
+ (assert-on
+ (lambda ()
+ (should erc--keep-place-indicator-overlay)
+ (should (local-variable-p 'window-configuration-change-hook))
+ (should window-configuration-change-hook)
+ (should erc-keep-place-mode)))
+ ;;
+ erc-insert-pre-hook
+ erc-modules)
+
+ (funcall assert-off)
+
+ (ert-info ("Value t")
+ (should (eq erc-keep-place-indicator-buffer-type t))
+ (erc-keep-place-indicator-mode +1)
+ (funcall assert-on)
+ (goto-char (point-min))
+ (should (search-forward "Enabling" nil t))
+ (should (memq 'keep-place erc-modules)))
+
+ (erc-keep-place-indicator-mode -1)
+ (funcall assert-off)
+
+ (ert-info ("Value `target'")
+ (let ((erc-keep-place-indicator-buffer-type 'target))
+ (erc-keep-place-indicator-mode +1)
+ (funcall assert-off)
+ (setq erc--target (erc--target-from-string "#chan"))
+ (erc-keep-place-indicator-mode +1)
+ (funcall assert-on)))
+
+ (erc-keep-place-indicator-mode -1)
+ (funcall assert-off)
+
+ (ert-info ("Value `server'")
+ (let ((erc-keep-place-indicator-buffer-type 'server))
+ (erc-keep-place-indicator-mode +1)
+ (funcall assert-off)
+ (setq erc--target nil)
+ (erc-keep-place-indicator-mode +1)
+ (funcall assert-on)))
+
+ ;; Populate buffer
+ (erc-display-message nil 'notice (current-buffer)
+ "This buffer is for text that is not saved")
+ (erc-display-message nil 'notice (current-buffer)
+ "and for lisp evaluation")
+ (should (search-forward "saved" nil t))
+ (erc-keep-place-move nil)
+ (goto-char erc-input-marker)
+
+ (ert-info ("Indicator survives reconnect")
+ (let ((erc--server-reconnecting (buffer-local-variables)))
+ (cl-letf (((symbol-function 'erc-server-connect) #'ignore))
+ (erc-open "localhost" 6667 "tester" "Tester" 'connect
+ nil nil nil nil nil "tester" nil)))
+ (funcall assert-on)
+ (should (= (point) erc-input-marker))
+ (goto-char (overlay-start erc--keep-place-indicator-overlay))
+ (should (looking-at (rx "*** This buffer is for text")))))
+
+ (when noninteractive
+ (kill-buffer))))
+
+;;; erc-goodies-tests.el ends here
diff --git a/test/lisp/erc/erc-networks-tests.el
b/test/lisp/erc/erc-networks-tests.el
index 96836c29aed..b9d216f217b 100644
--- a/test/lisp/erc/erc-networks-tests.el
+++ b/test/lisp/erc/erc-networks-tests.el
@@ -1475,10 +1475,16 @@
(erc-mode)
(setq erc-network 'FooNet
erc-server-current-nick "tester"
- erc-insert-marker (set-marker (make-marker) (point-max))
+ erc-insert-marker (make-marker)
+ erc-input-marker (make-marker)
erc-server-process (erc-networks-tests--create-live-proc)
erc-networks--id (erc-networks--id-create nil))
- (should-not (erc-networks--rename-server-buffer erc-server-process))
+ (set-process-sentinel erc-server-process #'ignore)
+ (erc-display-prompt nil (point-max))
+ (set-marker erc-insert-marker (pos-bol))
+ (erc-display-message nil 'notice (current-buffer) "notice")
+ (with-silent-modifications
+ (should-not (erc-networks--rename-server-buffer erc-server-process)))
(should (eq erc-active-buffer old-buf))
(should-not (erc-server-process-alive))
(should (string= (buffer-name) "irc.foonet.org"))
diff --git a/test/lisp/erc/erc-scenarios-base-auto-recon.el
b/test/lisp/erc/erc-scenarios-base-auto-recon.el
new file mode 100644
index 00000000000..40e2c23408b
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-auto-recon.el
@@ -0,0 +1,141 @@
+;;; erc-scenarios-base-auto-recon.el --- auto-recon 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)))
+
+(defun erc-scenarios-base-auto-recon--get-unused-port ()
+ (let ((server (make-network-process :name "*erc-scenarios-base-auto-recon*"
+ :host "localhost"
+ :service t
+ :server t)))
+ (delete-process server)
+ (process-contact server :service)))
+
+;; This demos one possible flavor of intermittent service.
+;; It may end up needing to be marked :unstable.
+
+(ert-deftest erc-scenarios-base-auto-recon-unavailable ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-server-flood-penalty 0.1)
+ (port (erc-scenarios-base-auto-recon--get-unused-port))
+ (erc--server-reconnect-timeout-scale-function (lambda (_) 1))
+ (erc-server-auto-reconnect t)
+ (erc-server-reconnect-function #'erc-server-delayed-check-reconnect)
+ (expect (erc-d-t-make-expecter))
+ (erc-scenarios-common-dialog "base/reconnect")
+ (dumb-server nil))
+
+ (ert-info ("Dialing fails: nobody home")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :full-name "tester")
+ (erc-d-t-wait-for 10 (not (erc-server-process-alive)))
+ (erc-d-t-wait-for 10 erc--server-reconnect-timer)
+ (funcall expect 10 "Opening connection")
+ (funcall expect 10 "failed")
+
+ (ert-info ("Reconnect function freezes attempts at 1")
+ (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))
+ (funcall expect 10 "nobody home")
+ (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))
+ (funcall expect 10 "nobody home"))))
+
+ (ert-info ("Service appears")
+ (setq dumb-server (erc-d-run "localhost" port
+ 'just-eof 'unexpected-disconnect))
+ (with-current-buffer (format "127.0.0.1:%d" port)
+ (funcall expect 10 "server is in debug mode")
+ (should (equal (buffer-name) "FooNet"))))
+
+ (ert-info ("Service interrupted, reconnect starts again")
+ (with-current-buffer "FooNet"
+ (funcall expect 10 "failed")
+ (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))))
+
+ (ert-info ("Service restored")
+ (delete-process dumb-server)
+ (setq dumb-server (erc-d-run "localhost" port
+ 'just-eof 'unexpected-disconnect))
+ (with-current-buffer "FooNet"
+ (funcall expect 10 "server is in debug mode")))
+
+ (ert-info ("Service interrupted a third time, reconnect starts yet again")
+ (with-current-buffer "FooNet"
+ (funcall expect 10 "failed")
+ (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))
+ (erc-cmd-RECONNECT "cancel")
+ (funcall expect 10 "canceled")))))
+
+;; In this test, a listener accepts but doesn't respond to any messages.
+
+(ert-deftest erc-scenarios-base-auto-recon-no-proto ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-server-flood-penalty 0.1)
+ (erc-scenarios-common-dialog "base/reconnect")
+ (erc-d-auto-pong nil)
+ (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect))
+ (port (process-contact dumb-server :service))
+ (erc--server-reconnect-timeout-scale-function (lambda (_) 1))
+ (erc--server-reconnect-timeout-check 0.5)
+ (erc-server-auto-reconnect t)
+ (erc-server-reconnect-function #'erc-server-delayed-check-reconnect)
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Session succeeds but cut short")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :full-name "tester")
+ (funcall expect 10 "server is in debug mode")
+ (should (equal (buffer-name) "FooNet"))
+ (erc-d-t-wait-for 10 erc--server-reconnect-timer)
+ (delete-process dumb-server)
+ (funcall expect 10 "failed")
+
+ (ert-info ("Reconnect function freezes attempts at 1")
+ (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))
+ (funcall expect 10 "nobody home")
+ (funcall expect 10 "timed out while dialing")
+ (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))
+ (funcall expect 10 "nobody home"))))
+
+ (ert-info ("Service restored")
+ (setq dumb-server (erc-d-run "localhost" port
+ 'just-ping
+ 'ping-pong
+ 'unexpected-disconnect))
+ (with-current-buffer "FooNet"
+ (funcall expect 30 "server is in debug mode")))
+
+ (ert-info ("Service interrupted again, reconnect starts again")
+ (with-current-buffer "FooNet"
+ (funcall expect 10 "failed")
+ (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))
+ (erc-cmd-RECONNECT "cancel")
+ (funcall expect 10 "canceled")))))
+
+;;; erc-scenarios-base-auto-recon.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-local-module-modes.el
b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
new file mode 100644
index 00000000000..7b91e28dc83
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
@@ -0,0 +1,211 @@
+;;; erc-scenarios-base-local-module-modes.el --- More local-mod ERC tests -*-
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:
+
+;; A local module doubles as a minor mode whose mode variable and
+;; associated local data can withstand service disruptions.
+;; Unfortunately, the current implementation is too unwieldy to be
+;; made public because it doesn't perform any of the boiler plate
+;; needed to save and restore buffer-local and "network-local" copies
+;; of user options. Ultimately, a user-friendly framework must fill
+;; this void if third-party local modules are ever to become
+;; practical.
+;;
+;; The following tests all use `sasl' because, as of ERC 5.5, it's the
+;; only local module.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(require 'erc-sasl)
+
+;; After quitting a session for which `sasl' is enabled, you
+;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
+;; using an alternate nickname. You again disconnect and reconnect,
+;; this time immediately, and the mode stays disabled. Finally, you
+;; once again disconnect, toggle the mode back on, and reconnect. You
+;; are authenticated successfully, just like in the initial session.
+;;
+;; This is meant to show that a user's local mode settings persist
+;; between sessions. It also happens to show (in round four, below)
+;; that a server renicking a user on 001 after a 903 is handled just
+;; like a user-initiated renick, although this is not the main thrust.
+
+(ert-deftest erc-scenarios-base-local-module-modes--reconnect ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round two, nick rejected, alternate granted")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode off, reconnect")
+ (erc-sasl-mode -1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Some enigma, some riddle"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round three, send alternate nick initially")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Keep mode off, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Let our reciprocal vows be remembered."))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round four, authenticated successfully again")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode on, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-sasl-mode +1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
+
+ (erc-cmd-QUIT "")))))
+
+;; In contrast to the mode-persistence test above, this one
+;; demonstrates that a user reinvoking an entry point declares their
+;; intention to reset local-module state for the server buffer.
+;; Whether a local-module's state variable is also reset in target
+;; buffers up to the module. That is, by default, they're left alone.
+
+(ert-deftest erc-scenarios-base-local-module-modes--entrypoint ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'first))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (ert-info ("Toggle local-module off in target buffer")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (erc-sasl-mode -1)))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")
+
+ (ert-info ("Toggle mode off")
+ (erc-sasl-mode -1)
+ (should (local-variable-p 'erc-sasl-mode)))))
+
+ (ert-info ("Reconnecting via entry point discards `erc-sasl-mode' value.")
+ ;; If you were to /RECONNECT here, no PASS changeme would be
+ ;; sent instead of CAP SASL, resulting in a failure.
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester")
+
+ (erc-d-t-wait-for 10 (equal (buffer-name) "foonet"))
+ (funcall expect 10 "User modes for tester")
+ (should erc-sasl-mode)) ; obviously
+
+ ;; No other foonet buffer exists, e.g., foonet<2>
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+
+ (ert-info ("Target buffer retains local-module state")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-QUIT ""))))))
+
+;;; erc-scenarios-base-local-module-modes.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el
b/test/lisp/erc/erc-scenarios-base-local-modules.el
index 1318207a3bf..d6dbd87c8cc 100644
--- a/test/lisp/erc/erc-scenarios-base-local-modules.el
+++ b/test/lisp/erc/erc-scenarios-base-local-modules.el
@@ -82,105 +82,6 @@
(erc-cmd-QUIT "")
(funcall expect 10 "finished")))))
-;; After quitting a session for which `sasl' is enabled, you
-;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
-;; using an alternate nickname. You again disconnect and reconnect,
-;; this time immediately, and the mode stays disabled. Finally, you
-;; once again disconnect, toggle the mode back on, and reconnect. You
-;; are authenticated successfully, just like in the initial session.
-;;
-;; This is meant to show that a user's local mode settings persist
-;; between sessions. It also happens to show (in round four, below)
-;; that a server renicking a user on 001 after a 903 is handled just
-;; like a user-initiated renick, although this is not the main thrust.
-
-(ert-deftest erc-scenarios-base-local-modules--mode-persistence ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/local-modules")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (expect (erc-d-t-make-expecter))
- (server-buffer-name (format "127.0.0.1:%d" port)))
-
- (ert-info ("Round one, initial authentication succeeds as expected")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) server-buffer-name))
- (funcall expect 10 "You are now logged in as tester"))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-JOIN "#chan")
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 20 "She is Lavinia, therefore must"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round two, nick rejected, alternate granted")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode off, reconnect")
- (erc-sasl-mode -1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Some enigma, some riddle"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round three, send alternate nick initially")
- (with-current-buffer "foonet"
-
- (ert-info ("Keep mode off, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Let our reciprocal vows be remembered."))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round four, authenticated successfully again")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode on, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-sasl-mode +1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
-
- (erc-cmd-QUIT "")))))
-
;; For local modules, the twin toggle commands `erc-FOO-enable' and
;; `erc-FOO-disable' affect all buffers of a connection, whereas
;; `erc-FOO-mode' continues to operate only on the current buffer.
diff --git a/test/lisp/erc/erc-scenarios-base-misc-regressions.el
b/test/lisp/erc/erc-scenarios-base-misc-regressions.el
index 16b2cb355d1..c1915d088a0 100644
--- a/test/lisp/erc/erc-scenarios-base-misc-regressions.el
+++ b/test/lisp/erc/erc-scenarios-base-misc-regressions.el
@@ -124,4 +124,48 @@ Originally from scenario rebuffed/gapless as explained in
Bug#48598:
(with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
(erc-d-t-search-for 10 "and be prosperous")))))
+;; This defends against a partial regression in which an /MOTD caused
+;; 376 and 422 handlers in erc-networks to run.
+
+(ert-deftest erc-cmd-MOTD ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/commands")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'motd))
+ (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 "This is the default Ergo MOTD")
+ (funcall expect 10 "debug mode")))
+
+ (ert-info ("Send plain MOTD")
+ (with-current-buffer "foonet"
+ (erc-cmd-MOTD)
+ (funcall expect -0.2 "Unexpected state detected")
+ (funcall expect 10 "This is the default Ergo MOTD")))
+
+ (ert-info ("Send MOTD with known target")
+ (with-current-buffer "foonet"
+ (erc-scenarios-common-say "/MOTD irc1.foonet.org")
+ (funcall expect -0.2 "Unexpected state detected")
+ (funcall expect 10 "This is the default Ergo MOTD")))
+
+ (ert-info ("Send MOTD with erroneous target")
+ (with-current-buffer "foonet"
+ (erc-scenarios-common-say "/MOTD fake.foonet.org")
+ (funcall expect -0.2 "Unexpected state detected")
+ (funcall expect 10 "No such server")
+ ;; Message may show up before the handler runs.
+ (erc-d-t-wait-for 10
+ (not (local-variable-p 'erc-server-402-functions)))
+ (should-not (local-variable-p 'erc-server-376-functions))
+ (should-not (local-variable-p 'erc-server-422-functions))
+ (erc-cmd-QUIT "")))))
+
;;; erc-scenarios-base-misc-regressions.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-renick.el
b/test/lisp/erc/erc-scenarios-base-renick.el
index f1723200533..f8350676fb7 100644
--- a/test/lisp/erc/erc-scenarios-base-renick.el
+++ b/test/lisp/erc/erc-scenarios-base-renick.el
@@ -303,4 +303,47 @@
(should-not (search-forward "now known as frenemy" nil t))
(erc-d-t-search-for 25 "I have lost"))))
+;; The server rejects your nick during registration, so ERC acquires a
+;; placeholder and successfully renicks once the connection is up.
+;; See also `erc-scenarios-base-renick-self-auto'.
+
+(ert-deftest erc-scenarios-base-renick-auto-regain ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-server-flood-penalty 0.1)
+ (erc-scenarios-common-dialog "base/renick/regain")
+ (dumb-server (erc-d-run "localhost" t 'normal 'normal-again))
+ (port (process-contact dumb-server :service))
+ (erc-server-auto-reconnect t)
+ (erc-modules (cons 'sasl erc-modules))
+ (erc-nickname-in-use-functions '(erc-regain-nick-on-connect))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Session succeeds but cut short")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (funcall expect 10 "Last login from")
+ (erc-cmd-JOIN "#test")))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#test"))
+ (funcall expect 10 "was created on"))
+
+ (ert-info ("Service restored")
+ (with-current-buffer "Libera.Chat"
+ (erc-d-t-wait-for 10 erc--server-reconnect-timer)
+ (funcall expect 10 "Connection failed!")
+ (funcall expect 10 "already in use")
+ (funcall expect 10 "changed mode for tester`")
+ (funcall expect 10 "Last login from")
+ (funcall expect 10 "Your new nickname is tester")))
+
+ (with-current-buffer (get-buffer "#test")
+ (funcall expect 10 "tester ")
+ (funcall expect 10 "was created on"))))
+
+
;;; erc-scenarios-base-renick.el ends here
diff --git a/test/lisp/erc/erc-scenarios-misc.el
b/test/lisp/erc/erc-scenarios-misc.el
index 5927eee48fd..bb925eed836 100644
--- a/test/lisp/erc/erc-scenarios-misc.el
+++ b/test/lisp/erc/erc-scenarios-misc.el
@@ -205,4 +205,38 @@
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
(funcall expect 10 "welcome")))))
+;; Ensure that ERC does not attempt to switch to a killed server
+;; buffer via `erc-track-switch-buffer'.
+
+(declare-function erc-track-switch-buffer "erc-track" (arg))
+(defvar erc-track-mode)
+
+(ert-deftest erc-scenarios-base-kill-server-track ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "networks/merge-server")
+ (dumb-server (erc-d-run "localhost" t 'track))
+ (port (process-contact dumb-server :service))
+ (erc-server-flood-penalty 0.1)
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester")
+ (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
+ (should erc-track-mode)
+ (funcall expect 5 "changed mode for tester")
+ (erc-cmd-JOIN "#chan")))
+
+ (ert-info ("Join channel and kill server buffer")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 5 "The hour that fools should ask"))
+ (with-current-buffer "FooNet"
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (kill-buffer))
+ (should-not (eq (current-buffer) (get-buffer "#chan"))) ; *temp*
+ (ert-simulate-command '(erc-track-switch-buffer 1)) ; No longer signals
+ (should (eq (current-buffer) (get-buffer "#chan"))))))
+
;;; erc-scenarios-misc.el ends here
diff --git a/test/lisp/erc/erc-scenarios-sasl.el
b/test/lisp/erc/erc-scenarios-sasl.el
index 3878237c7d2..ab652d72dd2 100644
--- a/test/lisp/erc/erc-scenarios-sasl.el
+++ b/test/lisp/erc/erc-scenarios-sasl.el
@@ -51,6 +51,70 @@
;; Regression "\0\0\0\0 ..." caused by (fillarray passphrase 0)
(should (string= erc-sasl-password "password123"))))))
+;; The user's unreasonably long password is apportioned into chunks on
+;; the way out the door.
+
+(ert-deftest erc-scenarios-sasl--plain-overlong-split ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "sasl")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'plain-overlong-split))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (erc-sasl-password
+ (concat
+ "Est ut beatae omnis ipsam. "
+ "Quis fugiat deleniti totam qui. "
+ "Ipsum quam a dolorum tempora velit laborum odit. "
+ "Et saepe voluptate sed cumque vel. "
+ "Voluptas sint ab pariatur libero veritatis corrupti. "
+ "Vero iure omnis ullam. "
+ "Vero beatae dolores facere fugiat ipsam. "
+ "Ea est pariatur minima nobis sunt aut ut. "
+ "Dolores ut laudantium maiores temporibus voluptates. "
+ "Reiciendis impedit omnis et unde delectus quas ab. "
+ "Quae eligendi necessitatibus doloribus "
+ "molestias tempora magnam assumenda."))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "emersion"
+ :user "emersion"
+ :full-name "emersion")
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-QUIT "")))))
+
+(ert-deftest erc-scenarios-sasl--plain-overlong-aligned ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "sasl")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'plain-overlong-aligned))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (erc-sasl-password
+ (concat
+ "Est ut beatae omnis ipsam. "
+ "Quis fugiat deleniti totam qui. "
+ "Ipsum quam a dolorum tempora velit laborum odit. "
+ "Et saepe voluptate sed cumque vel. "
+ "Voluptas sint ab pariatur libero veritatis corrupti. "
+ "Vero iure omnis ullam. Vero beatae dolores facere fugiat ipsam. "
+ "Ea est pariatur minima nobis"))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "emersion"
+ :user "emersion"
+ :full-name "emersion")
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-QUIT "")))))
+
(ert-deftest erc-scenarios-sasl--external ()
:tags '(:expensive-test)
(erc-scenarios-common-with-cleanup
diff --git a/test/lisp/erc/erc-services-tests.el
b/test/lisp/erc/erc-services-tests.el
index 9181a47ee3b..6cbba02a37e 100644
--- a/test/lisp/erc/erc-services-tests.el
+++ b/test/lisp/erc/erc-services-tests.el
@@ -212,39 +212,32 @@
(advice-remove 'epg-decrypt-string 'erc--auth-source-plstore)
(advice-remove 'epg-find-configuration 'erc--auth-source-plstore)))
-(defvar erc-services-tests--auth-source-plstore-standard-entries
- '(("ba950d38118a76d71f9f0591bb373d6cb366a512"
- :secret-secret t
- :host "irc.gnu.org"
- :user "#chan"
- :port "irc")
- ("7f17ca445d11158065e911a6d0f4cbf52ca250e3"
- :secret-secret t
- :host "my.gnu.org"
- :user "#chan"
- :port "irc")
- ("fcd3c8bd6daf4509de0ad6ee98e744ce0fca9377"
- :secret-secret t
- :host "GNU.chat"
- :user "#chan"
- :port "irc")))
-
-(defvar erc-services-tests--auth-source-plstore-standard-secrets
- '(("ba950d38118a76d71f9f0591bb373d6cb366a512" :secret "bar")
- ("7f17ca445d11158065e911a6d0f4cbf52ca250e3" :secret "baz")
- ("fcd3c8bd6daf4509de0ad6ee98e744ce0fca9377" :secret "foo")))
+(defvar erc-services-tests--auth-source-plstore-standard-announced "\
+;;; public entries -*- mode: plstore -*-
+((\"ba950d38118a76d71f9f0591bb373d6cb366a512\"
+ :secret-secret t
+ :host \"irc.gnu.org\"
+ :user \"#chan\"
+ :port \"irc\")
+ (\"7f17ca445d11158065e911a6d0f4cbf52ca250e3\"
+ :secret-secret t
+ :host \"my.gnu.org\"
+ :user \"#chan\"
+ :port \"irc\")
+ (\"fcd3c8bd6daf4509de0ad6ee98e744ce0fca9377\"
+ :secret-secret t
+ :host \"GNU.chat\"
+ :user \"#chan\"
+ :port \"irc\"))
+;;; secret entries
+((\"ba950d38118a76d71f9f0591bb373d6cb366a512\" :secret \"bar\")
+ (\"7f17ca445d11158065e911a6d0f4cbf52ca250e3\" :secret \"baz\")
+ (\"fcd3c8bd6daf4509de0ad6ee98e744ce0fca9377\" :secret \"foo\"))")
(ert-deftest erc--auth-source-search--plstore-standard ()
(ert-with-temp-file plstore-file
:suffix ".plist"
- :text (concat ";;; public entries -*- mode: plstore -*- \n"
- (prin1-to-string
- erc-services-tests--auth-source-plstore-standard-entries)
- "\n;;; secret entries\n"
- (prin1-to-string
- erc-services-tests--auth-source-plstore-standard-secrets)
- "\n")
-
+ :text erc-services-tests--auth-source-plstore-standard-announced
(let ((auth-sources (list plstore-file))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-standard
@@ -254,14 +247,7 @@
(ert-deftest erc--auth-source-search--plstore-announced ()
(ert-with-temp-file plstore-file
:suffix ".plist"
- :text (concat ";;; public entries -*- mode: plstore -*- \n"
- (prin1-to-string
- erc-services-tests--auth-source-plstore-standard-entries)
- "\n;;; secret entries\n"
- (prin1-to-string
- erc-services-tests--auth-source-plstore-standard-secrets)
- "\n")
-
+ :text erc-services-tests--auth-source-plstore-standard-announced
(let ((auth-sources (list plstore-file))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-announced
@@ -271,29 +257,33 @@
(ert-deftest erc--auth-source-search--plstore-overrides ()
(ert-with-temp-file plstore-file
:suffix ".plist"
- :text (concat
- ";;; public entries -*- mode: plstore -*- \n"
- (prin1-to-string
- `(,@erc-services-tests--auth-source-plstore-standard-entries
- ("1b3fab249a8dff77a4d8fe7eb4b0171b25cc711a"
- :secret-secret t :host "GNU.chat" :user "#chan" :port "6697")
- ("6cbcdc39476b8cfcca6f3e9a7876f41ec3f708cc"
- :secret-secret t :host "my.gnu.org" :user "#fsf" :port "irc")
- ("a33e2b3bd2d6f33995a4b88710a594a100c5e41d"
- :secret-secret t :host "irc.gnu.org" :port "6667")
- ("ab2fd349b2b7d6a9215bb35a92d054261b0b1537"
- :secret-secret t :host "MyHost" :port "irc")
- ("61a6bd552059494f479ff720e8de33e22574650a"
- :secret-secret t :host "MyHost" :port "6667")))
- "\n;;; secret entries\n"
- (prin1-to-string
- `(,@erc-services-tests--auth-source-plstore-standard-secrets
- ("1b3fab249a8dff77a4d8fe7eb4b0171b25cc711a" :secret "spam")
- ("6cbcdc39476b8cfcca6f3e9a7876f41ec3f708cc" :secret "42")
- ("a33e2b3bd2d6f33995a4b88710a594a100c5e41d" :secret "sesame")
- ("ab2fd349b2b7d6a9215bb35a92d054261b0b1537" :secret "456")
- ("61a6bd552059494f479ff720e8de33e22574650a" :secret "123")))
- "\n")
+ :text "\
+;;; public entries -*- mode: plstore -*-
+((\"ba950d38118a76d71f9f0591bb373d6cb366a512\"
+ :secret-secret t :host \"irc.gnu.org\" :user \"#chan\" :port \"irc\")
+ (\"7f17ca445d11158065e911a6d0f4cbf52ca250e3\"
+ :secret-secret t :host \"my.gnu.org\" :user \"#chan\" :port \"irc\")
+ (\"fcd3c8bd6daf4509de0ad6ee98e744ce0fca9377\"
+ :secret-secret t :host \"GNU.chat\" :user \"#chan\" :port \"irc\")
+ (\"1b3fab249a8dff77a4d8fe7eb4b0171b25cc711a\"
+ :secret-secret t :host \"GNU.chat\" :user \"#chan\" :port \"6697\")
+ (\"6cbcdc39476b8cfcca6f3e9a7876f41ec3f708cc\"
+ :secret-secret t :host \"my.gnu.org\" :user \"#fsf\" :port \"irc\")
+ (\"a33e2b3bd2d6f33995a4b88710a594a100c5e41d\"
+ :secret-secret t :host \"irc.gnu.org\" :port \"6667\")
+ (\"ab2fd349b2b7d6a9215bb35a92d054261b0b1537\"
+ :secret-secret t :host \"MyHost\" :port \"irc\")
+ (\"61a6bd552059494f479ff720e8de33e22574650a\"
+ :secret-secret t :host \"MyHost\" :port \"6667\"))
+;;; secret entries
+((\"ba950d38118a76d71f9f0591bb373d6cb366a512\" :secret \"bar\")
+ (\"7f17ca445d11158065e911a6d0f4cbf52ca250e3\" :secret \"baz\")
+ (\"fcd3c8bd6daf4509de0ad6ee98e744ce0fca9377\" :secret \"foo\")
+ (\"1b3fab249a8dff77a4d8fe7eb4b0171b25cc711a\" :secret \"spam\")
+ (\"6cbcdc39476b8cfcca6f3e9a7876f41ec3f708cc\" :secret \"42\")
+ (\"a33e2b3bd2d6f33995a4b88710a594a100c5e41d\" :secret \"sesame\")
+ (\"ab2fd349b2b7d6a9215bb35a92d054261b0b1537\" :secret \"456\")
+ (\"61a6bd552059494f479ff720e8de33e22574650a\" :secret \"123\"))"
(let ((auth-sources (list plstore-file))
(auth-source-do-cache nil))
@@ -303,17 +293,24 @@
;; auth-source JSON backend
-(defvar erc-services-tests--auth-source-json-standard-entries
- [(:host "irc.gnu.org" :port "irc" :user "#chan" :secret "bar")
- (:host "my.gnu.org" :port "irc" :user "#chan" :secret "baz")
- (:host "GNU.chat" :port "irc" :user "#chan" :secret "foo")])
+(defvar erc-services-tests--auth-source-json-standard-announced "\
+[{\"host\": \"irc.gnu.org\",
+ \"port\": \"irc\",
+ \"user\": \"#chan\",
+ \"secret\": \"bar\"},
+ {\"host\": \"my.gnu.org\",
+ \"port\": \"irc\",
+ \"user\": \"#chan\",
+ \"secret\": \"baz\"},
+ {\"host\": \"GNU.chat\",
+ \"port\": \"irc\",
+ \"user\": \"#chan\",
+ \"secret\": \"foo\"}]")
(ert-deftest erc--auth-source-search--json-standard ()
(ert-with-temp-file json-store
+ :text erc-services-tests--auth-source-json-standard-announced
:suffix ".json"
- :text (let ((json-object-type 'plist))
- (json-encode
- erc-services-tests--auth-source-json-standard-entries))
(let ((auth-sources (list json-store))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-standard #'erc-auth-source-search))))
@@ -321,10 +318,7 @@
(ert-deftest erc--auth-source-search--json-announced ()
(ert-with-temp-file plstore-file
:suffix ".json"
- :text (let ((json-object-type 'plist))
- (json-encode
- erc-services-tests--auth-source-json-standard-entries))
-
+ :text erc-services-tests--auth-source-json-standard-announced
(let ((auth-sources (list plstore-file))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-announced #'erc-auth-source-search))))
@@ -332,16 +326,36 @@
(ert-deftest erc--auth-source-search--json-overrides ()
(ert-with-temp-file json-file
:suffix ".json"
- :text (let ((json-object-type 'plist))
- (json-encode
- (vconcat
- erc-services-tests--auth-source-json-standard-entries
- [(:secret "spam" :host "GNU.chat" :user "#chan" :port "6697")
- (:secret "42" :host "my.gnu.org" :user "#fsf" :port "irc")
- (:secret "sesame" :host "irc.gnu.org" :port "6667")
- (:secret "456" :host "MyHost" :port "irc")
- (:secret "123" :host "MyHost" :port "6667")])))
-
+ :text "\
+[{\"host\": \"irc.gnu.org\",
+ \"port\": \"irc\",
+ \"user\": \"#chan\",
+ \"secret\": \"bar\"},
+ {\"host\": \"my.gnu.org\",
+ \"port\": \"irc\",
+ \"user\": \"#chan\",
+ \"secret\": \"baz\"},
+ {\"host\": \"GNU.chat\",
+ \"port\": \"irc\",
+ \"user\": \"#chan\",
+ \"secret\": \"foo\"},
+ {\"host\": \"GNU.chat\",
+ \"user\": \"#chan\",
+ \"port\": \"6697\",
+ \"secret\": \"spam\"},
+ {\"host\": \"my.gnu.org\",
+ \"user\": \"#fsf\",
+ \"port\": \"irc\",
+ \"secret\": \"42\"},
+ {\"host\": \"irc.gnu.org\",
+ \"port\": \"6667\",
+ \"secret\": \"sesame\"},
+ {\"host\": \"MyHost\",
+ \"port\": \"irc\",
+ \"secret\": \"456\"},
+ {\"host\": \"MyHost\",
+ \"port\": \"6667\",
+ \"secret\": \"123\"}]"
(let ((auth-sources (list json-file))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-overrides #'erc-auth-source-search))))
@@ -370,6 +384,14 @@
("#chan@my.gnu.org:irc" . "baz")
("#chan@GNU.chat:irc" . "foo")))
+(defun erc-services-tests--secrets-search-items (entries _ &rest r)
+ (mapcan (lambda (s)
+ (and (seq-every-p (pcase-lambda (`(,k . ,v))
+ (equal v (alist-get k (cdr s))))
+ (map-pairs r))
+ (list (car s))))
+ entries))
+
(ert-deftest erc--auth-source-search--secrets-standard ()
(skip-unless (bound-and-true-p secrets-enabled))
(let ((auth-sources '("secrets:Test"))
@@ -378,18 +400,12 @@
(secrets erc-services-tests--auth-source-secrets-standard-secrets))
(cl-letf (((symbol-function 'secrets-search-items)
- (lambda (col &rest r)
- (should (equal col "Test"))
- (should (plist-get r :user))
- (map-keys entries)))
+ (apply-partially #'erc-services-tests--secrets-search-items
+ entries))
((symbol-function 'secrets-get-secret)
- (lambda (col label)
- (should (equal col "Test"))
- (assoc-default label secrets)))
+ (lambda (_ label) (assoc-default label secrets)))
((symbol-function 'secrets-get-attributes)
- (lambda (col label)
- (should (equal col "Test"))
- (assoc-default label entries))))
+ (lambda (_ label) (assoc-default label entries))))
(erc-services-tests--auth-source-standard #'erc-auth-source-search))))
@@ -401,18 +417,12 @@
(secrets erc-services-tests--auth-source-secrets-standard-secrets))
(cl-letf (((symbol-function 'secrets-search-items)
- (lambda (col &rest r)
- (should (equal col "Test"))
- (should (plist-get r :user))
- (map-keys entries)))
+ (apply-partially #'erc-services-tests--secrets-search-items
+ entries))
((symbol-function 'secrets-get-secret)
- (lambda (col label)
- (should (equal col "Test"))
- (assoc-default label secrets)))
+ (lambda (_ label) (assoc-default label secrets)))
((symbol-function 'secrets-get-attributes)
- (lambda (col label)
- (should (equal col "Test"))
- (assoc-default label entries))))
+ (lambda (_ label) (assoc-default label entries))))
(erc-services-tests--auth-source-announced #'erc-auth-source-search))))
@@ -444,17 +454,12 @@
("MyHost:6667" . "123"))))
(cl-letf (((symbol-function 'secrets-search-items)
- (lambda (col &rest _)
- (should (equal col "Test"))
- (map-keys entries)))
+ (apply-partially #'erc-services-tests--secrets-search-items
+ entries))
((symbol-function 'secrets-get-secret)
- (lambda (col label)
- (should (equal col "Test"))
- (assoc-default label secrets)))
+ (lambda (_ label) (assoc-default label secrets)))
((symbol-function 'secrets-get-attributes)
- (lambda (col label)
- (should (equal col "Test"))
- (assoc-default label entries))))
+ (lambda (_ label) (assoc-default label entries))))
(erc-services-tests--auth-source-overrides #'erc-auth-source-search))))
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
new file mode 100644
index 00000000000..01e71e348e0
--- /dev/null
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -0,0 +1,265 @@
+;;; erc-stamp-tests.el --- Tests for erc-stamp. -*- 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 'ert-x)
+(require 'erc-stamp)
+(require 'erc-goodies) ; for `erc-make-read-only'
+
+;; These display-oriented tests are brittle because many factors
+;; influence how text properties are applied. We should just
+;; rework these into full scenarios.
+
+(defun erc-stamp-tests--insert-right (test)
+ (let ((val (list 0 0))
+ (erc-insert-modify-hook '(erc-add-timestamp))
+ (erc-insert-post-hook '(erc-make-read-only)) ; see comment above
+ (erc-timestamp-only-if-changed-flag nil)
+ ;;
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+
+ (advice-add 'erc-format-timestamp :filter-args
+ (lambda (args) (cons (cl-incf (cadr val) 60) (cdr args)))
+ '((name . ert-deftest--erc-timestamp-use-align-to)))
+
+ (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process (start-process "p" (current-buffer)
+ "sleep" "1")
+ erc-input-marker (make-marker)
+ erc-insert-marker (make-marker))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (set-marker erc-insert-marker (point-max))
+ (erc-display-prompt)
+
+ (funcall test)
+
+ (when noninteractive
+ (kill-buffer)))
+
+ (advice-remove 'erc-format-timestamp
+ 'ert-deftest--erc-timestamp-use-align-to)))
+
+(ert-deftest erc-timestamp-use-align-to--nil ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("nil, normal")
+ (let ((erc-timestamp-use-align-to nil))
+ (erc-display-message nil 'notice (current-buffer) "begin"))
+ (goto-char (point-min))
+ (should (search-forward-regexp
+ (rx "begin" (+ "\t") (* " ") "[") nil t))
+ ;; Field includes intervening spaces
+ (should (eql ?n (char-before (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ ;; The option `erc-timestamp-right-column' is normally nil by
+ ;; default, but it's a convenient stand in for a sufficiently
+ ;; small `erc-fill-column' (we can force a line break without
+ ;; involving that module).
+ (should-not erc-timestamp-right-column)
+
+ (ert-info ("nil, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to nil)
+ (erc-timestamp-right-column 20))
+ (erc-display-message nil 'notice (current-buffer)
+ "twenty characters"))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
+ ;; Field excludes leading whitespace (arguably undesirable).
+ (should (eql ?\[ (char-after (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line.
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--t ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("t, normal")
+ (let ((erc-timestamp-use-align-to t))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Exactly two spaces, one from format, one added by erc-stamp.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("t, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to t)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; Indented to pos (this is arguably a bug).
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
+ ;; Field starts *after* leading space (arguably bad).
+ (should (eql ?\[ (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--integer ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("integer, normal")
+ (let ((erc-timestamp-use-align-to 1))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added because included in format string.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("integer, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 1)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo [" nil t))
+ ;; Field starts at leading space.
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--margin ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+ (erc-stamp--display-margin-mode +1)
+
+ (ert-info ("margin, normal")
+ (let ((erc-timestamp-use-align-to 'margin))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (put-text-property 0 (length msg) 'wrap-prefix 10 msg)
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added (treated as opaque string).
+ (should (search-forward "msg one[" nil t))
+ ;; Field covers stamp alone
+ (should (eql ?e (char-before (field-beginning (point)))))
+ ;; Vanity props extended
+ (should (get-text-property (field-beginning (point)) 'wrap-prefix))
+ (should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix))
+ (should (get-text-property (1- (field-end (point))) 'wrap-prefix))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("margin, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 'margin)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo[" nil t))
+ ;; Field starts at format string (right bracket)
+ (should (eql ?\[ (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+;; This concerns a proposed partial reversal of the changes resulting
+;; from:
+;;
+;; 24.1.50; Wrong behavior of move-end-of-line in ERC (Bug#11706)
+;;
+;; Perhaps core behavior has changed since this bug was reported, but
+;; C-e stopping one char short of EOL no longer seems a problem.
+;; However, invoking C-n (`next-line') exhibits a similar effect.
+;; When point is in a stamp or near the beginning of a line, issuing a
+;; C-n puts point one past the start of the message (i.e., two chars
+;; beyond the timestamp's closing "]". Dropping the invisible
+;; property when timestamps are hidden does indeed prevent this, but
+;; it's also a lasting commitment. The docs mention that it's
+;; pointless to pair the old `intangible' property with `invisible'
+;; and suggest users look at `cursor-intangible-mode'. Turning off
+;; the latter does indeed do the trick as does decrementing the end of
+;; the `cursor-intangible' interval so that, in addition to C-n
+;; working, a C-f from before the timestamp doesn't overshoot. This
+;; appears to be the case whether `erc-hide-timestamps' is enabled or
+;; not, but it may be inadvisable for some reason (a hack) and
+;; therefore warrants further investigation.
+;;
+;; Note some striking omissions here:
+;;
+;; 1. a lack of `fill' module integration (we simulate it by
+;; making lines short enough to not wrap)
+;; 2. functions like `line-move' behave differently when
+;; `noninteractive'
+;; 3. no actual test assertions involving `cursor-sensor' movement
+;; even though that's a huge ingredient
+
+(ert-deftest erc-timestamp-intangible--left ()
+ (let ((erc-timestamp-only-if-changed-flag nil)
+ (erc-timestamp-intangible t) ; default changed to nil in 2014
+ (erc-hide-timestamps t)
+ (erc-insert-timestamp-function 'erc-insert-timestamp-left)
+ (erc-server-process (start-process "true" (current-buffer) "true"))
+ (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp))
+ msg
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (should (not cursor-sensor-inhibit))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (erc-mode)
+ (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*")
+ (erc-mode)
+ (erc--initialize-markers (point) nil)
+ (erc-munge-invisibility-spec)
+ (erc-display-message nil 'notice (current-buffer) "Welcome")
+ ;;
+ ;; Pretend `fill' is active and that these lines are
+ ;; folded. Otherwise, there's an annoying issue on wrapped lines
+ ;; (when visual-line-mode is off and stamps are visible) where
+ ;; C-e sends you to the end of the previous line.
+ (setq msg "Lorem ipsum dolor sit amet")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alyssa" msg nil t))
+ (erc-display-message nil 'notice (current-buffer) "Home")
+ (goto-char (point-min))
+
+ ;; EOL is actually EOL (Bug#11706)
+
+ (ert-info ("Notice before stamp, C-e") ; first line/stamp
+ (should (search-forward "Welcome" nil t))
+ (ert-simulate-command '(erc-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol))) ; `line-end-position' fails because fields
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg before stamp, C-e")
+ (should (search-forward "Lorem" nil t))
+ (goto-char (pos-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg first line, C-e")
+ (goto-char (pos-bol))
+ (should (search-forward "ipsum" nil t))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (when noninteractive
+ (kill-buffer)))))
+
+;;; erc-stamp-tests.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index d6c63934163..29bda7e742d 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -113,15 +113,27 @@
(should (get-buffer "#spam"))
(kill-buffer "#spam")))
+(ert-deftest erc-with-server-buffer ()
+ (setq erc-away 1)
+ (erc-tests--set-fake-server-process "sleep" "1")
+
+ (let (calls)
+ (advice-add 'buffer-local-value :after (lambda (&rest r) (push r calls))
+ '((name . erc-with-server-buffer)))
+
+ (should (= 1 (erc-with-server-buffer erc-away)))
+ (should (equal (pop calls) (list 'erc-away (current-buffer))))
+
+ (should (= 1 (erc-with-server-buffer (ignore 'me) erc-away)))
+ (should-not calls)
+
+ (advice-remove 'buffer-local-value 'erc-with-server-buffer)))
+
(defun erc-tests--send-prep ()
;; Caller should probably shadow `erc-insert-modify-hook' or
;; populate user tables for erc-button.
(erc-mode)
- (insert "\n\n")
- (setq erc-input-marker (make-marker)
- erc-insert-marker (make-marker))
- (set-marker erc-insert-marker (point-max))
- (erc-display-prompt)
+ (erc--initialize-markers (point) nil)
(should (= (point) erc-input-marker)))
(defun erc-tests--set-fake-server-process (&rest args)
@@ -257,6 +269,79 @@
(kill-buffer "bob")
(kill-buffer "ServNet"))))
+(ert-deftest erc--initialize-markers ()
+ (let ((proc (start-process "true" (current-buffer) "true"))
+ erc-modules
+ erc-connect-pre-hook
+ erc-insert-modify-hook
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (set-process-query-on-exit-flag proc nil)
+ (erc-mode)
+ (setq erc-server-process proc
+ erc-networks--id (erc-networks--id-create 'foonet))
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 3 (marker-position erc-insert-marker)))
+ (should (= 8 (marker-position erc-input-marker)))
+ (should (= 8 (point-max)))
+ (should (= 8 (point)))
+ ;; These prompt properties are a continual source of confusion.
+ ;; Including the literal defaults here can hopefully serve as a
+ ;; quick reference for anyone operating in that area.
+ (should (equal (buffer-string)
+ #("\n\nERC> "
+ 2 6 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 6 7 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+
+ ;; Simulate some activity by inserting some text before and
+ ;; after the prompt (multiline).
+ (erc-display-error-notice nil "Welcome")
+ (goto-char (point-max))
+ (insert "Hello\nWorld")
+ (goto-char 3)
+ (should (looking-at-p (regexp-quote "*** Welcome"))))
+
+ (ert-info ("Reconnect")
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (should-not (get-buffer "#chan<2>")))
+
+ (ert-info ("Existing prompt respected")
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 15 (marker-position erc-insert-marker)))
+ (should (= 20 (marker-position erc-input-marker)))
+ (should (= 3 (point))) ; point restored
+ (should (equal (buffer-string)
+ #("\n\n*** Welcome\nERC> Hello\nWorld"
+ 2 13 (font-lock-face erc-error-face)
+ 14 18 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 18 19 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+ (when noninteractive
+ (kill-buffer))))))
+
(ert-deftest erc--switch-to-buffer ()
(defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el
@@ -314,6 +399,309 @@
(dolist (b '("server" "other" "#chan" "#foo" "#fake"))
(kill-buffer b))))
+(defun erc-tests--run-in-term (&optional debug)
+ (let* ((default-directory (getenv "EMACS_TEST_DIRECTORY"))
+ (emacs (expand-file-name invocation-name invocation-directory))
+ (process-environment (cons "ERC_TESTS_SUBPROCESS=1"
+ process-environment))
+ (name (ert-test-name (ert-running-test)))
+ (temp-file (make-temp-file "erc-term-test-"))
+ (cmd `(let ((stats 1))
+ (setq enable-dir-local-variables nil)
+ (unwind-protect
+ (setq stats (ert-run-tests-batch ',name))
+ (unless ',debug
+ (let ((buf (with-current-buffer (messages-buffer)
+ (buffer-string))))
+ (with-temp-file ,temp-file
+ (insert buf)))
+ (kill-emacs (ert-stats-completed-unexpected stats))))))
+ ;; `ert-test' object in Emacs 29 has a `file-name' field
+ (file-name (symbol-file name 'ert--test))
+ (default-directory (expand-file-name (file-name-directory file-name)))
+ (package (if-let* ((found (getenv "ERC_PACKAGE_NAME"))
+ ((string-prefix-p "erc-" found)))
+ (intern found)
+ 'erc))
+ (setup (and (featurep 'compat)
+ `(progn
+ (require 'package)
+ (let ((package-load-list '((compat t) (,package t))))
+ (package-initialize)))))
+ ;; Make subprocess terminal bigger than controlling.
+ (buf (cl-letf (((symbol-function 'window-screen-lines)
+ (lambda () 20))
+ ((symbol-function 'window-max-chars-per-line)
+ (lambda () 40)))
+ (make-term (symbol-name name) emacs nil "-Q" "-nw"
+ "-eval" (prin1-to-string setup)
+ "-l" file-name "-eval" (format "%S" cmd))))
+ (proc (get-buffer-process buf))
+ (err (lambda ()
+ (with-temp-buffer
+ (insert-file-contents temp-file)
+ (message "Subprocess: %s" (buffer-string))
+ (delete-file temp-file)))))
+ (with-current-buffer buf
+ (set-process-query-on-exit-flag proc nil)
+ (with-timeout (10 (funcall err) (error "Timed out awaiting result"))
+ (while (process-live-p proc)
+ (accept-process-output proc 0.1)))
+ (while (accept-process-output proc))
+ (goto-char (point-min))
+ ;; Otherwise gives process exited abnormally with exit-code >0
+ (unless (search-forward (format "Process %s finished" name) nil t)
+ (funcall err)
+ (ert-fail (when (search-forward "exited" nil t)
+ (buffer-substring-no-properties (line-beginning-position)
+ (line-end-position)))))
+ (delete-file temp-file)
+ (when noninteractive
+ (kill-buffer)))))
+
+(defun erc-tests--servars (source &rest vars)
+ (unless (bufferp source)
+ (setq source (get-buffer source)))
+ (dolist (var vars)
+ (should (local-variable-if-set-p var))
+ (set var (buffer-local-value var source))))
+
+(defun erc-tests--erc-reuse-frames (test &optional debug)
+ (if (and (or debug noninteractive) (not (getenv "ERC_TESTS_SUBPROCESS")))
+ (progn
+ (when (memq system-type '(windows-nt ms-dos))
+ (ert-skip "System must be UNIX"))
+ (erc-tests--run-in-term debug))
+ (should-not erc-frame-dedicated-flag)
+ (should (eq erc-reuse-frames t))
+ (let ((erc-join-buffer 'frame)
+ (erc-reuse-frames t)
+ (erc-frame-alist nil)
+ (orig-frame (selected-frame))
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (delete-other-frames)
+ (delete-other-windows)
+ (set-window-buffer (selected-window) "*scratch*")
+ (funcall test orig-frame)
+ (delete-other-frames orig-frame)
+ (delete-other-windows))))
+
+;; TODO add cases for frame-display behavior while reconnecting
+
+(defun erc-tests--erc-reuse-frames--t (_)
+ (ert-info ("New server buffer creates and raises second frame")
+ (with-current-buffer (generate-new-buffer "server")
+ (erc-mode)
+ (setq erc-server-process (start-process "server"
+ (current-buffer) "sleep" "10")
+ erc-frame-alist (cons '(name . "server") default-frame-alist)
+ erc-network 'foonet
+ erc-networks--id (erc-networks--id-create nil)
+ erc--server-last-reconnect-count 0)
+ (set-process-buffer erc-server-process (current-buffer))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (should-not (get-buffer-window (current-buffer) t))
+ (erc-setup-buffer (current-buffer))
+ (should (equal "server" (frame-parameter (window-frame) 'name)))
+ (should (get-buffer-window (current-buffer) t))))
+
+ (ert-info ("New channel creates and raises third frame")
+ (with-current-buffer (generate-new-buffer "#chan")
+ (erc-mode)
+ (erc-tests--servars "server" 'erc-server-process 'erc-networks--id
+ 'erc-network)
+ (setq erc-frame-alist (cons '(name . "#chan") default-frame-alist)
+ erc-default-recipients '("#chan"))
+ (should-not (get-buffer-window (current-buffer) t))
+ (erc-setup-buffer (current-buffer))
+ (should (equal "#chan" (frame-parameter (window-frame) 'name)))
+ (should (get-buffer-window (current-buffer) t))
+ (should (cddr (frame-list))))))
+
+(ert-deftest erc-reuse-frames--t ()
+ :tags '(:unstable :expensive-test)
+ (erc-tests--erc-reuse-frames
+ (lambda (orig-frame)
+ (erc-tests--erc-reuse-frames--t orig-frame)
+ (dolist (b '("server" "#chan"))
+ (kill-buffer b)))))
+
+(defun erc-tests--erc-reuse-frames--displayed-single (_ server-name chan-name)
+
+ (should (eq erc-reuse-frames 'displayed))
+
+ (ert-info ("New server buffer shown in existing frame")
+ (with-current-buffer (generate-new-buffer server-name)
+ (erc-mode)
+ (setq erc-server-process (start-process server-name (current-buffer)
+ "sleep" "10")
+ erc-frame-alist (cons `(name . ,server-name) default-frame-alist)
+ erc-network (make-symbol server-name)
+ erc-server-current-nick "tester"
+ erc-networks--id (erc-networks--id-create nil)
+ erc--server-last-reconnect-count 0)
+ (set-process-buffer erc-server-process (current-buffer))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (should-not (get-buffer-window (current-buffer) t))
+ (erc-setup-buffer (current-buffer))
+ (should-not (equal server-name (frame-parameter (window-frame) 'name)))
+ ;; New server buffer window appears in split below ERT/scratch
+ (should (get-buffer-window (current-buffer) t))))
+
+ (ert-info ("New channel shown in existing frame")
+ (with-current-buffer (generate-new-buffer chan-name)
+ (erc-mode)
+ (erc-tests--servars server-name 'erc-server-process 'erc-networks--id
+ 'erc-network)
+ (setq erc-frame-alist (cons `(name . ,chan-name) default-frame-alist)
+ erc-default-recipients (list chan-name))
+ (should-not (get-buffer-window (current-buffer) t))
+ (erc-setup-buffer (current-buffer))
+ (should-not (equal chan-name (frame-parameter (window-frame) 'name)))
+ ;; New channel buffer replaces server in lower window
+ (should (get-buffer-window (current-buffer) t))
+ (should-not (get-buffer-window server-name t)))))
+
+(ert-deftest erc-reuse-frames--displayed-single ()
+ :tags '(:unstable :expensive-test)
+ (erc-tests--erc-reuse-frames
+ (lambda (orig-frame)
+ (let ((erc-reuse-frames 'displayed))
+ (erc-tests--erc-reuse-frames--displayed-single orig-frame
+ "server" "#chan")
+ (should-not (cdr (frame-list))))
+ (dolist (b '("server" "#chan"))
+ (kill-buffer b)))))
+
+(defun erc-tests--assert-server-split (buffer-or-name frame-name)
+ ;; Assert current buffer resides on one side of a horizontal split
+ ;; in the "server" frame but is not selected.
+ (let* ((buffer-window (get-buffer-window buffer-or-name t))
+ (buffer-frame (window-frame buffer-window)))
+ (should (equal frame-name (frame-parameter buffer-frame 'name)))
+ (should (memq buffer-window (car-safe (window-tree buffer-frame))))
+ (should-not (eq buffer-window (frame-selected-window)))
+ buffer-frame))
+
+(defun erc-tests--erc-reuse-frames--displayed-double (_)
+ (should (eq erc-reuse-frames 'displayed))
+
+ (make-frame '((name . "other")))
+ (select-frame (make-frame '((name . "server"))) 'no-record)
+ (set-window-buffer (selected-window) "*scratch*") ; invokes `erc'
+
+ ;; A user invokes an entry point and switches immediately to a new
+ ;; frame before autojoin kicks in (bug#55540).
+
+ (ert-info ("New server buffer shown in selected frame")
+ (with-current-buffer (generate-new-buffer "server")
+ (erc-mode)
+ (setq erc-server-process (start-process "server" (current-buffer)
+ "sleep" "10")
+ erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-networks--id (erc-networks--id-create nil)
+ erc--server-last-reconnect-count 0)
+ (set-process-buffer erc-server-process (current-buffer))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (should-not (get-buffer-window (current-buffer) t))
+ (erc-setup-buffer (current-buffer))
+ (should (equal "server" (frame-parameter (window-frame) 'name)))
+ (should (get-buffer-window (current-buffer) t))))
+
+ (select-frame-by-name "other")
+
+ (ert-info ("New channel shown in dedicated frame")
+ (with-current-buffer (generate-new-buffer "#chan")
+ (erc-mode)
+ (erc-tests--servars "server" 'erc-server-process 'erc-networks--id
+ 'erc-network)
+ (setq erc-frame-alist (cons '(name . "#chan") default-frame-alist)
+ erc-default-recipients '("#chan"))
+ (should-not (get-buffer-window (current-buffer) t))
+ (erc-setup-buffer (current-buffer))
+ (erc-tests--assert-server-split (current-buffer) "server")
+ ;; New channel buffer replaces server in lower window of other frame
+ (should-not (get-buffer-window "server" t)))))
+
+(ert-deftest erc-reuse-frames--displayed-double ()
+ :tags '(:unstable :expensive-test)
+ (erc-tests--erc-reuse-frames
+ (lambda (orig-frame)
+ (let ((erc-reuse-frames 'displayed))
+ (erc-tests--erc-reuse-frames--displayed-double orig-frame))
+ (dolist (b '("server" "#chan"))
+ (kill-buffer b)))))
+
+;; If a frame showing ERC buffers exists among other frames, new,
+;; additional connections will use the existing IRC frame. However,
+;; if two or more frames exist with ERC buffers unique to a particular
+;; connection, the correct frame will be found.
+
+(defun erc-tests--erc-reuse-frames--displayed-full (orig-frame)
+ (erc-tests--erc-reuse-frames--displayed-double orig-frame)
+ ;; Server buffer is not displayed because #chan has replaced it in
+ ;; the "server" frame, which is not selected.
+ (should (equal "other" (frame-parameter (window-frame) 'name)))
+ (erc-tests--erc-reuse-frames--displayed-single orig-frame "ircd" "#spam")
+ (should (equal "other" (frame-parameter (window-frame) 'name)))
+
+ ;; Buffer "#spam" has replaced "ircd", which earlier replaced
+ ;; "#chan" in frame "server". But this is confusing, so...
+ (ert-info ("Arrange windows for second connection in other frame")
+ (set-window-buffer (selected-window) "ircd")
+ (split-window-below)
+ (set-window-buffer (next-window) "#spam")
+ (should (equal (cddar (window-tree))
+ (list (get-buffer-window "ircd" t)
+ (get-buffer-window "#spam" t)))))
+
+ (ert-info ("Arrange windows for first connection in server frame")
+ (select-frame-by-name "server")
+ (set-window-buffer (selected-window) "server")
+ (set-window-buffer (next-window) "#chan")
+ (should (equal (cddar (window-tree))
+ (list (get-buffer-window "server" t)
+ (get-buffer-window "#chan" t)))))
+
+ ;; Select original ERT frame
+ (ert-info ("New target for connection server finds appropriate frame")
+ (select-frame orig-frame 'no-record)
+ (with-current-buffer (window-buffer (selected-window))
+ (should (member (buffer-name) '("*ert*" "*scratch*")))
+ (with-current-buffer (generate-new-buffer "alice")
+ (erc-mode)
+ (erc-tests--servars "server" 'erc-server-process 'erc-networks--id)
+ (setq erc-default-recipients '("alice"))
+ (should-not (get-buffer-window (current-buffer) t))
+ (erc-setup-buffer (current-buffer))
+ ;; Window created in frame "server"
+ (should (eq (selected-frame) orig-frame))
+ (erc-tests--assert-server-split (current-buffer) "server"))))
+
+ (ert-info ("New target for connection ircd finds appropriate frame")
+ (select-frame orig-frame 'no-record)
+ (with-current-buffer (window-buffer (selected-window))
+ (should (member (buffer-name) '("*ert*" "*scratch*")))
+ (with-current-buffer (generate-new-buffer "bob")
+ (erc-mode)
+ (erc-tests--servars "ircd" 'erc-server-process 'erc-networks--id)
+ (setq erc-default-recipients '("bob"))
+ (should-not (get-buffer-window (current-buffer) t))
+ (erc-setup-buffer (current-buffer))
+ ;; Window created in frame "other"
+ (should (eq (selected-frame) orig-frame))
+ (erc-tests--assert-server-split (current-buffer) "other")))))
+
+(ert-deftest erc-reuse-frames--displayed-full ()
+ :tags '(:unstable :expensive-test)
+ (erc-tests--erc-reuse-frames
+ (lambda (orig-frame)
+ (let ((erc-reuse-frames 'displayed))
+ (erc-tests--erc-reuse-frames--displayed-full orig-frame))
+ (dolist (b '("server" "ircd" "bob" "alice" "#spam" "#chan"))
+ (kill-buffer b)))))
+
(ert-deftest erc-lurker-maybe-trim ()
(let (erc-lurker-trim-nicks
(erc-lurker-ignore-chars "_`"))
@@ -447,6 +835,27 @@
(should (equal (erc-downcase "Tilde~") "tilde~" ))
(should (equal (erc-downcase "\\O/") "|o/" )))))
+(ert-deftest erc-channel-p ()
+ (let ((erc--isupport-params (make-hash-table))
+ erc-server-parameters)
+
+ (should (erc-channel-p "#chan"))
+ (should (erc-channel-p "##chan"))
+ (should (erc-channel-p "&chan"))
+ (should (erc-channel-p "+chan"))
+ (should (erc-channel-p "!chan"))
+ (should-not (erc-channel-p "@chan"))
+
+ (push '("CHANTYPES" . "#&@+!") erc-server-parameters)
+
+ (should (erc-channel-p "!chan"))
+ (should (erc-channel-p "#chan"))
+
+ (with-current-buffer (get-buffer-create "#chan")
+ (setq erc--target (erc--target-from-string "#chan")))
+ (should (erc-channel-p (get-buffer "#chan"))))
+ (kill-buffer "#chan"))
+
(ert-deftest erc--valid-local-channel-p ()
(ert-info ("Local channels not supported")
(let ((erc--isupport-params (make-hash-table)))
@@ -471,6 +880,50 @@
(should (equal (erc--target-from-string "&Bitlbee")
#s(erc--target-channel-local "&Bitlbee" &bitlbee)))))
+(ert-deftest erc--modify-local-map ()
+ (when (and (bound-and-true-p erc-irccontrols-mode)
+ (fboundp 'erc-irccontrols-mode))
+ (erc-irccontrols-mode -1))
+ (when (and (bound-and-true-p erc-match-mode)
+ (fboundp 'erc-match-mode))
+ (erc-match-mode -1))
+ (let* (calls
+ (inhibit-message noninteractive)
+ (cmd-foo (lambda () (interactive) (push 'foo calls)))
+ (cmd-bar (lambda () (interactive) (push 'bar calls))))
+
+ (ert-info ("Add non-existing")
+ (erc--modify-local-map t "C-c C-c" cmd-foo "C-c C-k" cmd-bar)
+ (with-temp-buffer
+ (set-window-buffer (selected-window) (current-buffer))
+ (use-local-map erc-mode-map)
+ (execute-kbd-macro "\C-c\C-c")
+ (execute-kbd-macro "\C-c\C-k"))
+ (should (equal calls '(bar foo))))
+ (setq calls nil)
+
+ (ert-info ("Add existing") ; Attempt to swap definitions fails
+ (erc--modify-local-map t "C-c C-c" cmd-bar "C-c C-k" cmd-foo)
+ (with-temp-buffer
+ (set-window-buffer (selected-window) (current-buffer))
+ (use-local-map erc-mode-map)
+ (execute-kbd-macro "\C-c\C-c")
+ (execute-kbd-macro "\C-c\C-k"))
+ (should (equal calls '(bar foo))))
+ (setq calls nil)
+
+ (ert-info ("Remove existing")
+ (ert-with-message-capture messages
+ (erc--modify-local-map nil "C-c C-c" cmd-foo "C-c C-k" cmd-bar)
+ (with-temp-buffer
+ (set-window-buffer (selected-window) (current-buffer))
+ (use-local-map erc-mode-map)
+ (execute-kbd-macro "\C-c\C-c")
+ (execute-kbd-macro "\C-c\C-k"))
+ (should (string-search "C-c C-c is undefined" messages))
+ (should (string-search "C-c C-k is undefined" messages))
+ (should-not calls)))))
+
(ert-deftest erc-ring-previous-command-base-case ()
(ert-info ("Create ring when nonexistent and do nothing")
(let (erc-input-ring
@@ -494,8 +947,8 @@
;;
(cl-letf (((symbol-function 'erc-process-input-line)
(lambda (&rest _)
- (insert-before-markers
- (erc-display-message-highlight 'notice "echo: one\n"))))
+ (erc-display-message
+ nil 'notice (current-buffer) "echo: one\n")))
((symbol-function 'erc-command-no-process-p)
(lambda (&rest _) t)))
(ert-info ("Create ring, populate, recall")
@@ -999,32 +1452,67 @@
(should (string-match erc--server-connect-dumb-ipv6-regexp
(concat "[" a "]")))))
+(ert-deftest erc--with-entrypoint-environment ()
+ (let ((env '((erc-join-buffer . foo)
+ (erc-server-connect-function . bar))))
+ (erc--with-entrypoint-environment env
+ (should (eq erc-join-buffer 'foo))
+ (should (eq erc-server-connect-function 'bar)))))
+
(ert-deftest erc-select-read-args ()
- (ert-info ("Does not default to TLS")
- (should (equal (ert-simulate-keys "\r\r\r\r"
+ (ert-info ("Prompts for switch to TLS by default")
+ (should (equal (ert-simulate-keys "\r\r\r\ry\r"
(erc-select-read-args))
(list :server "irc.libera.chat"
- :port 6667
+ :port 6697
+ :nick (user-login-name)
+ '&interactive-env
+ '((erc-server-connect-function . erc-open-tls-stream)
+ (erc-join-buffer . buffer))))))
+
+ (ert-info ("Switches to TLS when port matches default TLS port")
+ (should (equal (ert-simulate-keys "irc.gnu.org\r6697\r\r\r"
+ (erc-select-read-args))
+ (list :server "irc.gnu.org"
+ :port 6697
+ :nick (user-login-name)
+ '&interactive-env
+ '((erc-server-connect-function . erc-open-tls-stream)
+ (erc-join-buffer . buffer))))))
+
+ (ert-info ("Switches to TLS when URL is ircs://")
+ (should (equal (ert-simulate-keys "ircs://irc.gnu.org\r\r\r\r"
+ (erc-select-read-args))
+ (list :server "irc.gnu.org"
+ :port 6697
:nick (user-login-name)
- :password nil))))
+ '&interactive-env
+ '((erc-server-connect-function . erc-open-tls-stream)
+ (erc-join-buffer . buffer))))))
+
+ (setq-local erc-interactive-display nil) ; cheat to save space
+
+ (ert-info ("Opt out of non-TLS warning manually")
+ (should (equal (ert-simulate-keys "\r\r\r\rn\r"
+ (erc-select-read-args))
+ (list :server "irc.libera.chat"
+ :port 6667
+ :nick (user-login-name)))))
(ert-info ("Override default TLS")
(should (equal (ert-simulate-keys "irc://irc.libera.chat\r\r\r\r"
(erc-select-read-args))
(list :server "irc.libera.chat"
:port 6667
- :nick (user-login-name)
- :password nil))))
+ :nick (user-login-name)))))
(ert-info ("Address includes port")
- (should (equal (ert-simulate-keys
- "localhost:6667\rnick\r\r"
+ (should (equal (ert-simulate-keys "localhost:6667\rnick\r\r"
(erc-select-read-args))
(list :server "localhost"
:port 6667
- :nick "nick"
- :password nil))))
+ :nick "nick"))))
(ert-info ("Address includes nick, password skipped via option")
(should (equal (ert-simulate-keys "nick@localhost:6667\r"
@@ -1032,8 +1520,7 @@
(erc-select-read-args)))
(list :server "localhost"
:port 6667
- :nick "nick"
- :password nil))))
+ :nick "nick"))))
(ert-info ("Address includes nick and password")
(should (equal (ert-simulate-keys "nick:sesame@localhost:6667\r\r"
@@ -1048,37 +1535,53 @@
(erc-select-read-args))
(list :server "[::1]"
:port 6667
- :nick (user-login-name)
- :password nil))))
+ :nick (user-login-name)))))
(ert-info ("IPv6 address with port")
(should (equal (ert-simulate-keys "[::1]:6667\r\r\r"
(erc-select-read-args))
(list :server "[::1]"
:port 6667
- :nick (user-login-name)
- :password nil))))
+ :nick (user-login-name)))))
(ert-info ("IPv6 address includes nick")
(should (equal (ert-simulate-keys "nick@[::1]:6667\r\r"
(erc-select-read-args))
(list :server "[::1]"
+ :port 6667
+ :nick "nick"))))
+
+ (ert-info ("Extra args use URL nick by default")
+ (should (equal (ert-simulate-keys "nick:sesame@localhost:6667\r\r\r\r"
+ (let ((current-prefix-arg '(4)))
+ (erc-select-read-args)))
+ (list :server "localhost"
:port 6667
:nick "nick"
- :password nil)))))
+ :user "nick"
+ :password "sesame"
+ :full-name "nick")))))
(ert-deftest erc-tls ()
- (let (calls)
+ (let (calls env)
(cl-letf (((symbol-function 'user-login-name)
(lambda (&optional _) "tester"))
((symbol-function 'erc-open)
- (lambda (&rest r) (push r calls))))
+ (lambda (&rest r)
+ (push `((erc-join-buffer ,erc-join-buffer)
+ (erc-server-connect-function
+ ,erc-server-connect-function))
+ env)
+ (push r calls))))
(ert-info ("Defaults")
(erc-tls)
(should (equal (pop calls)
'("irc.libera.chat" 6697 "tester" "unknown" t
- nil nil nil nil nil "user" nil))))
+ nil nil nil nil nil "user" nil)))
+ (should (equal (pop env)
+ '((erc-join-buffer bury)
+ (erc-server-connect-function erc-open-tls-stream)))))
(ert-info ("Full")
(erc-tls :server "irc.gnu.org"
@@ -1091,7 +1594,10 @@
:id 'GNU.org)
(should (equal (pop calls)
'("irc.gnu.org" 7000 "bob" "Bob's Name" t
- "bob:changeme" nil nil nil t "bobo" GNU.org))))
+ "bob:changeme" nil nil nil t "bobo" GNU.org)))
+ (should (equal (pop env)
+ '((erc-join-buffer bury)
+ (erc-server-connect-function erc-open-tls-stream)))))
;; Values are often nil when called by lisp code, which leads to
;; null params. This is why `erc-open' recomputes almost
@@ -1107,7 +1613,92 @@
:password "bob:changeme"))
(should (equal (pop calls)
'(nil 7000 nil "Bob's Name" t
- "bob:changeme" nil nil nil nil "bobo" nil)))))))
+ "bob:changeme" nil nil nil nil "bobo" nil)))
+ (should (equal (pop env)
+ '((erc-join-buffer bury)
+ (erc-server-connect-function erc-open-tls-stream)))))
+
+ (ert-info ("Interactive")
+ (ert-simulate-keys "nick:sesame@localhost:6667\r\r"
+ (call-interactively #'erc-tls))
+ (should (equal (pop calls)
+ '("localhost" 6667 "nick" "unknown" t "sesame"
+ nil nil nil nil "user" nil)))
+ (should (equal (pop env)
+ '((erc-join-buffer buffer)
+ (erc-server-connect-function erc-open-tls-stream)))))
+
+ (ert-info ("Custom connect function")
+ (let ((erc-server-connect-function 'my-connect-func))
+ (erc-tls)
+ (should (equal (pop calls)
+ '("irc.libera.chat" 6697 "tester" "unknown" t
+ nil nil nil nil nil "user" nil)))
+ (should (equal (pop env)
+ '((erc-join-buffer bury)
+ (erc-server-connect-function my-connect-func))))))
+
+ (ert-info ("Advised default function overlooked") ; intentional
+ (advice-add 'erc-server-connect-function :around #'ignore
+ '((name . erc-tests--erc-tls)))
+ (erc-tls)
+ (should (equal (pop calls)
+ '("irc.libera.chat" 6697 "tester" "unknown" t
+ nil nil nil nil nil "user" nil)))
+ (should (equal (pop env)
+ '((erc-join-buffer bury)
+ (erc-server-connect-function erc-open-tls-stream))))
+ (advice-remove 'erc-server-connect-function 'erc-tests--erc-tls))
+
+ (ert-info ("Advised non-default function honored")
+ (let ((f (lambda (&rest r) (ignore r))))
+ (cl-letf (((symbol-value 'erc-server-connect-function) f))
+ (advice-add 'erc-server-connect-function :around #'ignore
+ '((name . erc-tests--erc-tls)))
+ (erc-tls)
+ (should (equal (pop calls)
+ '("irc.libera.chat" 6697 "tester" "unknown" t
+ nil nil nil nil nil "user" nil)))
+ (should (equal (pop env) `((erc-join-buffer bury)
+ (erc-server-connect-function ,f))))
+ (advice-remove 'erc-server-connect-function
+ 'erc-tests--erc-tls)))))))
+
+;; See `erc-select-read-args' above for argument parsing.
+;; This only tests the "hidden" arguments.
+
+(ert-deftest erc--interactive ()
+ (let (calls env)
+ (cl-letf (((symbol-function 'user-login-name)
+ (lambda (&optional _) "tester"))
+ ((symbol-function 'erc-open)
+ (lambda (&rest r)
+ (push `((erc-join-buffer ,erc-join-buffer)
+ (erc-server-connect-function
+ ,erc-server-connect-function))
+ env)
+ (push r calls))))
+
+ (ert-info ("Default click-through accept TLS upgrade")
+ (ert-simulate-keys "\r\r\r\ry\r"
+ (call-interactively #'erc))
+ (should (equal (pop calls)
+ '("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-open-tls-stream)))))
+
+ (ert-info ("Nick supplied, decline TLS upgrade")
+ (ert-simulate-keys "\r\rdummy\r\rn\r"
+ (call-interactively #'erc))
+ (should (equal (pop calls)
+ '("irc.libera.chat" 6667 "dummy" "unknown" t nil
+ nil nil nil nil "user" nil)))
+ (should (equal (pop env)
+ '((erc-join-buffer buffer)
+ (erc-server-connect-function
+ erc-open-network-stream))))))))
(defun erc-tests--make-server-buf (name)
(with-current-buffer (get-buffer-create name)
@@ -1203,27 +1794,150 @@
(kill-buffer "baznet")
(kill-buffer "#chan")))
+(defconst erc-tests--modules
+ '( autoaway autojoin button capab-identify completion dcc fill identd
+ imenu irccontrols keep-place list log match menu move-to-prompt netsplit
+ networks noncommands notifications notify page readonly
+ replace ring sasl scrolltobottom services smiley sound
+ spelling stamp track truncate unmorse xdcc))
+
+;; Ensure that `:initialize' doesn't change the ordering of the
+;; members because otherwise the widget's state is "edited".
+
+(ert-deftest erc-modules--initialize ()
+ ;; This is `custom--standard-value' from Emacs 28.
+ (should (equal (eval (car (get 'erc-modules 'standard-value)) t)
+ erc-modules)))
+
+;; Ensure the `:initialize' function for `erc-modules' successfully
+;; tags all built-in modules with the internal property `erc--module'.
+
+(ert-deftest erc-modules--internal-property ()
+ (let (ours)
+ (mapatoms (lambda (s)
+ (when-let ((v (get s 'erc--module))
+ ((eq v s)))
+ (push s ours))))
+ (should (equal (sort ours #'string-lessp) erc-tests--modules))))
+
+(ert-deftest erc--normalize-module-symbol ()
+ (dolist (mod erc-tests--modules)
+ (should (eq (erc--normalize-module-symbol mod) mod)))
+ (should (eq (erc--normalize-module-symbol 'pcomplete) 'completion))
+ (should (eq (erc--normalize-module-symbol 'Completion) 'completion))
+ (should (eq (erc--normalize-module-symbol 'ctcp-page) 'page))
+ (should (eq (erc--normalize-module-symbol 'ctcp-sound) 'sound))
+ (should (eq (erc--normalize-module-symbol 'timestamp) 'stamp))
+ (should (eq (erc--normalize-module-symbol 'nickserv) 'services)))
+
+;; Worrying about which library a module comes from is mostly not
+;; worth the hassle so long as ERC can find its minor mode. However,
+;; bugs involving multiple modules living in the same library may slip
+;; by because a module's loading problems may remain hidden on account
+;; of its place in the default ordering.
+
+(ert-deftest erc--find-mode ()
+ (let* ((package (if-let* ((found (getenv "ERC_PACKAGE_NAME"))
+ ((string-prefix-p "erc-" found)))
+ (intern found)
+ 'erc))
+ (prog
+ `(,@(and (featurep 'compat)
+ `((progn
+ (require 'package)
+ (let ((package-load-list '((compat t) (,package t))))
+ (package-initialize)))))
+ (require 'erc)
+ (let ((mods (mapcar #'cadddr
+ (cdddr (get 'erc-modules 'custom-type))))
+ moded)
+ (setq mods
+ (sort mods (lambda (a b) (if (zerop (random 2)) a b))))
+ (dolist (mod mods)
+ (unless (keywordp mod)
+ (push (if-let ((mode (erc--find-mode mod)))
+ mod
+ (list :missing mod))
+ moded)))
+ (message "%S"
+ (sort moded
+ (lambda (a b)
+ (string< (symbol-name a) (symbol-name b))))))))
+ (proc (start-process "erc--module-mode-autoloads"
+ (current-buffer)
+ (concat invocation-directory invocation-name)
+ "-batch" "-Q"
+ "-eval" (format "%S" (cons 'progn prog)))))
+ (set-process-query-on-exit-flag proc t)
+ (while (accept-process-output proc 10))
+ (goto-char (point-min))
+ (should (equal (read (current-buffer)) erc-tests--modules))))
+
(ert-deftest erc-migrate-modules ()
(should (equal (erc-migrate-modules '(autojoin timestamp button))
'(autojoin stamp button)))
;; Default unchanged
(should (equal (erc-migrate-modules erc-modules) erc-modules)))
+(ert-deftest erc--find-group ()
+ ;; These two are loaded by default
+ (should (eq (erc--find-group 'keep-place nil) 'erc))
+ (should (eq (erc--find-group 'networks nil) 'erc-networks))
+ ;; These are fake
+ (cl-letf (((get 'erc-bar 'group-documentation) "")
+ ((get 'baz 'erc-group) 'erc-foo))
+ (should (eq (erc--find-group 'foo 'bar) 'erc-bar))
+ (should (eq (erc--find-group 'bar 'foo) 'erc-bar))
+ (should (eq (erc--find-group 'bar nil) 'erc-bar))
+ (should (eq (erc--find-group 'foo nil) 'erc))
+ (should (eq (erc--find-group 'fake 'baz) 'erc-foo))))
+
+(ert-deftest erc--find-group--real ()
+ :tags '(:unstable)
+ (require 'erc-services)
+ (require 'erc-stamp)
+ (require 'erc-sound)
+ (require 'erc-page)
+ (require 'erc-join)
+ (require 'erc-capab)
+ (require 'erc-pcomplete)
+ (should (eq (erc--find-group 'services 'nickserv) 'erc-services))
+ (should (eq (erc--find-group 'stamp 'timestamp) 'erc-stamp))
+ (should (eq (erc--find-group 'sound 'ctcp-sound) 'erc-sound))
+ (should (eq (erc--find-group 'page 'ctcp-page) 'erc-page))
+ (should (eq (erc--find-group 'autojoin) 'erc-autojoin))
+ (should (eq (erc--find-group 'pcomplete 'Completion) 'erc-pcomplete))
+ (should (eq (erc--find-group 'capab-identify) 'erc-capab))
+ ;; No group specified.
+ (should (eq (erc--find-group 'smiley nil) 'erc))
+ (should (eq (erc--find-group 'unmorse nil) 'erc)))
+
(ert-deftest erc--update-modules ()
(let (calls
erc-modules
erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+
+ ;; This `lbaz' module is unknown, so ERC looks for it via the
+ ;; symbol proerty `erc--feature' and, failing that, by
+ ;; `require'ing its "erc-" prefixed symbol.
+ (should-not (intern-soft "erc-lbaz-mode"))
+
(cl-letf (((symbol-function 'require)
- (lambda (s &rest _) (push s calls)))
+ (lambda (s &rest _)
+ (when (eq s 'erc--lbaz-feature)
+ (fset (intern "erc-lbaz-mode") ; local module
+ (lambda (n) (push (cons 'lbaz n) calls))))
+ (push s calls)))
;; Local modules
- ((symbol-function 'erc-fake-bar-mode)
- (lambda (n) (push (cons 'fake-bar n) calls)))
+ ((symbol-function 'erc-lbar-mode)
+ (lambda (n) (push (cons 'lbar n) calls)))
+ ((get 'lbaz 'erc--feature) 'erc--lbaz-feature)
;; Global modules
- ((symbol-function 'erc-fake-foo-mode)
- (lambda (n) (push (cons 'fake-foo n) calls)))
- ((get 'erc-fake-foo-mode 'standard-value) 'ignore)
+ ((symbol-function 'erc-gfoo-mode)
+ (lambda (n) (push (cons 'gfoo n) calls)))
+ ((get 'erc-gfoo-mode 'standard-value) 'ignore)
((symbol-function 'erc-autojoin-mode)
(lambda (n) (push (cons 'autojoin n) calls)))
((get 'erc-autojoin-mode 'standard-value) 'ignore)
@@ -1234,20 +1948,28 @@
(lambda (n) (push (cons 'completion n) calls)))
((get 'erc-completion-mode 'standard-value) 'ignore))
+ (ert-info ("Unknown module")
+ (setq erc-modules '(lfoo))
+ (should-error (erc--update-modules))
+ (should (equal (pop calls) 'erc-lfoo))
+ (should-not calls))
+
(ert-info ("Local modules")
- (setq erc-modules '(fake-foo fake-bar))
- (should (equal (erc--update-modules) '(erc-fake-bar-mode)))
- ;; Bar the feature is still required but the mode is not activated
- (should (equal (nreverse calls)
- '(erc-fake-foo (fake-foo . 1) erc-fake-bar)))
+ (setq erc-modules '(gfoo lbar lbaz))
+ ;; Don't expose the mode here
+ (should (equal (mapcar #'symbol-name (erc--update-modules))
+ '("erc-lbaz-mode" "erc-lbar-mode")))
+ ;; Lbaz required because unknown.
+ (should (equal (nreverse calls) '((gfoo . 1) erc--lbaz-feature)))
+ (fmakunbound (intern "erc-lbaz-mode"))
+ (unintern (intern "erc-lbaz-mode") obarray)
(setq calls nil))
- (ert-info ("Module name overrides")
- (setq erc-modules '(completion autojoin networks))
+ (ert-info ("Global modules") ; `pcomplete' resolved to `completion'
+ (setq erc-modules '(pcomplete autojoin networks))
(should-not (erc--update-modules)) ; no locals
- (should (equal (nreverse calls) '( erc-pcomplete (completion . 1)
- erc-join (autojoin . 1)
- erc-networks (networks . 1))))
+ (should (equal (nreverse calls)
+ '((completion . 1) (autojoin . 1) (networks . 1))))
(setq calls nil)))))
(ert-deftest erc--merge-local-modes ()
@@ -1276,21 +1998,27 @@
(ert-deftest define-erc-module--global ()
(let ((global-module '(define-erc-module mname malias
- "Some docstring"
+ "Some docstring."
((ignore a) (ignore b))
((ignore c) (ignore d)))))
- (should (equal (macroexpand global-module)
+ (should (equal (cl-letf (((symbol-function
+ 'erc--prepare-custom-module-type)
+ #'symbol-name))
+ (macroexpand global-module))
`(progn
(define-minor-mode erc-mname-mode
"Toggle ERC mname mode.
-With a prefix argument ARG, enable mname if ARG is positive,
-and disable it otherwise. If called from Lisp, enable the mode
-if ARG is omitted or nil.
-Some docstring"
+With a prefix argument ARG, enable mname if ARG is positive, and
+disable it otherwise. If called from Lisp, enable the mode if
+ARG is omitted or nil.
+
+Some docstring."
:global t
- :group 'erc-mname
+ :group (erc--find-group 'mname 'malias)
+ :get #'erc--neuter-custom-variable-state
+ :type "mname"
(if erc-mname-mode
(erc-mname-enable)
(erc-mname-disable)))
@@ -1298,14 +2026,22 @@ Some docstring"
(defun erc-mname-enable ()
"Enable ERC mname mode."
(interactive)
- (cl-pushnew 'mname erc-modules)
+ (unless (or erc--inside-mode-toggle-p
+ (memq 'mname erc-modules))
+ (let ((erc--inside-mode-toggle-p t))
+ (erc--favor-changed-reverted-modules-state
+ 'mname #'cons)))
(setq erc-mname-mode t)
(ignore a) (ignore b))
(defun erc-mname-disable ()
"Disable ERC mname mode."
(interactive)
- (setq erc-modules (delq 'mname erc-modules))
+ (unless (or erc--inside-mode-toggle-p
+ (not (memq 'mname erc-modules)))
+ (let ((erc--inside-mode-toggle-p t))
+ (erc--favor-changed-reverted-modules-state
+ 'mname #'delq)))
(setq erc-mname-mode nil)
(ignore c) (ignore d))
@@ -1319,7 +2055,7 @@ Some docstring"
(ert-deftest define-erc-module--local ()
(let* ((global-module '(define-erc-module mname nil ; no alias
- "Some docstring"
+ "Some docstring."
((ignore a) (ignore b))
((ignore c) (ignore d))
'local))
@@ -1331,19 +2067,21 @@ Some docstring"
`(progn
(define-minor-mode erc-mname-mode
"Toggle ERC mname mode.
-With a prefix argument ARG, enable mname if ARG is positive,
-and disable it otherwise. If called from Lisp, enable the mode
-if ARG is omitted or nil.
-Some docstring"
+With a prefix argument ARG, enable mname if ARG is positive, and
+disable it otherwise. If called from Lisp, enable the mode if
+ARG is omitted or nil.
+
+Some docstring."
:global nil
- :group 'erc-mname
+ :group (erc--find-group 'mname nil)
(if erc-mname-mode
(erc-mname-enable)
(erc-mname-disable)))
(defun erc-mname-enable (&optional ,arg-en)
"Enable ERC mname mode.
-When called interactively, do so in all buffers for the current connection."
+When called interactively, do so in all buffers for the current
+connection."
(interactive "p")
(when (derived-mode-p 'erc-mode)
(if ,arg-en
@@ -1355,7 +2093,8 @@ When called interactively, do so in all buffers for the
current connection."
(defun erc-mname-disable (&optional ,arg-dis)
"Disable ERC mname mode.
-When called interactively, do so in all buffers for the current connection."
+When called interactively, do so in all buffers for the current
+connection."
(interactive "p")
(when (derived-mode-p 'erc-mode)
(if ,arg-dis
@@ -1370,4 +2109,65 @@ When called interactively, do so in all buffers for the
current 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/assoc/bouncer-history/foonet.eld
b/test/lisp/erc/resources/base/assoc/bouncer-history/foonet.eld
index 58df79e19fa..f34ae02f4e4 100644
--- a/test/lisp/erc/resources/base/assoc/bouncer-history/foonet.eld
+++ b/test/lisp/erc/resources/base/assoc/bouncer-history/foonet.eld
@@ -27,6 +27,7 @@
(0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:02] alice: Here come the
lovers, full of joy and mirth.")
(0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:07] bob: According to
the fool's bolt, sir, and such dulcet diseases.")
(0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:10] alice: And hang
himself. I pray you, do my greeting.")
+ (0 ":someone!~u@abcdefg.irc PRIVMSG #chan :[07:04:10] hi everyone.")
(0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:18] bob: And you sat
smiling at his cruel prey.")
(0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:21] alice: Or never after
look me in the face.")
(0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:25] bob: If that may
be, than all is well. Come, sit down, every mother's son, and rehearse your
parts. Pyramus, you begin: when you have spoken your speech, enter into that
brake; and so every one according to his cue.")
diff --git a/test/lisp/erc/resources/base/commands/motd.eld
b/test/lisp/erc/resources/base/commands/motd.eld
new file mode 100644
index 00000000000..6d10ee122e2
--- /dev/null
+++ b/test/lisp/erc/resources/base/commands/motd.eld
@@ -0,0 +1,48 @@
+;; -*- 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 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"))
+
+((motd-1 10 "MOTD")
+ (0.08 ":irc.foonet.org 375 tester :- irc.foonet.org Message of the day - ")
+ (0.02 ":irc.foonet.org 372 tester :- This is the default Ergo MOTD.")
+ (0.01 ":irc.foonet.org 372 tester :- ")
+ (0.00 ":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"))
+
+((motd-2 10 "MOTD irc1.foonet.org")
+ (0.08 ":irc1.foonet.org 375 tester :- irc1.foonet.org Message of the day - ")
+ (0.02 ":irc1.foonet.org 372 tester :- This is the default Ergo MOTD.")
+ (0.01 ":irc1.foonet.org 372 tester :- ")
+ (0.00 ":irc1.foonet.org 372 tester :- For more information on using these,
see MOTDFORMATTING.md")
+ (0.00 ":irc1.foonet.org 376 tester :End of MOTD command"))
+
+((motd-3 10 "MOTD fake.foonet.org")
+ (0.00 ":irc.foonet.org 402 tester fake.foonet.org :No such server"))
+
+((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/reconnect/just-eof.eld
b/test/lisp/erc/resources/base/reconnect/just-eof.eld
new file mode 100644
index 00000000000..c80a39b3170
--- /dev/null
+++ b/test/lisp/erc/resources/base/reconnect/just-eof.eld
@@ -0,0 +1,3 @@
+;; -*- mode: lisp-data; -*-
+((eof 5 EOF))
+((drop 0 DROP))
diff --git a/test/lisp/erc/resources/base/reconnect/just-ping.eld
b/test/lisp/erc/resources/base/reconnect/just-ping.eld
new file mode 100644
index 00000000000..d57888b42d3
--- /dev/null
+++ b/test/lisp/erc/resources/base/reconnect/just-ping.eld
@@ -0,0 +1,4 @@
+;; -*- mode: lisp-data; -*-
+((ping 20 "PING"))
+
+((eof 10 EOF))
diff --git a/test/lisp/erc/resources/base/reconnect/ping-pong.eld
b/test/lisp/erc/resources/base/reconnect/ping-pong.eld
new file mode 100644
index 00000000000..b3d36cf6cec
--- /dev/null
+++ b/test/lisp/erc/resources/base/reconnect/ping-pong.eld
@@ -0,0 +1,6 @@
+;; -*- mode: lisp-data; -*-
+((ping 10 "PING ")
+ (0 "PONG fake"))
+
+((eof 10 EOF))
+((drop 0 DROP))
diff --git a/test/lisp/erc/resources/base/reconnect/unexpected-disconnect.eld
b/test/lisp/erc/resources/base/reconnect/unexpected-disconnect.eld
new file mode 100644
index 00000000000..386d0f4b085
--- /dev/null
+++ b/test/lisp/erc/resources/base/reconnect/unexpected-disconnect.eld
@@ -0,0 +1,24 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
+ (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
+ (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version
oragono-2.6.0-7481bf0385b95b16")
+ (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021
05:06:18 UTC")
+ (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16
BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii
CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=#
ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this
server")
+ (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100
NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+
TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100
TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
+ (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this
server")
+ (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1
server(s)")
+ (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
+ (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
+ (0 ":irc.foonet.org 254 tester 1 :channels formed")
+ (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
+ (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
+ (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
+ (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
+
+((mode-user 10 "MODE tester +i")
+ (0 ":irc.foonet.org 221 tester +i")
+ (0 ":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."))
+
+((drop 0 DROP))
diff --git a/test/lisp/erc/resources/base/renick/regain/normal-again.eld
b/test/lisp/erc/resources/base/renick/regain/normal-again.eld
new file mode 100644
index 00000000000..c0529052c70
--- /dev/null
+++ b/test/lisp/erc/resources/base/renick/regain/normal-again.eld
@@ -0,0 +1,56 @@
+;; -*- mode: lisp-data; -*-
+((cap 10 "CAP REQ :sasl"))
+((nick 10 "NICK tester"))
+((user 10 "USER tester 0 * :tester"))
+
+((authenticate 10 "AUTHENTICATE PLAIN")
+ (0.04 ":tantalum.libera.chat NOTICE * :*** Checking Ident")
+ (0.01 ":tantalum.libera.chat NOTICE * :*** Looking up your hostname...")
+ (0.01 ":tantalum.libera.chat NOTICE * :*** Couldn't look up your hostname")
+ (0.06 ":tantalum.libera.chat NOTICE * :*** No Ident response")
+ (0.02 ":tantalum.libera.chat CAP * ACK :sasl")
+ (0.03 ":tantalum.libera.chat 433 * tester :Nickname is already in use."))
+
+((nick 10 "NICK tester`")
+ (0.03 "AUTHENTICATE +"))
+
+((authenticate 10 "AUTHENTICATE AHRlc3RlcgBjaGFuZ2VtZQ==")
+ (0.06 ":tantalum.libera.chat 900 tester` tester`!tester@127.0.0.1 tester :You
are now logged in as tester")
+ (0.02 ":tantalum.libera.chat 903 tester` :SASL authentication successful"))
+
+((cap 10 "CAP END")
+ (0.02 ":tantalum.libera.chat 001 tester` :Welcome to the Libera.Chat Internet
Relay Chat Network tester`")
+ (0.02 ":tantalum.libera.chat 002 tester` :Your host is
tantalum.libera.chat[93.158.237.2/6697], running version solanum-1.0-dev")
+ (0.02 ":tantalum.libera.chat 003 tester` :This server was created Mon Feb 13
2023 at 12:05:04 UTC")
+ (0.01 ":tantalum.libera.chat 004 tester` tantalum.libera.chat solanum-1.0-dev
DGMQRSZaghilopsuwz CFILMPQRSTbcefgijklmnopqrstuvz bkloveqjfI")
+ (0.01 ":tantalum.libera.chat 005 tester` WHOX MONITOR=100 SAFELIST
ELIST=CMNTU ETRACE FNC CALLERID=g KNOCK CHANTYPES=# EXCEPTS INVEX
CHANMODES=eIbq,k,flj,CFLMPQRSTcgimnprstuz :are supported by this server")
+ (0.01 ":tantalum.libera.chat 005 tester` CHANLIMIT=#:250 PREFIX=(ov)@+
MAXLIST=bqeI:100 MODES=4 NETWORK=Libera.Chat STATUSMSG=@+ CASEMAPPING=rfc1459
NICKLEN=16 MAXNICKLEN=16 CHANNELLEN=50 TOPICLEN=390 DEAF=D :are supported by
this server")
+ (0.03 ":tantalum.libera.chat 005 tester`
TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,MONITOR:
EXTBAN=$,ajrxz :are supported by this server")
+ (0.01 ":tantalum.libera.chat 251 tester` :There are 70 users and 42977
invisible on 28 servers")
+ (0.00 ":tantalum.libera.chat 252 tester` 38 :IRC Operators online")
+ (0.00 ":tantalum.libera.chat 253 tester` 87 :unknown connection(s)")
+ (0.00 ":tantalum.libera.chat 254 tester` 22908 :channels formed")
+ (0.00 ":tantalum.libera.chat 255 tester` :I have 2507 clients and 1 servers")
+ (0.00 ":tantalum.libera.chat 265 tester` 2507 3232 :Current local users 2507,
max 3232")
+ (0.00 ":tantalum.libera.chat 266 tester` 43047 51777 :Current global users
43047, max 51777")
+ (0.00 ":tantalum.libera.chat 250 tester` :Highest connection count: 3233
(3232 clients) (284887 connections received)")
+ (0.03 ":tantalum.libera.chat 375 tester` :- tantalum.libera.chat Message of
the Day - ")
+ (0.00 ":tantalum.libera.chat 372 tester` :- This server provided by
Hyperfilter (https://hyperfilter.com)")
+ (0.00 ":tantalum.libera.chat 372 tester` :- Email:
support@libera.chat")
+ (0.02 ":tantalum.libera.chat 376 tester` :End of /MOTD command."))
+
+((mode 10 "MODE tester` +i")
+ (0.01 ":tester` MODE tester` :+Ziw")
+ (0.02 ":SaslServ!SaslServ@services.libera.chat NOTICE tester` :Last login
from: \2~tester@127.0.0.1\2 on Apr 07 01:36:25 2023 +0000."))
+
+((nick 10 "NICK tester")
+ (0.02 ":tester`!~tester@127.0.0.1 NICK :tester"))
+
+((join 10 "JOIN #test")
+ (0.02 ":tester!~tester@127.0.0.1 JOIN #test")
+ (0.02 ":tantalum.libera.chat 353 tester = #test :tester zbyqbepbqre7
pusevgfpu Thrfg2187 zngbeb qnexNssvavgl wrebzr- rqpentt Ilehf grfg2 AvtugZbaxrl
pevfgvvbna xrivap_ fnvybePng shohxv gxan arrqyr avpx16 NeanhqW_kzcc jvyyr
wrnaogeq Wnarg cnefavc0 Xbentt RcvpArb flfqrs wfgbxre hafcrag__ Lbevpx_")
+ (0.02 ":tantalum.libera.chat 366 tester #test :End of /NAMES list."))
+
+((mode 10 "MODE #test")
+ (0.02 ":tantalum.libera.chat 324 tester #test +nt")
+ (0.02 ":tantalum.libera.chat 329 tester #test 1621432263"))
diff --git a/test/lisp/erc/resources/base/renick/regain/normal.eld
b/test/lisp/erc/resources/base/renick/regain/normal.eld
new file mode 100644
index 00000000000..9f4df70e580
--- /dev/null
+++ b/test/lisp/erc/resources/base/renick/regain/normal.eld
@@ -0,0 +1,53 @@
+;; -*- mode: lisp-data; -*-
+((cap 10 "CAP REQ :sasl"))
+((nick 10 "NICK tester"))
+((user 10 "USER tester 0 * :tester"))
+
+((authenticate 10 "AUTHENTICATE PLAIN")
+ (0.02 ":cadmium.libera.chat NOTICE * :*** Checking Ident")
+ (0.01 ":cadmium.libera.chat NOTICE * :*** Looking up your hostname...")
+ (0.01 ":cadmium.libera.chat NOTICE * :*** Couldn't look up your hostname")
+ (0.06 ":cadmium.libera.chat NOTICE * :*** No Ident response")
+ (0.09 ":cadmium.libera.chat CAP * ACK :sasl")
+ (0.01 "AUTHENTICATE +"))
+
+((authenticate 10 "AUTHENTICATE AHRlc3RlcgBjaGFuZ2VtZQ==")
+ (0.03 ":cadmium.libera.chat 900 tester tester!tester@127.0.0.1 tester :You
are now logged in as tester")
+ (0.01 ":cadmium.libera.chat 903 tester :SASL authentication successful"))
+
+((cap 10 "CAP END")
+ (0.03 ":cadmium.libera.chat 001 tester :Welcome to the Libera.Chat Internet
Relay Chat Network tester")
+ (0.02 ":cadmium.libera.chat 002 tester :Your host is
cadmium.libera.chat[103.196.37.95/6697], running version solanum-1.0-dev")
+ (0.01 ":cadmium.libera.chat 003 tester :This server was created Wed Jan 25
2023 at 10:22:45 UTC")
+ (0.01 ":cadmium.libera.chat 004 tester cadmium.libera.chat solanum-1.0-dev
DGMQRSZaghilopsuwz CFILMPQRSTbcefgijklmnopqrstuvz bkloveqjfI")
+ (0.00 ":cadmium.libera.chat 005 tester CALLERID=g WHOX ETRACE FNC SAFELIST
ELIST=CMNTU KNOCK MONITOR=100 CHANTYPES=# EXCEPTS INVEX
CHANMODES=eIbq,k,flj,CFLMPQRSTcgimnprstuz :are supported by this server")
+ (0.01 ":cadmium.libera.chat 005 tester CHANLIMIT=#:250 PREFIX=(ov)@+
MAXLIST=bqeI:100 MODES=4 NETWORK=Libera.Chat STATUSMSG=@+ CASEMAPPING=rfc1459
NICKLEN=16 MAXNICKLEN=16 CHANNELLEN=50 TOPICLEN=390 DEAF=D :are supported by
this server")
+ (0.01 ":cadmium.libera.chat 005 tester
TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,MONITOR:
EXTBAN=$,ajrxz :are supported by this server")
+ (0.01 ":cadmium.libera.chat 251 tester :There are 70 users and 42996
invisible on 28 servers")
+ (0.02 ":cadmium.libera.chat 252 tester 38 :IRC Operators online")
+ (0.01 ":cadmium.libera.chat 253 tester 57 :unknown connection(s)")
+ (0.01 ":cadmium.libera.chat 254 tester 22912 :channels formed")
+ (0.01 ":cadmium.libera.chat 255 tester :I have 2499 clients and 1 servers")
+ (0.01 ":cadmium.libera.chat 265 tester 2499 4187 :Current local users 2499,
max 4187")
+ (0.01 ":cadmium.libera.chat 266 tester 43066 51827 :Current global users
43066, max 51827")
+ (0.01 ":cadmium.libera.chat 250 tester :Highest connection count: 4188 (4187
clients) (319420 connections received)")
+ (0.01 ":cadmium.libera.chat 375 tester :- cadmium.libera.chat Message of the
Day - ")
+ (0.01 ":cadmium.libera.chat 372 tester :- This server kindly provided by Mach
Dilemma (www.m-d.net)")
+ (0.01 ":cadmium.libera.chat 372 tester :- Welcome to Libera Chat, the IRC
network for")
+ (0.00 ":cadmium.libera.chat 372 tester :- Email:
support@libera.chat")
+ (0.00 ":cadmium.libera.chat 376 tester :End of /MOTD command.")
+ (0.00 ":tester MODE tester :+Ziw")
+ (0.02 ":SaslServ!SaslServ@services.libera.chat NOTICE tester :Last login
from: \2~tester@127.0.0.1\2 on Apr 07 01:02:11 2023 +0000."))
+
+((mode 10 "MODE tester +i"))
+
+((join 10 "JOIN #test")
+ (0.09 ":tester!~tester@127.0.0.1 JOIN #test"))
+
+((mode 10 "MODE #test")
+ (0.03 ":cadmium.libera.chat 353 tester = #test :tester zbyqbepbqre7 pusevgfpu
Thrfg2187 zngbeb qnexNssvavgl wrebzr- rqpentt Ilehf grfg2 AvtugZbaxrl
pevfgvvbna xrivap_ fnvybePng shohxv gxan arrqyr avpx16 NeanhqW_kzcc Lbevpx_
hafcrag__ wfgbxre flfqrs RcvpArb Xbentt jvyyr cnefavc0 Wnarg wrnaogeq")
+ (0.02 ":cadmium.libera.chat 366 tester #test :End of /NAMES list.")
+ (0.00 ":cadmium.libera.chat 324 tester #test +nt")
+ (0.01 ":cadmium.libera.chat 329 tester #test 1621432263"))
+
+((drop 0 DROP))
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el
b/test/lisp/erc/resources/erc-scenarios-common.el
index 0d9a79ae9ce..f259c88594b 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -121,6 +121,7 @@
(erc-modules (copy-sequence erc-modules))
(inhibit-interaction t)
(auth-source-do-cache nil)
+ (timer-list (copy-sequence timer-list))
(erc-auth-source-parameters-join-function nil)
(erc-autojoin-channels-alist nil)
(erc-server-auto-reconnect nil)
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
new file mode 100644
index 00000000000..db3136a9d9e
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
@@ -0,0 +1 @@
+#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1
2023]\n<bob> zero.[07:00]\n<alic [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
new file mode 100644
index 00000000000..fcb9e59b757
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
@@ -0,0 +1 @@
+#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1
2023]\n<bob> zero.[07:00]\n<alic [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
new file mode 100644
index 00000000000..67ebad542fb
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
@@ -0,0 +1 @@
+#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 21
(erc-timestamp 0 line-prefix (space :wi [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
new file mode 100644
index 00000000000..0bf8001475d
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
@@ -0,0 +1 @@
+#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 21
(erc-timestamp 0 line-prefix (space :wi [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
new file mode 100644
index 00000000000..7d231d19cef
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
@@ -0,0 +1 @@
+#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 21
(erc-timestamp 0 line-prefix (space :wi [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
new file mode 100644
index 00000000000..67ebad542fb
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
@@ -0,0 +1 @@
+#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 21
(erc-timestamp 0 line-prefix (space :wi [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/sasl/plain-overlong-aligned.eld
b/test/lisp/erc/resources/sasl/plain-overlong-aligned.eld
new file mode 100644
index 00000000000..6ed8981be0f
--- /dev/null
+++ b/test/lisp/erc/resources/sasl/plain-overlong-aligned.eld
@@ -0,0 +1,39 @@
+;; -*- mode: lisp-data; -*-
+((cap-req 10 "CAP REQ :sasl"))
+((nick 10 "NICK emersion"))
+((user 10 "USER emersion 0 * :emersion")
+ (0.0 ":irc.example.org NOTICE * :*** Looking up your hostname...")
+ (0.0 ":irc.example.org NOTICE * :*** Found your hostname")
+ (0.0 ":irc.example.org CAP * ACK :sasl"))
+
+((authenticate-plain 10 "AUTHENTICATE PLAIN")
+ (0.0 ":irc.example.org AUTHENTICATE +"))
+((authenticate-gimme-1 10 "AUTHENTICATE
AGVtZXJzaW9uAEVzdCB1dCBiZWF0YWUgb21uaXMgaXBzYW0uIFF1aXMgZnVnaWF0IGRlbGVuaXRpIHRvdGFtIHF1aS4gSXBzdW0gcXVhbSBhIGRvbG9ydW0gdGVtcG9yYSB2ZWxpdCBsYWJvcnVtIG9kaXQuIEV0IHNhZXBlIHZvbHVwdGF0ZSBzZWQgY3VtcXVlIHZlbC4gVm9sdXB0YXMgc2ludCBhYiBwYXJpYXR1ciBsaWJlcm8gdmVyaXRhdGlzIGNvcnJ1cHRpLiBWZXJvIGl1cmUgb21uaXMgdWxsYW0uIFZlcm8gYmVhdGFlIGRvbG9yZXMgZmFjZXJlIGZ1Z2lhdCBpcHNhbS4gRWEgZXN0IHBhcmlhdHVyIG1pbmltYSBub2Jpcw=="))
+((authenticate-gimme-2 10 "AUTHENTICATE +")
+ (0.0 ":irc.example.org 900 * * emersion :You are now logged in as emersion")
+ (0.0 ":irc.example.org 903 * :Authentication successful"))
+
+((cap-end 10 "CAP END")
+ (0.0 ":irc.example.org 001 emersion :Welcome to the ExampleOrg IRC Network
emersion")
+ (0.0 ":irc.example.org 002 emersion :Your host is irc.example.org, running
version oragono-2.6.1")
+ (0.0 ":irc.example.org 003 emersion :This server was created Sat, 17 Jul 2021
09:06:42 UTC")
+ (0.0 ":irc.example.org 004 emersion irc.example.org oragono-2.6.1 BERTZios
CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0.0 ":irc.example.org 005 emersion AWAYLEN=200 BOT=B CASEMAPPING=ascii
CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=#
ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this
server")
+ (0.0 ":irc.example.org 005 emersion MAXLIST=beI:60 MAXTARGETS=4 MODES
MONITOR=100 NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+
TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100
TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY :are supported by this server")
+ (0.0 ":irc.example.org 005 emersion draft/CHATHISTORY=100 :are supported by
this server")
+ (0.0 ":irc.example.org 251 emersion :There are 1 users and 0 invisible on 1
server(s)")
+ (0.0 ":irc.example.org 252 emersion 0 :IRC Operators online")
+ (0.0 ":irc.example.org 253 emersion 0 :unregistered connections")
+ (0.0 ":irc.example.org 254 emersion 0 :channels formed")
+ (0.0 ":irc.example.org 255 emersion :I have 1 clients and 0 servers")
+ (0.0 ":irc.example.org 265 emersion 1 1 :Current local users 1, max 1")
+ (0.0 ":irc.example.org 266 emersion 1 1 :Current global users 1, max 1")
+ (0.0 ":irc.example.org 422 emersion :MOTD File is missing"))
+
+((mode-user 10 "MODE emersion +i")
+ (0.0 ":irc.example.org 221 emersion +Zi")
+ (0.0 ":irc.example.org NOTICE emersion :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."))
+
+((quit 5 "QUIT :\2ERC\2")
+ (0 ":emersion!~u@yuvqisyu7m7qs.irc QUIT :Quit"))
+((drop 1 DROP))
diff --git a/test/lisp/erc/resources/sasl/plain-overlong-split.eld
b/test/lisp/erc/resources/sasl/plain-overlong-split.eld
new file mode 100644
index 00000000000..3e6870790f3
--- /dev/null
+++ b/test/lisp/erc/resources/sasl/plain-overlong-split.eld
@@ -0,0 +1,39 @@
+;; -*- mode: lisp-data; -*-
+((cap-req 10 "CAP REQ :sasl"))
+((nick 10 "NICK emersion"))
+((user 10 "USER emersion 0 * :emersion")
+ (0.0 ":irc.example.org NOTICE * :*** Looking up your hostname...")
+ (0.0 ":irc.example.org NOTICE * :*** Found your hostname")
+ (0.0 ":irc.example.org CAP * ACK :sasl"))
+
+((authenticate-plain 10 "AUTHENTICATE PLAIN")
+ (0.0 ":irc.example.org AUTHENTICATE +"))
+((authenticate-gimme-1 10 "AUTHENTICATE
AGVtZXJzaW9uAEVzdCB1dCBiZWF0YWUgb21uaXMgaXBzYW0uIFF1aXMgZnVnaWF0IGRlbGVuaXRpIHRvdGFtIHF1aS4gSXBzdW0gcXVhbSBhIGRvbG9ydW0gdGVtcG9yYSB2ZWxpdCBsYWJvcnVtIG9kaXQuIEV0IHNhZXBlIHZvbHVwdGF0ZSBzZWQgY3VtcXVlIHZlbC4gVm9sdXB0YXMgc2ludCBhYiBwYXJpYXR1ciBsaWJlcm8gdmVyaXRhdGlzIGNvcnJ1cHRpLiBWZXJvIGl1cmUgb21uaXMgdWxsYW0uIFZlcm8gYmVhdGFlIGRvbG9yZXMgZmFjZXJlIGZ1Z2lhdCBpcHNhbS4gRWEgZXN0IHBhcmlhdHVyIG1pbmltYSBub2JpcyBz"))
+((authenticate-gimme-2 10 "AUTHENTICATE
dW50IGF1dCB1dC4gRG9sb3JlcyB1dCBsYXVkYW50aXVtIG1haW9yZXMgdGVtcG9yaWJ1cyB2b2x1cHRhdGVzLiBSZWljaWVuZGlzIGltcGVkaXQgb21uaXMgZXQgdW5kZSBkZWxlY3R1cyBxdWFzIGFiLiBRdWFlIGVsaWdlbmRpIG5lY2Vzc2l0YXRpYnVzIGRvbG9yaWJ1cyBtb2xlc3RpYXMgdGVtcG9yYSBtYWduYW0gYXNzdW1lbmRhLg==")
+ (0.0 ":irc.example.org 900 * * emersion :You are now logged in as emersion")
+ (0.0 ":irc.example.org 903 * :Authentication successful"))
+
+((cap-end 10 "CAP END")
+ (0.0 ":irc.example.org 001 emersion :Welcome to the ExampleOrg IRC Network
emersion")
+ (0.0 ":irc.example.org 002 emersion :Your host is irc.example.org, running
version oragono-2.6.1")
+ (0.0 ":irc.example.org 003 emersion :This server was created Sat, 17 Jul 2021
09:06:42 UTC")
+ (0.0 ":irc.example.org 004 emersion irc.example.org oragono-2.6.1 BERTZios
CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0.0 ":irc.example.org 005 emersion AWAYLEN=200 BOT=B CASEMAPPING=ascii
CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=#
ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this
server")
+ (0.0 ":irc.example.org 005 emersion MAXLIST=beI:60 MAXTARGETS=4 MODES
MONITOR=100 NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+
TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100
TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY :are supported by this server")
+ (0.0 ":irc.example.org 005 emersion draft/CHATHISTORY=100 :are supported by
this server")
+ (0.0 ":irc.example.org 251 emersion :There are 1 users and 0 invisible on 1
server(s)")
+ (0.0 ":irc.example.org 252 emersion 0 :IRC Operators online")
+ (0.0 ":irc.example.org 253 emersion 0 :unregistered connections")
+ (0.0 ":irc.example.org 254 emersion 0 :channels formed")
+ (0.0 ":irc.example.org 255 emersion :I have 1 clients and 0 servers")
+ (0.0 ":irc.example.org 265 emersion 1 1 :Current local users 1, max 1")
+ (0.0 ":irc.example.org 266 emersion 1 1 :Current global users 1, max 1")
+ (0.0 ":irc.example.org 422 emersion :MOTD File is missing"))
+
+((mode-user 10 "MODE emersion +i")
+ (0.0 ":irc.example.org 221 emersion +Zi")
+ (0.0 ":irc.example.org NOTICE emersion :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."))
+
+((quit 5 "QUIT :\2ERC\2")
+ (0 ":emersion!~u@yuvqisyu7m7qs.irc QUIT :Quit"))
+((drop 1 DROP))