Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Merge remote-tracking branch 'origin/master' into feature/android

Browse source
This commit is contained in:
Po Lu 2023-07-14 15:35:21 +08:00
commit 4f95ab3837
39 changed files with 3956 additions and 572 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
doc/lispref/numbers.texi
View file

@ -279,12 +279,6 @@ whether they are numerically equal. For example, when @var{x} and
conversely, @code{(equal 0.0 -0.0)} returns @code{nil} whereas
@code{(= 0.0 -0.0)} returns @code{t}.
Infinities and NaNs are not available on legacy systems that lack
IEEE floating-point arithmetic. On a circa 1980 VAX, for example, the
Lisp reader approximates an infinity with the nearest finite value,
and a NaN with some other non-numeric Lisp object that provokes an
error if used numerically.
Here are read syntaxes for these special floating-point values:
@table @asis
@ -294,6 +288,12 @@ Here are read syntaxes for these special floating-point values:
@samp{0.0e+NaN} and @samp{-0.0e+NaN}
@end table
Infinities and NaNs are not available on legacy systems that lack
IEEE floating-point arithmetic. On a circa 1980 VAX, for example,
Lisp reads @samp{1.0e+INF} as a large but finite floating-point number,
and @samp{0.0e+NaN} as some other non-numeric Lisp object that provokes an
error if used numerically.
The following functions are specialized for handling floating-point
numbers:

675
doc/misc/erc.texi
View file

@ -144,11 +144,11 @@ the @samp{#emacs} channels where you can chat with other Emacs users,
and if you're having trouble with ERC, you can join the @samp{#erc}
channel and ask for help there.
If you want to place ERC settings in their own file, you can place them
in @file{~/.emacs.d/.ercrc.el}, creating it if necessary.
If you would rather use the Customize interface to change how ERC
works, do @kbd{M-x customize-group @key{RET} erc @key{RET}}. In
At some point in your ERC journey, you'll inevitably want to change
how the client looks and behaves. As with other Emacs applications,
the typical place to store your settings is your @file{init.el}. If
you would rather use the Customize interface, a good place to start is
by running @kbd{M-x customize-group @key{RET} erc @key{RET}}. In
particular, ERC comes with lots of modules that may be enabled or
disabled; to select which ones you want, do @kbd{M-x
customize-variable @key{RET} erc-modules @key{RET}}.
@ -161,69 +161,90 @@ customize-variable @key{RET} erc-modules @key{RET}}.
@node Sample Session
@section Sample Session
This is an example ERC session which shows how to connect to the
@samp{#emacs} channel on Libera.Chat. Another IRC channel on
Libera.Chat that may be of interest is @samp{#erc}, which is a channel
where ERC users and developers hang out. These channels used to live
on the Freenode IRC network until June 2021, when they---along with
the official IRC channels of the GNU Project, the Free Software
Foundation, and many other free software communities---relocated to
the Libera.Chat network in the aftermath of changes in governance and
policies of Freenode in May and June 2021. GNU and FSF's
announcements about this are at
@uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00005.html},
@uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00007.html},
and
@uref{https://lists.gnu.org/archive/html/info-gnu-emacs/2021-06/msg00000.html}.
This example ERC session describes how to connect to the @samp{#emacs}
channel on Libera.Chat. Also worth checking out is Libera's own
introductory guide to IRC, @uref{https://libera.chat/guides/basics},
which presents a more comprehensive overview without instructions
specific to ERC.
@itemize @bullet
@item Connect to Libera.Chat
Run @kbd{M-x erc}. Use ``irc.libera.chat'' as the IRC server, ``6667''
as the port, and choose a nickname.
Run @kbd{M-x erc @key{RET}}. Use @samp{irc.libera.chat} for the
server and @samp{6667} for the port. Choose a nickname, and hit
@key{y} when asked if you'd prefer to connect over @acronym{TLS}.
@item Get used to the interface
Switch to the ``irc.libera.chat:6667'' buffer, if you're not already
there. You will see first some messages about checking for ident, and
then a bunch of other messages that describe the current IRC server.
Switch to the @file{Libera.Chat} buffer if you're not already there.
ERC calls this a @dfn{server buffer}, and it must exist for the
duration of the session. You will likely see some messages about
``ident'', authentication, and the like, followed by information
describing the current server and the network.
@item Join the #emacs channel
In that buffer, type ``/join @key{SPC} #emacs'' and hit @kbd{RET}. Depending
on how you've set up ERC, either a new buffer for ``#emacs'' will be
displayed, or a new buffer called ``#emacs'' will be created in the
background. If the latter, switch to the ``#emacs'' buffer. You will
see the channel topic and a list of the people who are currently on the
channel.
In the server buffer, type @kbd{/join #emacs @key{RET}} at the prompt.
ERC will create a new buffer called @file{#emacs}. If you've already
configured ERC, you may need to switch to it manually. Once there,
you will see the channel's ``topic'' in the buffer's header line
(@pxref{Header Lines,,,elisp,}) and a list of people currently in the
channel. If you can't see the full topic, mouse over it or type
@kbd{/topic @key{RET}} at the prompt.
@item Register your nickname with Libera.Chat
If you would like to be able to talk with people privately on the
Libera.Chat network, you will have to ``register'' your nickname.
To do so, switch to the ``irc.libera.chat:6667'' buffer and type
``/msg NickServ register <password>'', replacing ``<password>'' with
your desired password. It should tell you that the operation was
successful.
In order to access essential network features, like speaking in
certain channels and participating in private conversations, you'll
likely have to ``register'' your nickname. To do so, switch to the
@file{Libera.Chat} buffer and type @kbd{/msg NickServ register
@samp{<password>} @samp{<email>} @key{RET}}, replacing
@samp{<password>} and @samp{<email>} with your desired account
password and contact email (both sans quotes). The server should tell
you that the operation was successful. See the official Libera.Chat
docs if you encounter problems.
In addition to creating an account, this process also
``authenticates'' you to the network's ``account services'' system for
the duration of the session. In other words, you're now logged in.
However, when you connect in the future, you'll need to authenticate
again by providing the same credentials somehow. When you're finished
with this walk through, see ``Next Steps'', below, to learn some ways
to do that.
@item Talk to people in the channel
If you switch back to the ``#emacs'' buffer, you can type a message, and
everyone on the channel will see it.
Switch back to the @file{#emacs} buffer and type a message at the
prompt, hitting @kbd{RET} once satisfied. Everyone in the channel
will now see your message.
@item Open a query buffer to talk to someone
If you want to talk with someone in private (this should usually not be
done for technical help, only for personal questions), type ``/query
<nick>'', replacing ``<nick>'' with the nickname of the person you would
like to talk to. Depending on how ERC is set up, you will either see a
new buffer with the name of the person, or such a buffer will be created
in the background and you will have to switch to it. Begin typing
messages, and you will be able to have a conversation.
If you want to talk with someone in private, type @kbd{/query
@samp{<nick>} @key{RET}}, replacing @samp{<nick>} with the their
nickname. As before, with the server buffer, if this new @dfn{query
buffer} doesn't appear in the current window, you may have to switch
to it. Regardless, its name should match @samp{<nick>}. Once there,
type something at the prompt and hit @kbd{RET}, and the other party
will see it.
Note that if the other person is not registered, you will not be able to
talk with them.
Keep in mind that if either party isn't authenticated, you may not be
able to converse at all. Also, depending on the network, certain
social conventions may apply to the practice of direct messaging. As
a general rule, queries should usually be reserved for personal
matters rather than technical help, which can often benefit (and
benefit @emph{from}) a larger audience.
@item Next steps
Try joining another channel, such as @samp{#erc}, where ERC users and
developers hang out (@pxref{Official IRC channels} for more on the
history of @samp{#emacs}). For ideas on various options to customize,
@pxref{Sample Configuration}. To learn how ERC can authenticate you
to the network automatically whenever you connect, @pxref{SASL}. As
always, if you encounter problems, @pxref{Getting Help and Reporting
Bugs}.
@end itemize
@ -414,9 +435,10 @@ Set away status automatically
@item autojoin
Join channels automatically
@cindex modules, bbdb
@item bbdb
Integrate with the Big Brother Database
@cindex modules, bufbar
@item bufbar
List buffers belonging to a connection in a side window; part of
Custom group @code{erc-status-sidebar}
@cindex modules, button
@item button
@ -443,6 +465,10 @@ Launch an identd server on port 8113
@item irccontrols
Highlight or remove IRC control characters
@cindex modules, keep-place
@item keep-place
Remember your position in buffers
@cindex modules, log
@item log
Save buffers in logs
@ -459,6 +485,15 @@ Display a menu in ERC buffers
@item netsplit
Detect netsplits
@cindex modules, nicks
@item nicks
Automatically colorize nicks
@cindex modules, nickbar
@item nickbar
List participating nicks for the current target buffer in a side
window; part of Custom group @code{erc-speedbar}
@cindex modules, noncommands
@item noncommands
Don't display non-IRC commands after evaluation
@ -530,6 +565,33 @@ Translate morse code in messages
@end table
@anchor{Auxiliary Modules}
@subheading Auxiliary Modules
@cindex auxiliary modules
For various reasons, the following modules aren't currently listed in
the Custom interface for @code{erc-modules}, but feel free to add them
explicitly. They may be managed by another module or considered more
useful when toggled interactively or just deemed experimental.
@table @code
@cindex modules, fill-wrap
@item fill-wrap
Wrap long lines using @code{visual-line-mode}
@cindex modules, keep-place-indicator
@item keep-place-indicator
Remember your place in buffers with a visible reminder; activated
interactively or via something like @code{erc-join-hook}
@cindex modules, services-regain
@item services-regain
Automatically ask NickServ to reclaim your nick when reconnecting;
experimental as of ERC 5.6
@end table
@anchor{Required Modules}
@subheading Required Modules
@cindex required modules
@ -613,6 +675,7 @@ Integrations
* URL:: Opening IRC URLs in ERC.
* SOCKS:: Connecting to IRC with a SOCKS proxy.
* auth-source:: Retrieving auth-source entries with ERC.
* display-buffer:: Controlling how ERC displays buffers.
@end detailmenu
@end menu
@ -1150,82 +1213,284 @@ case, you'll probably want to temporarily disable
@section Sample Configuration
@cindex configuration, sample
Here is an example of configuration settings for ERC@. This can go into
your Emacs configuration file. Everything after the @code{(require
'erc)} command can optionally go into @file{~/.emacs.d/.ercrc.el}.
Here is an example configuration for ERC@. @strong{Don't panic} if
you aren't familiar with @samp{use-package} or have no interest in
learning it. For our purposes, it's just a means of presenting
configuration details in a tidy, standardized format. If it helps,
just pretend it's some make-believe, pseudo configuration language.
Although the syntax below is easy enough to intuit and adapt to your
setup, you may wish to keep the following in mind (or @pxref{Top,,,
use-package,}):
@itemize @bullet
@item
Each @code{use-package} ``declaration'' focuses on a library
``feature'', which is just a symbol you'd normally @code{require} in
your config @pxref{Named Features,,, elisp,}).
@item
Emacs loads anything in a @code{:config} section @emph{after} loading
whatever library @code{provide}s the declaration's feature.
@item
Everything in a @code{:custom} or @code{:custom-face} section is
basically something you'd find in your @code{custom-file}.
@end itemize
@noindent
The following would typically go in your init file. Experienced users
may opt to keep any non-settings, like commands and functions, in a
dedicated @file{~/.emacs.d/.ercrc.el}. Whatever the case, please keep
in mind that you can replace nearly all of the following with Custom
settings (@pxref{Sample configuration via Customize}).
@lisp
;;; Sample ERC configuration
;;; My ERC configuration -*- lexical-binding: t -*-
;; Load authentication info from an external source. Put sensitive
;; passwords and the like in here.
(load "~/.emacs.d/.erc-auth")
(use-package erc
:config
;; Prefer SASL to NickServ, colorize nicknames, interpret mIRC colors,
;; and list buffers and channel members in separate side panels.
(setopt erc-modules
(seq-union '(sasl nicks irccontrols bufbar nickbar scrolltobottom)
erc-modules))
;; This is an example of how to make a new command. Type "/uptime" to
;; use it.
(defun erc-cmd-UPTIME (&rest ignore)
"Display the uptime of the system, as well as some load-related
stuff, to the current ERC buffer."
(let ((uname-output
(replace-regexp-in-string
", load average: " "] @{Load average@} ["
;; Collapse spaces, remove
(replace-regexp-in-string
" +" " "
;; Remove beginning and trailing whitespace
(replace-regexp-in-string
"^ +\\|[ \n]+$" ""
(shell-command-to-string "uptime"))))))
(erc-send-message
(concat "@{Uptime@} [" uname-output "]"))))
:custom
;; Protect me from accidentally sending excess lines.
(erc-inhibit-multiline-input t)
(erc-send-whitespace-lines t)
(erc-ask-about-multiline-input t)
;; This causes ERC to connect to the Libera.Chat network upon hitting
;; C-c e f. Replace MYNICK with your IRC nick.
(global-set-key "\C-cef" (lambda () (interactive)
(erc :server "irc.libera.chat" :port "6667"
:nick "MYNICK")))
;; Reconnect automatically using a fancy strategy.
(erc-server-reconnect-function #'erc-server-delayed-check-reconnect)
(erc-server-reconnect-timeout 30)
;; This causes ERC to connect to the IRC server on your own machine (if
;; you have one) upon hitting C-c e b. Replace MYNICK with your IRC
;; nick. Often, people like to run bitlbee (https://bitlbee.org/) as an
;; AIM/Jabber/MSN to IRC gateway, so that they can use ERC to chat with
;; people on those networks.
(global-set-key "\C-ceb" (lambda () (interactive)
(erc :server "localhost" :port "6667"
:nick "MYNICK")))
;; Insert a newline when I hit <RET> at the prompt, and prefer
;; something more deliberate for actually sending messages.
:bind (:map erc-mode-map
("RET" . nil)
("C-c C-c" . #'erc-send-current-line))
;; Make C-c RET (or C-c C-RET) send messages instead of RET. This has
;; been commented out to avoid confusing new users.
;; (define-key erc-mode-map (kbd "RET") nil)
;; (define-key erc-mode-map (kbd "C-c RET") 'erc-send-current-line)
;; (define-key erc-mode-map (kbd "C-c C-RET") 'erc-send-current-line)
;; Emphasize buttonized text in notices.
:custom-face (erc-notice-face ((t (:slant italic :weight unspecified)))))
;;; Options
(use-package erc-sasl
;; Since my account name is the same as my nick, free me from having
;; to hit C-u before M-x erc to trigger a username prompt.
:custom (erc-sasl-user :nick))
;; Join the #emacs and #erc channels whenever connecting to
;; Libera.Chat.
(setq erc-autojoin-channels-alist
'(("Libera.Chat" "#emacs" "#erc")))
(use-package erc-join
;; Join #emacs and #erc whenever I connect to Libera.Chat.
:custom (erc-autojoin-channels-alist '((Libera.Chat "#emacs" "#erc"))))
;; Interpret mIRC-style color commands in IRC chats
(setq erc-interpret-mirc-color t)
(use-package erc-fill
:custom
;; Prefer one message per line without continuation indicators.
(erc-fill-function #'erc-fill-wrap)
(erc-fill-static-center 18)
:bind (:map erc-fill-wrap-mode-map ("C-c =" . #'erc-fill-wrap-nudge)))
(use-package erc-track
;; Prevent JOINs and PARTs from lighting up the mode-line.
:config (setopt erc-track-faces-priority-list
(remq 'erc-notice-face erc-track-faces-priority-list))
:custom (erc-track-priority-faces-only 'all))
(use-package erc-goodies
;; Turn on read indicators when joining channels.
:hook (erc-join . my-erc-enable-read-indicator-on-join))
(defvar my-erc-read-indicator-channels '("#emacs")
"Channels in which to show a `keep-place-indicator'.")
(defun my-erc-enable-read-indicator-on-join ()
"Enable read indicators for certain queries or channels."
(when (member (erc-default-target) my-erc-read-indicator-channels)
(erc-keep-place-indicator-mode +1)))
;; Handy commands from the Emacs Wiki.
(defun erc-cmd-TRACK (&optional target)
"Start tracking TARGET or that of current buffer."
(setq erc-track-exclude (delete (or target (erc-default-target))
erc-track-exclude)))
(defun erc-cmd-UNTRACK (&optional target)
"Stop tracking TARGET or that of current buffer."
(setq erc-track-exclude (cl-pushnew (or target (erc-default-target))
erc-track-exclude
:test #'equal)))
;; The following are commented out by default, but users of other
;; non-Emacs IRC clients might find them useful.
;; Kill buffers for channels after /part
;; (setq erc-kill-buffer-on-part t)
;; Kill buffers for private queries after quitting the server
;; (setq erc-kill-queries-on-quit t)
;; Kill buffers for server messages after quitting the server
;; (setq erc-kill-server-buffer-on-quit t)
@end lisp
@noindent
Those familiar with @code{use-package} may have noticed the lack of
@code{:defer} keyword args. This was done to conserve space, but you
can just pretend that this user has enabled
@code{use-package-always-defer} elsewhere.
@anchor{Sample configuration via Customize}
@subheading Via Customize
@cindex configuration, via customize
As mentioned, Customize users can accomplish nearly all of the above
via the Customize interface. Start by running @kbd{M-x
customize-group @key{RET} erc @key{RET}}, and search for ``Modules''
with @kbd{C-s modules @key{RET}}. Toggle open the flyout menu to
reveal the full ``widget'' panel, a web-form-like interface for ``Erc
Modules''. Tick the boxes for @samp{bufbar}, @samp{irccontrols},
@samp{nickbar}, @samp{nicks}, @samp{sasl}, and @samp{scrolltobottom}.
Next, search for the phrases ``Erc Ask About Multiline Input'', ``Erc
Inhibit Mulitline Input'', and ``Erc Send Whitespace Lines''. These
are the print names of three Boolean options that control how ERC
treats prompt input containing line breaks. When visiting each
option's section, twirl open its triangle icon to reveal its widget
UI, and click its @samp{[Toggle]} button to set its value to @code{t}.
While going about this, you may find it helpful to glance at the
descriptions just in case you want to disable them later. When
finished, hit @kbd{C-x C-s} or click @samp{[Apply and Save]} atop the
buffer.
Now do the same for another couple options, this time having to do
with automatic reconnection. But instead of searching for their print
names, try running @kbd{M-x customize-option @key{RET} @samp{<option>}
@key{RET}}, replacing @samp{<option>} with:
@itemize @bullet
@item @code{erc-server-reconnect-function}, a function
@item @code{erc-server-reconnect-timeout}, a number
@end itemize
@noindent
(If it helps, hit @key{TAB} for completion.) As you may have noticed,
when customizing options individually, each buffer displays but a
single option's widget. When you get to the buffer for ``Erc Server
Reconnect Function'', you'll see that @samp{[Toggle]} has been
replaced with @samp{[Value Menu]} and that clicking it reveals three
choices in a pop-up window. Enter @kbd{1} to select
@code{erc-server-delayed-check-reconnect} before @key{TAB}'ing over to
@samp{[State]} and hitting @key{RET}. Enter @kbd{1} again, this time
to persists your changes.
For the final option, @code{erc-server-reconnect-timeout}, you'll
encounter a text field (instead of a button), which works like those
in a typical web form. Enter @samp{30} and hit @kbd{C-x C-s} to save.
Just for fun, click the group link for @samp{Erc Server} at the bottom
of the buffer. You could just as well have set the last two options
from this ``custom group'' buffer alone, which very much resembles the
one for the @samp{Erc} group, which is actually the ``parent'' of this
group (note the ``breadcrumb'' for group @samp{Erc} atop the buffer).
Indeed, you can always get back here by running @kbd{M-x
customize-group @key{RET} erc-server @key{RET}} from almost anywhere
in Emacs.
Now it's time to set some key bindings for @code{erc-mode-map}, a
major-mode keymap active in all ERC buffers. In general, it's best to
do this part either entirely or in conjunction with some lisp code in
you init file. However, to keep things ``simple'', we'll do it all in
customization buffers. To get started, hit @kbd{M-x customize-group
@key{RET} erc-hooks @key{RET}} and search for ``Erc Mode Hook''. In
the widget form, click @samp{[INS]}, and paste the following into the
value field in place of the default text.
@lisp
(lambda ()
(keymap-set erc-mode-map "RET" nil)
(keymap-set erc-mode-map "C-c C-c" 'erc-send-current-line))
@end lisp
@noindent
Don't worry about the line breaks. Emacs is smart enough to handle
those. When you're ready, click @samp{[Apply and Save]}.
Next, try tweaking the face ERC uses to stylize server messages that
say things like ``SoAndSo has joined channel #chan''. Type @kbd{M-x
customize-face @key{RET} erc-notice-face @key{RET}}. Click the
``link''-looking button at the very bottom that says something like
``Show All Attributes''. Untick @samp{Weight} and tick @samp{Slant}.
Then, in the latter's @samp{[Value Menu]}, enter @samp{0} for
@samp{italic}. Hit @kbd{C-x C-s} to save.
Time for some more involved configuring. From now on, if something
isn't applicable to your setup, just skip ahead. Also, note that if
you've installed ERC from GNU ELPA, you may need to load libraries for
groups and options you'd like to customize before Emacs can create a
customization buffer. For example, to do this for the group
@code{erc-sasl}, run @kbd{M-: (require 'erc-sasl) @key{RET}}.
Speaking of @acronym{SASL}, those already authenticating with it may
have noticed that connecting interactively requires running @kbd{C-u
M-x erc-tls @key{RET}} in order to receive a ``User'' prompt for your
account name. However, if your nickname happens to be the same as
your account name, you can avoid the leading @kbd{C-u} by customizing
the option @code{erc-sasl-user} to the keyword symbol @code{:nick}.
At the time of writing, you'd hit @kbd{2} when prompted by the
option's @samp{[Value menu]}. Hit @kbd{C-x C-s} to save your changes.
One of ERC's most configured options lives in @file{erc-join}, and it
determines the channels you join upon connecting. To make it work for
you, customize the option @code{erc-autojoin-channels-alist}. In the
customization widget, hit @samp{[INS]} to create a new entry. In the
@samp{Network:} field, type @samp{Libera.Chat}. Under
@samp{Channels:}, hit @samp{[INS]} again, this time to create a field
to enter a channel name, and enter @samp{#emacs}. Now, find and click
on the lowermost @samp{[INS]}, and this time enter @samp{#erc} in the
@samp{Name:} field. Save your changes.
If you're new to ERC, you may not be familiar with the various ways it
can ``fill'' message text by inserting line breaks. The most modern
fill style is called @code{fill-wrap}, and it's available by
customizing @code{erc-fill-function} to @code{erc-fill-wrap}, which
appears as @samp{Dynamic word-wrap} in the option's @samp{[Value
Menu]}. After setting this, change the related option
@code{erc-fill-static-center} to the integer @samp{18}. Save your
changes. As a bonus exercise, try binding the key @kbd{C-c =} to the
function @code{erc-fill-wrap-nudge} in the minor-mode keymap
@code{erc-fill-wrap-mode-map} (hint: the minor mode's hook is called
@code{erc-fill-wrap-mode-hook}, and it's not a member of any
customization group).
ERC users tend to be picky about the mode line. If you find that
you'd rather not see changes when people join and leave channels,
customize the option @code{erc-track-faces-priority-list}. When
visiting its customization buffer, you'll notice it's quite busy.
Ignore everything and type @kbd{C-s erc-notice-face @key{RET}}. Click
the @samp{[DEL]} button at the beginning of the line you end up on,
and save your changes. Next, customize the related option
@code{erc-track-priority-faces-only} to the @samp{[Value Menu]} choice
@samp{all}. Once again, save your changes.
Let's say you'd like to enable a ``local module'' (ERC's version of a
local minor mode) in a specific channel. One way to do that is by
running some code to activate the module if the channel's name
matches. Try that now by customizing the option @code{erc-join-hook}.
Add the following in the value field before saving your changes:
@lisp
(lambda ()
(require 'erc-goodies)
(when (equal (erc-default-target) "#emacs")
(erc-keep-place-indicator-mode +1)))
@end lisp
Lastly, if you really want the two ``slash'' commands defined at the
end of the previous section, you can put them in any file listed in
@code{erc-startup-file-list}, such as @file{~/.emacs.d/.ercrc.el}.
Make sure to put @code{(require 'erc-track)} near the top of the file.
These will allow you to type @kbd{/TRACK @key{RET}} and @kbd{/UNTRACK
@key{RET}} in channels and query buffers to tell ERC whether to show
activity from these buffers in the mode line.
@node Integrations
@section Integrations
@cindex integrations
@menu
* auth-source:: Retrieving auth-source entries with ERC.
* display-buffer:: Controlling how ERC displays buffers.
@end menu
@anchor{URL}
@ -1468,6 +1733,185 @@ required by certain channels you join. When modifying a traditional
@samp{user} field (for example, @samp{login "#fsf"}, in netrc's case).
The actual key goes in the @samp{password} (or @samp{secret}) field.
@node display-buffer
@subsection display-buffer
@cindex display-buffer
ERC supports the ``action'' interface used by @code{display-buffer}
and friends from @file{window.el}. @xref{Displaying Buffers,,, elisp,
Emacs Lisp}, for specifics. When ERC displays a new or
``reassociated'' buffer, it consults its various buffer-display
options, such as @code{erc-buffer-display}, to decide whether and how
the buffer ought to appear in a window. Exactly which one it consults
depends on the context in which the buffer is being manifested.
For some buffer-display options, the context is pretty cut and dry.
For instance, in the case of @code{erc-receive-query-display}, you're
receiving a query from someone you haven't yet chatted with in the
current session. For other options, like
@code{erc-interactive-display}, the precise context varies. For
example, you might be opening a query buffer with the command
@kbd{/QUERY bob @key{RET}} or joining a new channel with @kbd{/JOIN
#chan @key{RET}}. Power users wishing to distinguish between such
nuanced contexts or just exercise more control over buffer-display
behavior generally can elect to override these options by setting one
or more to a ``@code{display-buffer}-like'' function that accepts a
@var{buffer} and an @var{action} argument.
@subsubheading Examples
In this first example, a user-provided buffer-display function
displays new server buffers in the current window when issuing an
@kbd{M-x erc-tls @key{RET}} and in a split window for all other
interactve contexts covered by the option
@code{erc-interactive-display}, like clicking an @samp{irc://}-style
@acronym{URL} (@pxref{URL}).
@lisp
(defun my-erc-interactive-display-buffer (buffer action)
"Pop to BUFFER when running \\[erc-tls], clicking a link, etc."
(when-let ((alist (cdr action))
(found (alist-get 'erc-interactive-display alist)))
(if (eq found 'erc-tls)
(pop-to-buffer-same-window buffer action)
(pop-to-buffer buffer action))))
(setopt erc-interactive-display #'my-erc-interactive-display-buffer)
@end lisp
@noindent
Observe that ERC supplies the names of buffer-display options as
@var{action} alist keys and pairs them with contextual constants, like
the symbols @samp{erc-tls} or @samp{url}, the full lineup of which are
listed below.
In this second example, the user writes three predicates that somewhat
resemble the ``@code{display-buffer}-like'' function above. These too
look for @var{action} alist keys sharing the names of buffer-display
options (and, in one case, a module's minor mode).
@lisp
(defun my-erc-disp-entry-p (_ action)
(memq (cdr (or (assq 'erc-buffer-display action)
(assq 'erc-interactive-display action)))
'(erc-tls url)))
(defun my-erc-disp-query-p (_ action)
(or (eq (cdr (assq 'erc-interactive-display action)) '/QUERY)
(and (eq (cdr (assq 'erc-receive-query-display action)) 'PRIVMSG)
(member (erc-default-target) '("bob" "alice")))))
(defun my-erc-disp-chan-p (_ action)
(or (assq 'erc-autojoin-mode action)
(and (memq (cdr (assq 'erc-buffer-display alist)) 'JOIN)
(member (erc-default-target) '("#emacs" "#fsf")))))
@end lisp
@noindent
You'll notice we ignore the @var{buffer} parameter of these predicates
because ERC ensures that @var{buffer} is already current (which is why
we can freely call @code{erc-default-target}). Note also that we
cheat a little by treating the @var{action} parameter like an alist
when it's really a cons of one or more functions and an alist.
@noindent
To complement our predicates, we set all three buffer-display options
referenced in their @var{action}-alist lookups to
@code{display-buffer}. This tells ERC to defer to that function in
the display contexts covered by these options.
@lisp
(setopt erc-buffer-display #'display-buffer
erc-interactive-display #'display-buffer
erc-receive-query-display #'display-buffer
;;
erc-auto-reconnect-display 'bury)
@end lisp
@noindent
The last option above just tells ERC to avoid any buffer-display
machinery when auto-reconnecting. (For historical reasons, ERC's
buffer-display options use the term ``bury'' to mean ``ignore'' rather
than @code{bury-buffer}.)
Finally, we compose our predicates into @code{buffer-match-p}
conditions and pair them with various well known @code{display-buffer}
action functions and action-alist members.
@lisp
(setopt display-buffer-alist
;; Create new frame with M-x erc-tls RET or (erc-tls ...)
'(((and (major-mode . erc-mode) my-erc-disp-entry-p)
display-buffer-pop-up-frame
(reusable-frames . visible))
;; Show important chans and queries in a split.
((and (major-mode . erc-mode)
(or my-erc-disp-chan-p my-erc-disp-query-p))
display-buffer-pop-up-window)
;; Ignore everything else.
((major-mode . erc-mode)
display-buffer-no-window
(allow-no-window . t))))
@end lisp
@noindent
Of course, we could just as well set our buffer-display options to one
or more homespun functions instead of bothering with
@code{display-buffer-alist} at all (in what would make for a more
complicated version of our first example). But perhaps we already
have a growing menagerie of similar predicates and like to keep
everything in one place in our @file{init.el}.
@subsubheading Action alist items
@table @asis
@item Option-based keys:
All keys are symbols, as are values, unless otherwise noted.
@itemize @bullet
@item @code{erc-buffer-display}
@itemize @minus
@item @samp{JOIN}
@item @samp{NOTICE}
@item @samp{PRIVMSG}
@item @samp{erc} (entry point called non-interactively)
@item @samp{erc-tls}
@end itemize
@item @code{erc-interactive-display}
@itemize @minus
@item @samp{/QUERY}
@item @samp{/JOIN}
@item @samp{/RECONNECT}
@item @samp{url} (hyperlink clicked)
@item @samp{erc} (entry point called interactively)
@item @samp{erc-tls}
@end itemize
@item @code{erc-receive-query-display}
@itemize @minus
@item @samp{NOTICE}
@item @samp{PRIVMSG}
@end itemize
@item @code{erc-auto-reconnect-display}
@itemize @minus
@item something non-@code{nil}
@end itemize
@end itemize
@item Module-based (minor-mode) keys:
@itemize @bullet
@item @code{erc-autojoin-mode}
@itemize @minus
@item channel name as a string, e.g., @code{"#chan"}
@end itemize
@end itemize
@end table
@node Options
@section Options
@ -1555,7 +1999,7 @@ In the resulting @code{help-mode} buffer, confirm the version and
click @samp{Install}. Make sure to restart Emacs before reconnecting
to IRC, and don't forget that you can roll back to the previous
version by running @kbd{M-x package-delete @key{RET}}.
@xref{Packages,,,emacs, the Emacs manual} for more information.
@xref{Packages,,,emacs, The Emacs Editor}, for more information.
In the rare instance you need an emergency fix or have volunteered to
test an edge feature between ERC releases, you can try adding
@ -1644,6 +2088,21 @@ is maintained as part of Emacs.
@end itemize
@anchor{Official IRC channels}
@subheading Official IRC channels
@cindex official IRC channels
The official channels for GNU Emacs and ERC lived on the Freenode IRC
network until June 2021, when they---along with the official IRC
channels of the GNU Project, the Free Software Foundation, and many
other free software communities---relocated to the Libera.Chat network
in the aftermath of changes in governance and policies of Freenode in
May and June 2021. GNU and FSF's announcements about this are at
@uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00005.html},
@uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00007.html},
and
@uref{https://lists.gnu.org/archive/html/info-gnu-emacs/2021-06/msg00000.html}.
@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi

97
etc/ERC-NEWS
View file

@ -14,13 +14,12 @@ GNU Emacs since Emacs version 22.1.
* Changes in ERC 5.6
** Module 'keep-place' now offers a visual indicator.
** Module 'keep-place' has gained a more flamboyant cousin.
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'.
options 'erc-keep-place-indicator-style' and friends, and try M-x
keep-place-indicator-mode to see it in action.
** Module 'fill' now offers a style based on 'visual-line-mode'.
This fill style mimics the "hanging indent" look of 'erc-fill-static'
@ -30,6 +29,14 @@ 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 new module for nickname highlighting has joined ERC.
Automatic nickname coloring has come to ERC core. Users familiar with
'erc-hl-nicks', from which this module directly descends, will already
be familiar with its suite of handy options. By default, each
nickname in an ERC session receives a unique face with a unique (or
evenly dealt) foreground color. Add 'nicks' to 'erc-modules' 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
@ -37,7 +44,7 @@ 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.
** Revised buffer-display handling for interactive commands.
** Revised buffer-display handling.
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 or when issuing a "/JOIN" command at the prompt. As explained
@ -56,7 +63,19 @@ reported as being difficult to discover and remember. When the latter
option (now known as 'erc-receive-query-display') is nil, ERC uses
'erc-join-buffer' in its place, much like it does for
'erc-interactive-display'. The old nil behavior can still be gotten
via the new compatibility flag 'erc-receive-query-display-defer'.
via the new compatibility flag 'erc-receive-query-display-defer'. The
relatively new option 'erc-reconnect-display' has likewise been
renamed, this time for clarity, to 'erc-auto-reconnect-display'.
This release also introduces a few subtleties affecting the display of
new or reassociated buffers. One involves buffers that already occupy
the selected window. ERC now treats these as deserving of an implicit
'bury'. An escape hatch for this and most other baked-in behaviors is
now available in the form of a new type variant recognized by all such
options. That is, users can now specify their own function to
exercise full control over nearly all buffer-display related
decisions. See the newly expanded doc strings of 'erc-buffer-display'
and friends, as well as Info node '(erc) display-buffer', for details.
** Setting a module's mode variable via Customize earns a warning.
Trying and failing to activate a module via its minor mode's Custom
@ -64,6 +83,22 @@ 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.
** ERC's status-sidebar has gained an accompanying module.
Users can now add 'bufbar' to 'erc-modules' to achieve the same effect
as toggling 'erc-status-sidebar-open' manually at the start of an IRC
session. The module has also been outfitted to show channels and
queries under their respective servers by default. To avoid
confusion, the major mode used for the sidebar buffer itself,
'erc-status-sidebar-mode', is no longer available interactively.
** A new spin on a classic integration in erc-speedbar.
Add 'nickbar' to 'erc-modules' to spawn a dynamically updating side
window listing all the users in any target buffer. It's powered by
the same speedbar.el integration you've always known, except this
one's optionally accessible from the keyboard, just like any other
side window. Hit '<RET>' over a nick to spawn a "/QUERY" or a
"Lastlog" (Occur) session. See 'erc-nickbar-mode' for more.
** 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
@ -75,6 +110,22 @@ 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.
** Awkward entry point 'erc-server-select' improved but deprecated.
The alternate entry point 'erc-server-select' has mainly served to
confuse users in more recent years because it requires certain
options, like 'erc-nick', to be configured ahead of time, and it
doesn't support TLS. Its main selling point, historically, has been
interactive completion based on the option 'erc-server-alist', which
is a table of networks, servers, and ports. But most of the option's
400-odd entries are sadly defunct or otherwise outdated. And, these
days, most networks promote a well known load-balancing end point over
individual servers anyway. Regardless, the command has now been
improved to prompt for the same slate of parameters sought by
'erc-tls'. Similarly, 'erc-server-alist' entries now support a fifth
member in TLS ports (though this option too has been deprecated). If
you feel these deprecations rash or unwarranted, please file a bug
report and petition the maintainers for a reprieve.
** 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
@ -129,6 +180,13 @@ been restored with a slightly revised role contingent on a few
assumptions explained in its doc string. For clarity, it has been
renamed 'erc-ensure-target-buffer-on-privmsg'.
** Subtle changes in two fundamental faces.
Users of the default theme may notice that 'erc-action-face' and
'erc-notice-face' now appear slightly less bold on systems supporting
a weight of 'semi-bold'. This was done to make buttons detectable and
to spare users from resorting to tweaking these faces, or options like
'erc-notice-highlight-type', just to achieve this effect.
** Improved interplay between buffer truncation and message logging.
While most of these improvements are subtle, some affect everyday use.
For example, users of the 'truncate' module may notice that truncation
@ -144,11 +202,12 @@ the same effect by issuing a "/CLEAR" at the prompt.
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. The command 'erc-button-previous' now moves to the
beginning instead of the end of buttons. A new command, 'erc-news',
can now be invoked to visit this very file. And the 'irccontrols'
module now supports additional colors and special handling for
"spoilers" (hidden text).
the echo area. Fool visibility has become togglable with the new
command 'erc-match-toggle-hidden-fools'. The 'button' module's
'erc-button-previous' now moves to the beginning instead of the end of
buttons. A new command, 'erc-news', can be invoked to visit this very
file. And the 'irccontrols' module now supports additional colors and
special handling for "spoilers" (hidden text).
** Changes in the library API.
@ -197,6 +256,9 @@ 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.
Additionally, the 'stamp' module now merges its 'invisible' property
with existing ones, when present, and it includes all white space
around stamps when doing so.
*** The role of a module's Custom group is now more clearly defined.
Associating built-in modules with Custom groups and provided library
@ -224,6 +286,19 @@ 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-display-message' optionally combines faces.
Users may notice that ERC now inserts some important error messages in
a combination of 'erc-error-face' and 'erc-notice-face'. This is
merely a consequence of 'erc-display-message' getting smarter about
how it treats face properties when its 'type' parameter is a list that
starts with t. Originally, ERC's authors intended to display both
server-originating and ERC-generated errors in this style, but that
intent was never realized. Though now possible, the effect has been
limited to special errors involving usage and internal state. For
third-party code, the key takeaway is that more 'font-lock-face'
properties encountered in the wild may be combinations of faces rather
than lone ones.
*** Prompt input is split before 'erc-pre-send-functions' has a say.
Hook members are now treated to input whose lines have already been
adjusted to fall within the allowed length limit. For convenience,

5
etc/NEWS
View file

@ -109,10 +109,13 @@ window systems other than Nextstep.
When this minor mode is enabled, buttons representing modifier keys
are displayed along the tool bar.
** You can expand the "..." truncation everywhere.
** cl-print
*** You can expand the "..." truncation everywhere.
The code that allowed "..." to be expanded in the *Backtrace* should
now work anywhere the data is generated by `cl-print`.
*** hash-tables' contents can be expanded via the ellipsis
** Modeline elements can now be right-aligned.
Anything following the symbol 'mode-line-format-right-align' in
'mode-line-format' will be right-aligned. Exactly where it is

4
lisp/emacs-lisp/backtrace.el
View file

@ -413,12 +413,12 @@ the buffer."
(overlay-put o 'evaporate t))))
(defun backtrace--change-button-skip (beg end value)
"Change the skip property on all buttons between BEG and END.
"Change the `skip' property on all buttons between BEG and END.
Set it to VALUE unless the button is a `cl-print-ellipsis' button."
(let ((inhibit-read-only t))
(setq beg (next-button beg))
(while (and beg (< beg end))
(unless (eq (button-type beg) cl-print-ellipsis)
(unless (eq (button-type beg) 'cl-print-ellipsis)
(button-put beg 'skip value))
(setq beg (next-button beg)))))

22
lisp/emacs-lisp/cl-print.el
View file

@ -57,7 +57,7 @@ call other entry points instead, such as `cl-prin1'."
"Dispatcher to print partial contents of OBJECT on STREAM.
This is used when replacing an ellipsis with the contents it
represents. OBJECT is the object that has been partially printed
and START represents the place at which the contents where
and START represents the place at which the contents were
replaced with an ellipsis.
Print the contents hidden by the ellipsis to STREAM."
;; Every cl-print-object method which can print an ellipsis should
@ -132,17 +132,30 @@ Print the contents hidden by the ellipsis to STREAM."
(cl-print--vector-contents object start stream)) ;FIXME: η-redex!
(cl-defmethod cl-print-object ((object hash-table) stream)
;; FIXME: Make it possible to see the contents, like `prin1' does,
;; e.g. using ellipsis. Make sure `cl-fill' can pretty print the result!
;; Make sure `pp-fill' can pretty print the result!
(princ "#<hash-table " stream)
(princ (hash-table-test object) stream)
(princ " " stream)
(princ (hash-table-count object) stream)
(princ "/" stream)
(princ (hash-table-size object) stream)
(princ (format " %#x" (sxhash object)) stream)
(princ (format " %#x " (sxhash object)) stream)
(cl-print-insert-ellipsis object t stream)
(princ ">" stream))
(cl-defmethod cl-print-object-contents ((object hash-table) _start stream)
;; If we want to obey `print-length' here, it's not completely obvious
;; what we should use as marker of "where we are" within the hash-table.
;; We could use here a simple number or a set of keys already printed,
;; but it still breaks down if elements get added/removed.
;; Instead here we convert the hash-table to an alist once and for all.
(let ((alist nil))
(maphash (lambda (k v) (push (cons k v) alist)) object)
;; While the order of elements seen by `maphash' is "arbitrary"
;; it tends to be in the order objects have been added, which is
;; sometimes handy, so it's nice to preserve this order here.
(cl-print-object (nreverse alist) stream)))
(define-button-type 'help-byte-code
'follow-link t
'action (lambda (button)
@ -475,7 +488,6 @@ STREAM should be a buffer. OBJECT and START are as described in
`cl-print-insert-ellipsis'."
(let ((value (list object start cl-print--number-table
cl-print--currently-printing)))
;; FIXME: Make it into a button!
(with-current-buffer stream
(put-text-property beg end 'cl-print-ellipsis value stream)
(make-text-button beg end :type 'cl-print-ellipsis))))

9
lisp/emacs-lisp/comp.el
View file

@ -1133,7 +1133,8 @@ with `message'. Otherwise, log with `comp-log-to-buffer'."
(log-buffer
(or (get-buffer comp-log-buffer-name)
(with-current-buffer (get-buffer-create comp-log-buffer-name)
(setf buffer-read-only t)
(unless (derived-mode-p 'compilation-mode)
(emacs-lisp-compilation-mode))
(current-buffer))))
(log-window (get-buffer-window log-buffer))
(inhibit-read-only t)
@ -4085,7 +4086,8 @@ display a message."
:buffer (with-current-buffer
(get-buffer-create
comp-async-buffer-name)
(setf buffer-read-only t)
(unless (derived-mode-p 'compilation-mode)
(emacs-lisp-compilation-mode))
(current-buffer))
:command (list
(expand-file-name invocation-name
@ -4119,6 +4121,8 @@ display a message."
(run-hooks 'native-comp-async-all-done-hook)
(with-current-buffer (get-buffer-create comp-async-buffer-name)
(save-excursion
(unless (derived-mode-p 'compilation-mode)
(emacs-lisp-compilation-mode))
(let ((inhibit-read-only t))
(goto-char (point-max))
(insert "Compilation finished.\n"))))
@ -4226,6 +4230,7 @@ LOAD and SELECTOR work as described in `native--compile-async'."
(string-match-p re file))
native-comp-jit-compilation-deny-list))))
;;;###autoload
(defun native--compile-async (files &optional recursively load selector)
;; BEWARE, this function is also called directly from C.
"Compile FILES asynchronously.

36
lisp/erc/erc-backend.el
View file

@ -101,6 +101,8 @@
(eval-when-compile (require 'cl-lib))
(require 'erc-common)
(defvar erc--called-as-input-p)
(defvar erc--display-context)
(defvar erc--target)
(defvar erc--user-from-nick-function)
(defvar erc-channel-list)
@ -304,7 +306,7 @@ function `erc-server-process-alive' instead.")
"Timer that resets `erc--server-last-reconnect-count' to zero.
Becomes non-nil in all server buffers when an IRC connection is
first \"established\" and carries out its duties
`erc-reconnect-display-timeout' seconds later.")
`erc-auto-reconnect-display-timeout' seconds later.")
(defvar-local erc--server-last-reconnect-count 0
"Snapshot of reconnect count when the connection was established.")
@ -957,7 +959,7 @@ EVENT is the message received from the closed connection process."
(erc--server-last-reconnect-display-reset (current-buffer)))
(defun erc--server-last-reconnect-display-reset (buffer)
"Deactivate `erc-reconnect-display'."
"Deactivate `erc-auto-reconnect-display'."
(when (buffer-live-p buffer)
(with-current-buffer buffer
(when erc--server-reconnect-display-timer
@ -1684,6 +1686,12 @@ add things to `%s' instead."
parsed 'notice 'active
'INVITE ?n nick ?u login ?h host ?c chnl)))))
(cl-defmethod erc--server-determine-join-display-context (_channel alist)
"Determine `erc--display-context' for JOINs."
(if (assq 'erc-buffer-display alist)
alist
`((erc-buffer-display . JOIN) ,@alist)))
(define-erc-response-handler (JOIN)
"Handle join messages."
nil
@ -1698,7 +1706,11 @@ add things to `%s' instead."
(let* ((str (cond
;; If I have joined a channel
((erc-current-nick-p nick)
(when (setq buffer (erc--open-target chnl))
(let ((erc--display-context
(erc--server-determine-join-display-context
chnl erc--display-context)))
(setq buffer (erc--open-target chnl)))
(when buffer
(set-buffer buffer)
(with-suppressed-warnings
((obsolete erc-add-default-channel))
@ -1887,6 +1899,8 @@ add things to `%s' instead."
(noticep (string= cmd "NOTICE"))
;; S.B. downcase *both* tgt and current nick
(privp (erc-current-nick-p tgt))
(erc--display-context `((erc-buffer-display . ,(intern cmd))
,@erc--display-context))
s buffer
fnick)
(setf (erc-response.contents parsed) msg)
@ -1901,6 +1915,8 @@ add things to `%s' instead."
(and erc-ensure-target-buffer-on-privmsg
(or erc-receive-query-display
erc-join-buffer)))))
(push `(erc-receive-query-display . ,(intern cmd))
erc--display-context)
(setq buffer (erc--open-target nick)))
;; A channel buffer has been killed but is still joined.
(when erc-ensure-target-buffer-on-privmsg
@ -2486,6 +2502,17 @@ See `erc-display-server-message'." nil
parsed
(erc-response.contents parsed)))
(define-erc-response-handler (471)
"ERR_CHANNELISFULL: channel full." nil
(erc-display-message parsed '(notice error) nil 's471
?c (cadr (erc-response.command-args parsed))
?s (erc-response.contents parsed)))
(define-erc-response-handler (473)
"ERR_INVITEONLYCHAN: channel invitation only." nil
(erc-display-message parsed '(notice error) nil 's473
?c (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (474)
"Banned from channel errors." nil
(erc-display-message parsed '(notice error) nil
@ -2499,6 +2526,7 @@ See `erc-display-server-message'." nil
?c (cadr (erc-response.command-args parsed)))
(when erc-prompt-for-channel-key
(let ((channel (cadr (erc-response.command-args parsed)))
(erc--called-as-input-p t)
(key (read-from-minibuffer
(format "Channel %s is mode +k. Enter key (RET to cancel): "
(cadr (erc-response.command-args parsed))))))
@ -2567,7 +2595,7 @@ See `erc-display-error-notice'." nil
;; 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 407 409 411 413 414 415
;; 423 424 436 441 443 444 467 471 472 473 KILL)
;; 423 424 436 441 443 444 467 472 KILL)
;; nil nil
;; (ignore proc parsed))

80
lisp/erc/erc-button.el
View file

@ -355,8 +355,6 @@ specified by `erc-button-alist'."
( cuser nil :type (or null erc-channel-user)
;; The CDR of a value from an `erc-channel-users' table.
:documentation "A possibly nil `erc-channel-user'.")
( face erc-button-face :type symbol
:documentation "Temp `erc-button-face' while buttonizing.")
( nickname-face erc-button-nickname-face :type symbol
:documentation "Temp `erc-button-nickname-face' while buttonizing.")
( mouse-face erc-button-mouse-face :type symbol
@ -431,45 +429,43 @@ retrieve it during buttonizing via
(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))
(erc-button-buttonize-nicks (and erc-button-buttonize-nicks
erc-button--modify-nick-function))
bounds word)
(when (and form (setq form (erc-button--extract-form 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)))
(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))
(funcall erc-button--fallback-user-function
down word bounds)))
(data (list word)))
(when (or (not (functionp form))
(and-let* ((user)
(obj (funcall form (make-erc-button--nick
:bounds bounds :data data
:downcased down :user user
:cuser (cdr cuser)))))
(setq bounds (erc-button--nick-bounds obj)
data (erc-button--nick-data obj)
erc-button-mouse-face
(erc-button--nick-mouse-face obj)
erc-button-nickname-face
(erc-button--nick-nickname-face obj)
erc-button-face
(erc-button--nick-face obj))))
(erc-button-add-button (car bounds) (cdr bounds)
fun t data))))))))
(when-let ((form (nth 2 entry))
;; Spoof `form' slot of default legacy `nicknames' entry
;; so `erc-button--extract-form' sees a function value.
(form (let ((erc-button-buttonize-nicks
(and erc-button-buttonize-nicks
erc-button--modify-nick-function)))
(erc-button--extract-form form)))
(seen 0))
(goto-char (point-min))
(while-let
(((erc-forward-word))
(bounds (or (and (= 1 (cl-incf seen)) (erc--get-speaker-bounds))
(erc-bounds-of-word-at-point)))
(word (buffer-substring-no-properties (car bounds) (cdr bounds)))
(down (erc-downcase word)))
(let* ((erc-button-mouse-face erc-button-mouse-face)
(erc-button-nickname-face erc-button-nickname-face)
(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))
(funcall erc-button--fallback-user-function
down word bounds)))
(data (list word)))
(when (or (not (functionp form))
(and-let* ((user)
(obj (funcall form (make-erc-button--nick
:bounds bounds :data data
:downcased down :user user
:cuser (cdr cuser)))))
(setq erc-button-mouse-face ; might be null
(erc-button--nick-mouse-face obj)
erc-button-nickname-face ; might be null
(erc-button--nick-nickname-face obj)
data (erc-button--nick-data obj)
bounds (erc-button--nick-bounds obj))))
(erc-button-add-button (car bounds) (cdr bounds) (nth 3 entry)
'nickp data))))))
(defun erc-button-add-buttons-1 (regexp entry)
"Search through the buffer for matches to ENTRY and add buttons."
@ -819,7 +815,7 @@ non-strings, concatenate leading string members before applying
erc-button--display-error-with-buttons
erc-button-describe-symbol 1)
,@erc-button-alist)))
(erc-display-message parsed '(notice error) (or buffer 'active) string)
(erc-display-message parsed '(t notice error) (or buffer 'active) string)
string))
;;;###autoload

23
lisp/erc/erc-common.el
View file

@ -289,6 +289,15 @@ instead of a `set' state, which precludes any actual saving."
(intern (file-name-base file))))
(v v)))
(defvar erc--module-toggle-prefix-arg nil
"The interpreted prefix arg of the minor-mode toggle.
Non-nil inside an ERC module's activation (or deactivation)
command, such as `erc-spelling-enable', when it's been called
indirectly via the module's minor-mode toggle, i.e.,
`erc-spelling-mode'. Nil otherwise. Its value is either the
symbol `toggle' or an integer produced by `prefix-numeric-value'.
See Info node `(elisp) Defining Minor Modes' for more.")
(defmacro define-erc-module (name alias doc enable-body disable-body
&optional local-p)
"Define a new minor mode using ERC conventions.
@ -337,9 +346,8 @@ if ARG is omitted or nil.
:group (erc--find-group ',name ,(and alias (list 'quote alias)))
,@(unless local-p `(:require ',(erc--find-feature name alias)))
,@(unless local-p `(:type ,(erc--prepare-custom-module-type name)))
(if ,mode
(,enable)
(,disable)))
(let ((erc--module-toggle-prefix-arg arg))
(if ,mode (,enable) (,disable))))
,(erc--assemble-toggle local-p name enable mode t enable-body)
,(erc--assemble-toggle local-p name disable mode nil disable-body)
,@(and-let* ((alias)
@ -465,6 +473,15 @@ Use the CASEMAPPING ISUPPORT parameter to determine the style."
(inline-quote (erc-with-server-buffer
(gethash (erc-downcase ,nick) erc-server-users)))))
(defmacro erc--with-dependent-type-match (type &rest features)
"Massage Custom :type TYPE with :match function that pre-loads FEATURES."
`(backquote (,(car type)
:match
,(list '\, `(lambda (w v)
,@(mapcar (lambda (ft) `(require ',ft)) features)
(,(widget-get (widget-convert type) :match) w v)))
,@(cdr type))))
(provide 'erc-common)
;;; erc-common.el ends here

21
lisp/erc/erc-compat.el
View file

@ -445,27 +445,6 @@ If START or END is negative, it counts from the end."
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

2
lisp/erc/erc-dcc.el
View file

@ -399,7 +399,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
(if compat-args
(setq cmd line
args compat-args)
(setq args (delete "" (erc-compat--split-string-shell-command line))
(setq args (delete "" (erc--split-string-shell-cmd line))
cmd (pop args)))
(let ((fn (intern-soft (concat "erc-dcc-do-" (upcase cmd) "-command"))))
(if fn

25
lisp/erc/erc-fill.el
View file

@ -124,11 +124,9 @@ configured. Its value should be larger than that of the variable
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil) number))
(defcustom erc-fill-spaced-commands '(PRIVMSG NOTICE)
(defvar erc-fill--spaced-commands '(PRIVMSG NOTICE)
"Types of messages to add space between on graphical displays.
Only considered when `erc-fill-line-spacing' is non-nil."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(repeat (choice integer symbol)))
Only considered when `erc-fill-line-spacing' is non-nil.")
(defvar-local erc-fill--function nil
"Internal copy of `erc-fill-function'.
@ -153,12 +151,12 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'."
(p (point-min)))
(widen)
(when (or (and-let* ((cmd (get-text-property p 'erc-command)))
(memq cmd erc-fill-spaced-commands))
(memq cmd erc-fill--spaced-commands))
(and-let* ((cmd (save-excursion
(forward-line -1)
(get-text-property (point)
'erc-command))))
(memq cmd erc-fill-spaced-commands)))
(memq cmd erc-fill--spaced-commands)))
(put-text-property (1- p) p
'line-spacing erc-fill-line-spacing))))))))
@ -384,8 +382,7 @@ parties.")
(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))
(not (eq (get-text-property m 'erc-ctcp) 'ACTION))
(cons (get-text-property m 'erc-timestamp)
(get-text-property (1+ m) 'erc-data)))))
(ts (pop props))
@ -418,6 +415,12 @@ parties.")
`(space :width (- erc-fill--wrap-value ,width))))
args)
;; An escape hatch for third-party code expecting speakers of ACTION
;; messages to be exempt from `line-prefix'. This could be converted
;; into a user option if users feel similarly.
(defvar erc-fill--wrap-action-dedent-p t
"Whether to dedent speakers in CTCP \"ACTION\" lines.")
(defun erc-fill-wrap ()
"Use text props to mimic the effect of `erc-fill-static'.
See `erc-fill-wrap-mode' for details."
@ -428,6 +431,12 @@ See `erc-fill-wrap-mode' for details."
(let ((len (or (and erc-fill--wrap-length-function
(funcall erc-fill--wrap-length-function))
(progn
(when-let ((e (erc--get-speaker-bounds))
(b (pop e))
((or erc-fill--wrap-action-dedent-p
(not (eq (get-text-property b 'erc-ctcp)
'ACTION)))))
(goto-char e))
(skip-syntax-forward "^-")
(forward-char)
;; Using the `invisible' property might make more

41
lisp/erc/erc-goodies.el
View file

@ -91,6 +91,7 @@ variable `erc-input-line-position'."
(save-restriction
(widen)
(when (and erc-insert-marker
(eq (current-buffer) (window-buffer))
;; we're editing a line. Scroll.
(> (point) erc-insert-marker))
(save-excursion
@ -207,6 +208,8 @@ the active frame."
(require 'fringe)
(erc--restore-initialize-priors erc-keep-place-indicator-mode
erc--keep-place-indicator-overlay (make-overlay 0 0))
(add-hook 'erc-keep-place-mode-hook
#'erc--keep-place-indicator-on-global-module nil t)
(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)))
@ -222,27 +225,39 @@ the active frame."
;;;###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)
(erc--warn-once-before-connect 'erc-keep-place-mode
"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))
"Buffer-local `keep-place' with fringe arrow and/or highlighted face.
Play nice with global module `keep-place' but don't depend on it.
Expect that users may want different combinations of `keep-place'
and `keep-place-indicator' in different buffers."
((cond (erc-keep-place-mode)
((memq 'keep-place erc-modules)
(erc-keep-place-mode +1))
;; Enable a local version of `keep-place-mode'.
(t (add-hook 'erc-insert-pre-hook #'erc-keep-place 90 t)))
(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)))
(erc-keep-place-indicator-mode -1)))
((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)))
(delete-overlay erc--keep-place-indicator-overlay))
(remove-hook 'window-configuration-change-hook
#'erc--keep-place-indicator-on-window-configuration-change t)
(remove-hook 'erc-keep-place-mode-hook
#'erc--keep-place-indicator-on-global-module t)
(remove-hook 'erc-insert-pre-hook #'erc-keep-place t)
(kill-local-variable 'erc--keep-place-indicator-overlay))
'local)
(defun erc--keep-place-indicator-on-global-module ()
"Ensure `keep-place-indicator' can cope with `erc-keep-place-mode'.
That is, ensure the local module can survive a user toggling the
global one."
(if erc-keep-place-mode
(remove-hook 'erc-insert-pre-hook #'erc-keep-place t)
(add-hook 'erc-insert-pre-hook #'erc-keep-place 90 t)))
(defun erc-keep-place-move (pos)
"Move keep-place indicator to current line or POS.
For use with `keep-place-indicator' module. When called

39
lisp/erc/erc-join.el
View file

@ -44,11 +44,23 @@
((add-hook 'erc-after-connect #'erc-autojoin-channels)
(add-hook 'erc-nickserv-identified-hook #'erc-autojoin-after-ident)
(add-hook 'erc-server-JOIN-functions #'erc-autojoin-add)
(add-hook 'erc-server-PART-functions #'erc-autojoin-remove))
(add-hook 'erc-server-PART-functions #'erc-autojoin-remove)
(add-hook 'erc-server-405-functions #'erc-join--remove-requested-channel)
(add-hook 'erc-server-471-functions #'erc-join--remove-requested-channel)
(add-hook 'erc-server-473-functions #'erc-join--remove-requested-channel)
(add-hook 'erc-server-474-functions #'erc-join--remove-requested-channel)
(add-hook 'erc-server-475-functions #'erc-join--remove-requested-channel))
((remove-hook 'erc-after-connect #'erc-autojoin-channels)
(remove-hook 'erc-nickserv-identified-hook #'erc-autojoin-after-ident)
(remove-hook 'erc-server-JOIN-functions #'erc-autojoin-add)
(remove-hook 'erc-server-PART-functions #'erc-autojoin-remove)))
(remove-hook 'erc-server-PART-functions #'erc-autojoin-remove)
(remove-hook 'erc-server-405-functions #'erc-join--remove-requested-channel)
(remove-hook 'erc-server-471-functions #'erc-join--remove-requested-channel)
(remove-hook 'erc-server-473-functions #'erc-join--remove-requested-channel)
(remove-hook 'erc-server-474-functions #'erc-join--remove-requested-channel)
(remove-hook 'erc-server-475-functions #'erc-join--remove-requested-channel)
(erc-buffer-do (lambda ()
(kill-local-variable 'erc-join--requested-channels)))))
(defcustom erc-autojoin-channels-alist nil
"Alist of channels to autojoin on IRC networks.
@ -138,6 +150,28 @@ network or a network ID). Return nil on failure."
(string-match-p candidate (or erc-server-announced-name
erc-session-server)))))
(defvar-local erc-join--requested-channels nil
"List of channels for which an outgoing JOIN was sent.")
;; Assume users will update their `erc-autojoin-channels-alist' when
;; encountering errors, like a 475 ERR_BADCHANNELKEY.
(defun erc-join--remove-requested-channel (_ parsed)
"Remove channel from `erc-join--requested-channels'."
(when-let ((channel (cadr (erc-response.command-args parsed)))
((member channel erc-join--requested-channels)))
(setq erc-join--requested-channels
(delete channel erc-join--requested-channels)))
nil)
(cl-defmethod erc--server-determine-join-display-context
(channel alist &context (erc-autojoin-mode (eql t)))
"Add item to `erc-display-context' ALIST if CHANNEL was autojoined."
(when (member channel erc-join--requested-channels)
(setq erc-join--requested-channels
(delete channel erc-join--requested-channels))
(push (cons 'erc-autojoin-mode channel) alist))
(cl-call-next-method channel alist))
(defun erc-autojoin--join ()
;; This is called in the server buffer
(pcase-dolist (`(,name . ,channels) erc-autojoin-channels-alist)
@ -146,6 +180,7 @@ network or a network ID). Return nil on failure."
(let ((buf (erc-get-buffer chan erc-server-process)))
(unless (and buf (with-current-buffer buf
(erc--current-buffer-joined-p)))
(push chan erc-join--requested-channels)
(erc-server-join-channel nil chan)))))))
(defun erc-autojoin-after-ident (_network _nick)

29
lisp/erc/erc-match.el
View file

@ -657,22 +657,22 @@ See `erc-log-match-format'."
(defvar-local erc-match--hide-fools-offset-bounds nil)
;; FIXME this should merge with instead of overwrite existing
;; `invisible' values.
(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide foolish comments.
This function should be called from `erc-text-matched-hook'."
"Hide comments from designated fools."
(when (eq match-type 'fool)
(erc-match--hide-message)))
(defun erc-match--hide-message ()
(progn ; FIXME raise sexp
(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)))))
(erc--merge-prop (1- beg) (1- end) 'invisible 'erc-match)))
;; Before ERC 5.6, this also used to add an `intangible'
;; property, but the docs say it's now obsolete.
(erc--merge-prop (point-min) (point-max) 'invisible 'erc-match))))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
@ -681,12 +681,21 @@ This function is meant to be called from `erc-text-matched-hook'."
(beep)))
(defun erc-match--modify-invisibility-spec ()
"Add an ellipsis property to the local spec."
"Add an `erc-match' 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))))
(defun erc-match-toggle-hidden-fools ()
"Toggle fool visibility.
Expect `erc-hide-fools' or a function that does something similar
to be in `erc-text-matched-hook'."
(interactive)
(if (memq 'erc-match (ensure-list buffer-invisibility-spec))
(remove-from-invisibility-spec 'erc-match)
(add-to-invisibility-spec 'erc-match)))
(provide 'erc-match)
;;; erc-match.el ends here

80
lisp/erc/erc-networks.el
View file

@ -29,8 +29,6 @@
;;
;; This is the "networks" module.
;;
;; M-x erc-server-select provides an alternative way to connect to servers by
;; choosing networks.
;; You can use (eq (erc-network) 'Network) if you'd like to set variables or do
;; certain actions according to which network you're connected to.
;; If a network you use is not listed in `erc-networks-alist', you can put
@ -258,6 +256,7 @@
("IRChat: Random server" IRChat "irc.irchat.net" ((6660 6669)))
("IrcLordz: Random server" IrcLordz "irc.irclordz.com" 6667)
("IrcMalta: Random server" IrcMalta "irc.ircmalta.org" ((6660 6667)))
;; This one is dead but used in testing. Please retain.
("IRCnet: EU, FR, Random" IRCnet "irc.fr.ircnet.net" 6667)
("IRCnet: EU, IT, Random" IRCnet "irc.ircd.it" ((6665 6669)))
("IRCnet: AS, IL, Haifa" IRCnet "ircnet.netvision.net.il" ((6661 6668)))
@ -318,13 +317,15 @@
("LagNet: Random server" LagNet "irc.lagnet.org.za" 6667)
("LagNet: AF, ZA, Cape Town" LagNet "reaper.lagnet.org.za" 6667)
("LagNet: AF, ZA, Johannesburg" LagNet "mystery.lagnet.org.za" 6667)
("Libera.Chat: Random server" Libera.Chat "irc.libera.chat" 6667)
("Libera.Chat: Random Europe server" Libera.Chat "irc.eu.libera.chat" 6667)
("Libera.Chat: Random US & Canada server" Libera.Chat "irc.us.libera.chat" 6667)
("Libera.Chat: Random Australia & New Zealand server" Libera.Chat "irc.au.libera.chat" 6667)
("Libera.Chat: Random East Asia server" Libera.Chat "irc.ea.libera.chat" 6667)
("Libera.Chat: IPv4 only server" Libera.Chat "irc.ipv4.libera.chat" 6667)
("Libera.Chat: IPv6 only server" Libera.Chat "irc.ipv6.libera.chat" 6667)
("Libera.Chat: Random server" Libera.Chat "irc.libera.chat"
((6665 6667) (8000 8002)) (6697 7000 7070))
;; If not deprecating this option, use ^ for the rest of these servers.
("Libera.Chat: Random Europe server" Libera.Chat "irc.eu.libera.chat" 6667 6697)
("Libera.Chat: Random US & Canada server" Libera.Chat "irc.us.libera.chat" 6667 6697)
("Libera.Chat: Random Australia & New Zealand server" Libera.Chat "irc.au.libera.chat" 6667 6697)
("Libera.Chat: Random East Asia server" Libera.Chat "irc.ea.libera.chat" 6667 6697)
("Libera.Chat: IPv4 only server" Libera.Chat "irc.ipv4.libera.chat" 6667 6697)
("Libera.Chat: IPv6 only server" Libera.Chat "irc.ipv6.libera.chat" 6667 6697)
("Librenet: Random server" Librenet "irc.librenet.net" 6667)
("LinkNet: Random server" LinkNet "irc.link-net.org" ((6667 6669)))
("LinuxChix: Random server" LinuxChix "irc.linuxchix.org" 6667)
@ -349,7 +350,7 @@
("Novernet: Random server" Novernet "irc.novernet.com" ((6665 6669) 7000 ))
("Nullrouted: Random server" Nullrouted "irc.nullrouted.org" ((6666 6669) 7000 ))
("NullusNet: Random server" NullusNet "irc.nullus.net" 6667)
("OFTC: Random server" OFTC "irc.oftc.net" ((6667 6670) 7000))
("OFTC: Random server" OFTC "irc.oftc.net" ((6667 6670) 7000) (6697 9999))
("OpChat: Random server" OpChat "irc.opchat.org" ((6667 6669)))
("Othernet: Random server" Othernet "irc.othernet.org" 6667)
("Othernet: US, FL, Miami" Othernet "miami.fl.us.othernet.org" 6667)
@ -472,12 +473,13 @@
("ZUHnet: Random server" ZUHnet "irc.zuh.net" 6667)
("Zurna: Random server" Zurna "irc.zurna.net" 6667))
"Alist of irc servers.
Each server is a list (NAME NET HOST PORTS) where
Each server is a list (NAME NET HOST PORTS TLS-PORTS) where
NAME is a name for that server,
NET is a symbol indicating to which network from `erc-networks-alist'
this server corresponds,
HOST is the servers hostname and
PORTS is either a number, a list of numbers, or a list of port ranges."
HOST is the server's hostname, and (TLS-)PORTS is either a
number, a list of numbers, or a list of port ranges."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(alist :key-type (string :tag "Name")
:value-type
(group symbol (string :tag "Hostname")
@ -486,7 +488,15 @@ PORTS is either a number, a list of numbers, or a list of port ranges."
(repeat :tag "List of ports or ranges"
(choice (integer :tag "Port number")
(list :tag "Port range"
integer integer)))))))
integer integer))))
(choice :tag "TLS ports"
(integer :tag "TLS port number")
(repeat :tag "List of TLS ports or ranges"
(choice (integer :tag "TLS port number")
(list :tag "TLS port range"
integer integer)))))))
(make-obsolete-variable 'erc-server-alist
"specify `:server' with `erc-tls'." "30.1")
(defcustom erc-networks-alist
'((4-irc "4-irc.com")
@ -1459,6 +1469,7 @@ to be a false alarm. If `erc-reuse-buffers' is nil, let
;; When this ends up being the current buffer, either we have
;; a "given" ID or the buffer was reused on reconnecting.
(existing (get-buffer name)))
(process-put new-proc 'erc-networks--id erc-networks--id)
(cond ((or (not existing)
(erc-networks--id-given erc-networks--id)
(eq existing (current-buffer)))
@ -1535,7 +1546,7 @@ As an example:
(erc-ports-list \\='((1 5))) => (1 2 3 4 5)
(erc-ports-list \\='(1 (3 5))) => (1 3 4 5)"
(let (result)
(dolist (p ports)
(dolist (p (ensure-list ports))
(cond ((numberp p)
(push p result))
((listp p)
@ -1544,31 +1555,32 @@ As an example:
result)))))
(nreverse result)))
;;;###autoload
(defun erc-server-select ()
"Interactively select a server to connect to using `erc-server-alist'."
(interactive)
(defun erc-networks--server-select ()
"Prompt for a server in `erc-server-alist' and return its irc(s):// URL.
Choose port at random if multiple candidates exist, but always
prefer TLS without asking. When a port can't be determined,
return the host alone sans URL formatting (for compatibility)."
(let* ((completion-ignore-case t)
(net (intern
(completing-read "Network: "
(delete-dups
(mapcar (lambda (x)
(list (symbol-name (nth 1 x))))
(list (nth 1 x)))
erc-server-alist)))))
(srv (assoc
(completing-read "Server: "
(delq nil
(mapcar (lambda (x)
(when (equal (nth 1 x) net)
x))
erc-server-alist)))
erc-server-alist))
(s-choose (lambda (entry)
(and (equal (nth 1 entry) net)
(if-let ((b (string-search ": " (car entry))))
(cons (format "%s (%s)" (nth 2 entry)
(substring (car entry) (+ b 2)))
(cdr entry))
entry))))
(s-entries (delq nil (mapcar s-choose erc-server-alist)))
(srv (assoc (completing-read "Server: " s-entries) s-entries))
(host (nth 2 srv))
(ports (if (listp (nth 3 srv))
(erc-ports-list (nth 3 srv))
(list (nth 3 srv))))
(port (and ports (seq-random-elt ports))))
(erc :server host :port port)))
(pspec (nthcdr 3 srv))
(ports (erc-ports-list (or (cadr pspec) (car pspec))))
(scheme (if (cdr pspec) "ircs" "irc")))
(if ports (format "%s://%s:%d" scheme host (seq-random-elt ports)) host)))
;;; The following experimental
;; It does not work yet, help me with it if you
@ -1605,7 +1617,7 @@ VALUE is the options value.")
items nil)))))
val))
(erc-get 'pals 'Libera.Chat)
;; (erc-get 'pals 'Libera.Chat)
(provide 'erc-networks)

633
lisp/erc/erc-nicks.el Normal file
View file

@ -0,0 +1,633 @@
;;; erc-nicks.el -- Nick colors for ERC -*- lexical-binding: t; -*-
;; Copyright (C) 2023 Free Software Foundation, Inc.
;; Author: David Leatherman <leathekd@gmail.com>
;; Andy Stewart <lazycat.manatee@gmail.com>
;; 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:
;; This file provides the `nicks' module for automatic nickname
;; highlighting. Add `nicks' to `erc-modules' to get started.
;;
;; Use the command `erc-nicks-refresh' to review changes after
;; adjusting an option, like `erc-nicks-contrast-range'. To change
;; the color of a nickname in a target buffer, click on it and choose
;; "Edit face" from the completion interface, and then perform your
;; adjustments in the resulting Customize menu. Non-Customize users
;; on Emacs 28+ can persist changes permanently by clicking on the
;; face's "location" hyperlink and copying the generated code snippet
;; (`defface' or `use-package') to their init.el. Customize users
;; need only click "Apply and Save", as usual.
;;; History:
;; This module has enjoyed a number of contributors across several
;; variants over the years, including:
;;
;; Thibault Polge <thibault@thb.lt>
;; Jay Kamat <jaygkamat@gmail.com>
;; Alex Kost <alezost@gmail.com>
;; Antoine Levitt <antoine dot levitt at gmail>
;; Adam Porter <adam@alphapapa.net>
;;
;; To those not mentioned, your efforts are no less appreciated.
;; 2023/05 - erc-nicks
;; Rewrite using internal API, and rebrand for ERC 5.6
;; 2020/03 - erc-hl-nicks 1.3.4
;; Final release, see [1] for intervening history
;; 2014/05 - erc-highlight-nicknames.el
;; Final release, see [2] for intervening history
;; 2011/08 - erc-hl-nicks 1.0
;; Initial release forked from erc-highlight-nicknames.el
;; 2008/12 - erc-highlight-nicknames.el
;; First release from Andy Stewart
;; 2007/09 - erc-highlight-nicknames.el
;; Initial release by by André Riemann
;; [1] <http://www.github.com/leathekd/erc-hl-nicks>
;; [2] <https://www.emacswiki.org/emacs/ErcHighlightNicknames>
;;; Code:
(require 'erc-button)
(require 'color)
(defgroup erc-nicks nil
"Colorize nicknames in ERC target buffers."
:package-version '(ERC . "5.6") ; FIXME sync on release
:group 'erc)
(defcustom erc-nicks-ignore-chars ",`'_-"
"Trailing characters in a nick to ignore while highlighting.
Value should be a string containing characters typically appended
by IRC clients to secure a nickname after a rejection (see option
`erc-nick-uniquifier'). A value of nil means don't trim
anything."
:type '(choice (string :tag "Chars to trim")
(const :tag "Don't trim" nil)))
(defcustom erc-nicks-skip-nicks nil
"Nicks to avoid highlighting.
ERC only considers this option during module activation, so users
should adjust it before connecting."
:type '(repeat string))
(defcustom erc-nicks-skip-faces '( erc-notice-face erc-current-nick-face
erc-my-nick-face erc-pal-face erc-fool-face)
"Faces to avoid highlighting atop."
:type (erc--with-dependent-type-match (repeat face) erc-match))
(defcustom erc-nicks-backing-face erc-button-nickname-face
"Face to mix with generated one for emphasizing non-speakers."
:type '(choice face (const nil)))
(defcustom erc-nicks-bg-color
(frame-parameter (selected-frame) 'background-color)
"Background color for calculating contrast.
Set this explicitly when the background color isn't discoverable,
which may be the case in terminal Emacs."
:type 'string)
(defcustom erc-nicks-color-adjustments
'(erc-nicks-add-contrast erc-nicks-cap-contrast erc-nicks-ensaturate)
"Treatments applied to improve aesthetics or visibility.
For example, the function `erc-nicks-invert' inverts a nick when
it's too close to the background, and `erc-nicks-add-contrast'
attempts to find a decent contrast ratio by brightening or
darkening. When `erc-nicks-colors' is set to the symbol
`defined' or a user-provided list of colors, ERC uses this option
as a guide for culling any colors that don't fall within
`erc-nicks-contrast-range' or `erc-nicks-saturation-range', as
appropriate. For example, if `erc-nicks-cap-contrast' is present
in this option's value, and a color's contrast exceeds the CDR of
`erc-nicks-contrast-range', ERC will purge that color from its
rolls when initializing this module. Specify a value of nil to
inhibit this process."
:type '(repeat
(choice (function-item :tag "Invert" erc-nicks-invert)
(function-item :tag "Add contrast" erc-nicks-add-contrast)
(function-item :tag "Cap contrast" erc-nicks-cap-contrast)
(function-item :tag "Bound saturation" erc-nicks-ensaturate)
function)))
(defcustom erc-nicks-contrast-range '(4.3 . 12.5)
"Desired range of contrast as a cons of (MIN . MAX).
When `erc-nicks-add-contrast' and/or `erc-nicks-invert' appear in
`erc-nicks-color-adjustments', MIN specifies the minimum amount
of contrast allowed between a buffer's background and its
foreground colors. Depending on the background, nicks may appear
tinted in pastels or shaded with muted grays. MAX works
similarly for reducing contrast, but only when
`erc-nicks-cap-contrast' is active. Users with lighter
backgrounds may want to lower MAX significantly. Either value
can range from 1.0 to 21.0(:1) but may produce unsatisfactory
results toward either extreme."
:type '(cons float float))
(defcustom erc-nicks-saturation-range '(0.2 . 0.8)
"Desired range for constraining saturation.
Expressed as a cons of decimal proportions. Only matters when
`erc-nicks-ensaturate' appears in `erc-nicks-color-adjustments'."
:type '(cons float float))
(defcustom erc-nicks-colors 'all
"Pool of colors.
List of colors as strings (hex or named) or, alternatively, a
single symbol representing a set of colors, like that produced by
the function `defined-colors', which ERC associates with the
symbol `defined'. Similarly, `all' tells ERC to use any 24-bit
color. When specifying a list, users may want to set the option
`erc-nicks-color-adjustments' to nil to prevent unwanted culling."
:type '(choice (const all) (const defined) (repeat string)))
(defcustom erc-nicks-key-suffix-format "@%n"
"Template for latter portion of keys to generate colors from.
ERC passes this to `format-spec' with the following specifiers:
%n for the current network and %m for your nickname (not the one
being colorized). If you don't like the generated palette, try
adding extra characters or padding, for example, with something
like \"@%-012n\"."
:type 'string)
(defvar erc-nicks--max-skip-search 3 ; make this an option?
"Max number of faces to visit when testing `erc-nicks-skip-faces'.")
(defvar erc-nicks--colors-rejects nil)
(defvar erc-nicks--custom-keywords '(:group erc-nicks :group erc-faces))
(defvar erc-nicks--grad-steps 9)
(defvar-local erc-nicks--face-table nil
"Hash table mapping nicks to unique, named faces.
Keys are nonempty strings but need not be valid nicks.")
(defvar-local erc-nicks--downcased-skip-nicks nil
"Case-mapped copy of `erc-nicks-skip-nicks'.")
(defvar-local erc-nicks--bg-luminance nil)
(defvar-local erc-nicks--bg-mode-value nil)
(defvar-local erc-nicks--colors-len nil)
(defvar-local erc-nicks--colors-pool nil)
(defvar-local erc-nicks--fg-rgb nil)
(defvar help-xref-stack)
(defvar help-xref-stack-item)
;; https://stackoverflow.com/questions/596216#answer-56678483
(defun erc-nicks--get-luminance (color)
"Return relative luminance of COLOR.
COLOR can be a list of normalized values or a name. This is the
same as the Y component returned by `color-srgb-to-xyz'."
(let ((out 0)
(coefficients '(0.2126 0.7152 0.0722))
(chnls (if (stringp color) (color-name-to-rgb color) color)))
(dolist (ch chnls out)
(cl-incf out (* (pop coefficients)
(if (<= ch 0.04045)
(/ ch 12.92)
(expt (/ (+ ch 0.055) 1.055) 2.4)))))))
(defun erc-nicks--get-contrast (fg &optional bg)
"Return a float between 1 and 21 for colors FG and BG.
If FG or BG are floats, interpret them as luminance values."
(let* ((lum-fg (if (numberp fg) fg (erc-nicks--get-luminance fg)))
(lum-bg (if bg
(if (numberp bg) bg (erc-nicks--get-luminance bg))
(or erc-nicks--bg-luminance
(setq erc-nicks--bg-luminance
(erc-nicks--get-luminance erc-nicks-bg-color))))))
(when (< lum-fg lum-bg) (cl-rotatef lum-fg lum-bg))
(/ (+ 0.05 lum-fg) (+ 0.05 lum-bg))))
(defmacro erc-nicks--bg-mode ()
`(or erc-nicks--bg-mode-value
(setq erc-nicks--bg-mode-value
,(cond ((fboundp 'frame--current-background-mode)
'(frame--current-background-mode (selected-frame)))
((fboundp 'frame--current-backround-mode)
'(frame--current-backround-mode (selected-frame)))
(t
'(frame-parameter (selected-frame) 'background-mode))))))
;; https://www.w3.org/TR/UNDERSTANDING-WCAG20/visual-audio-contrast-contrast.html
(defun erc-nicks--adjust-contrast (color target &optional decrease)
(let* ((lum-bg (or erc-nicks--bg-luminance
(setq erc-nicks--bg-luminance
(erc-nicks--get-luminance erc-nicks-bg-color))))
(stop (if decrease
(color-name-to-rgb erc-nicks-bg-color)
erc-nicks--fg-rgb))
;; From `color-gradient' in color.el
(r (nth 0 color))
(g (nth 1 color))
(b (nth 2 color))
(interval (float (1+ (expt 2 erc-nicks--grad-steps))))
(r-step (/ (- (nth 0 stop) r) interval))
(g-step (/ (- (nth 1 stop) g) interval))
(b-step (/ (- (nth 2 stop) b) interval))
(maxtries erc-nicks--grad-steps)
started)
;; FIXME stop when sufficiently close instead of exhausting.
(while (let* ((lum-fg (erc-nicks--get-luminance (list r g b)))
(darker (if (< lum-bg lum-fg) lum-bg lum-fg))
(lighter (if (= darker lum-bg) lum-fg lum-bg))
(cur (/ (+ 0.05 lighter) (+ 0.05 darker)))
(scale (expt 2 maxtries)))
(cond ((if decrease (> cur target) (< cur target))
(setq r (+ r (* r-step scale))
g (+ g (* g-step scale))
b (+ b (* b-step scale))))
(started
(setq r (- r (* r-step scale))
g (- g (* g-step scale))
b (- b (* b-step scale))))
(t (setq maxtries 1)))
(unless started
(setq started t))
(setq r (min 1.0 (max 0 r))
g (min 1.0 (max 0 g))
b (min 1.0 (max 0 b)))
(not (zerop (cl-decf maxtries)))))
(list r g b)))
(defun erc-nicks-add-contrast (color)
"Increase COLOR's contrast by blending it with the foreground.
Unless sufficient contrast exists between COLOR and the
background, raise it to meet the lower bound of
`erc-nicks-contrast-range'."
(erc-nicks--adjust-contrast color (car erc-nicks-contrast-range)))
(defun erc-nicks-cap-contrast (color)
"Reduce COLOR's contrast by blending it with the background.
If excessive contrast exists between COLOR and the background,
lower it to the upper bound of `erc-nicks-contrast-range'."
(erc-nicks--adjust-contrast color (cdr erc-nicks-contrast-range) 'remove))
(defun erc-nicks-invert (color)
"Invert COLOR based on the CAR of `erc-nicks-contrast-range'.
Don't bother if the inverted color has less contrast than the
input."
(if-let ((con-input (erc-nicks--get-contrast color))
((< con-input (car erc-nicks-contrast-range)))
(flipped (mapcar (lambda (c) (- 1.0 c)) color))
((> (erc-nicks--get-contrast flipped) con-input)))
flipped
color))
(defun erc-nicks-ensaturate (color)
"Ensure COLOR falls within `erc-nicks-saturation-range'."
(pcase-let ((`(,min . ,max) erc-nicks-saturation-range)
(`(,h ,s ,l) (apply #'color-rgb-to-hsl color)))
(cond ((> s max) (setq color (color-hsl-to-rgb h max l)))
((< s min) (setq color (color-hsl-to-rgb h min l)))))
color)
;; From https://elpa.gnu.org/packages/ement. The bit depth has been
;; scaled up to try and avoid components being exactly 0.0, which our
;; contrast function doesn't seem to like.
(defun erc-nicks--gen-color (string)
"Generate normalized RGB color from STRING."
(let* ((ratio (/ (float (abs (random string))) (float most-positive-fixnum)))
(color-num (round (* #xffffffffffff ratio))))
(list (/ (float (logand color-num #xffff)) #xffff)
(/ (float (ash (logand color-num #xffff0000) -16)) #xffff)
(/ (float (ash (logand color-num #xffff00000000) -32)) #xffff))))
;; This doesn't add an entry to the face table because "@" faces are
;; interned in the global `obarray' and thus easily accessible.
(defun erc-nicks--revive (new-face old-face nick net)
(put new-face 'erc-nicks--custom-face t)
(put new-face 'erc-nicks--nick nick)
(put new-face 'erc-nicks--netid erc-networks--id)
(put old-face 'erc-nicks--key nil)
(apply #'custom-declare-face new-face (face-user-default-spec old-face)
(format "Persistent `erc-nicks' color for %s on %s." nick net)
erc-nicks--custom-keywords))
(defun erc-nicks--create-defface-template (face)
(pop-to-buffer (get-buffer-create (format "*New face %s*" face)))
(erase-buffer)
(lisp-interaction-mode)
(insert ";; If you *don't* use Customize, put something like this in your\n"
(substitute-command-keys
";; init.el and use \\[eval-last-sexp] to apply any edits.\n\n")
(format "(defface %s\n '%S\n %S"
face (face-user-default-spec face) (face-documentation face))
(cl-loop for (k v) on erc-nicks--custom-keywords by #'cddr
concat (format "\n %s %S" k (list 'quote v)))
")\n\n;; Or, if you use use-package\n(use-package erc-nicks\n"
" :custom-face\n"
(format " (%s %S)" face (face-user-default-spec face))
")\n"))
(defun erc-nicks--redirect-face-widget-link (args)
(pcase args
(`(,widget face-link . ,plist)
(when-let ((face (widget-value widget))
((get face 'erc-nicks--custom-face)))
(unless (symbol-file face)
(setf (plist-get plist :action)
(lambda (&rest _) (erc-nicks--create-defface-template face))))
(setf (plist-get plist :help-echo) "Create or edit `defface'."
(cddr args) plist))))
args)
(defun erc-nicks--reduce (color)
"Fold adjustment strategies over COLOR, a string or normalized triple.
Return a hex string."
(apply #'color-rgb-to-hex
(seq-reduce (lambda (color strategy) (funcall strategy color))
erc-nicks-color-adjustments
(if (stringp color) (color-name-to-rgb color) color))))
(defun erc-nicks--create-pool (adjustments colors)
"Return COLORS that fall within parameters indicated by ADJUSTMENTS."
(let (addp capp satp pool)
(dolist (adjustment adjustments)
(pcase adjustment
((or 'erc-nicks-invert 'erc-nicks-add-contrast) (setq addp t))
('erc-nicks-cap-contrast (setq capp t))
('erc-nicks-ensaturate (setq satp t))))
(dolist (color colors)
(let* ((rgb (color-name-to-rgb color))
(contrast (and (or addp capp) (erc-nicks--get-contrast rgb))))
(if (or (and addp (< contrast (car erc-nicks-contrast-range)))
(and capp (> contrast (cdr erc-nicks-contrast-range)))
(and-let* ((satp)
(s (cadr (apply #'color-rgb-to-hsl rgb))))
(or (< s (car erc-nicks-saturation-range))
(> s (cdr erc-nicks-saturation-range)))))
(when erc-nicks--colors-rejects
(push color erc-nicks--colors-rejects))
(push color pool))))
(nreverse pool)))
(defun erc-nicks--init-pool ()
"Initialize colors and optionally display faces or color palette."
(unless (eq erc-nicks-colors 'all)
(let* ((colors (or (and (listp erc-nicks-colors) erc-nicks-colors)
(defined-colors)))
(pool (erc-nicks--create-pool erc-nicks-color-adjustments colors)))
(setq erc-nicks--colors-pool pool
erc-nicks--colors-len (length pool)))))
(defun erc-nicks--determine-color (key)
(if (eq erc-nicks-colors 'all)
(erc-nicks--reduce (erc-nicks--gen-color key))
(let ((pool (erc-with-server-buffer erc-nicks--colors-pool))
(len (erc-with-server-buffer erc-nicks--colors-len)))
(nth (% (abs (random key)) len) pool))))
(defun erc-nicks--get-face (nick key)
"Retrieve a face for trimmed and downcased NICK.
If NICK is new, use KEY to derive color, and store under NICK.
Favor a custom erc-nicks-NICK@NETWORK-face when defined."
(let ((table (erc-with-server-buffer erc-nicks--face-table)))
(or (gethash nick table)
(and-let* ((face (intern-soft (concat "erc-nicks-" nick "@"
(erc-network-name) "-face")))
((or (and (facep face) face)
(erc-nicks--revive face face nick (erc-network))))))
(let ((color (erc-nicks--determine-color key))
(new-face (make-symbol (concat "erc-nicks-" nick "-face"))))
(put new-face 'erc-nicks--nick nick)
(put new-face 'erc-nicks--netid erc-networks--id)
(put new-face 'erc-nicks--key key)
(face-spec-set new-face `((t :foreground ,color)) 'face-defface-spec)
(set-face-documentation
new-face (format "Internal face for %s on %s." nick (erc-network)))
(puthash nick new-face table)))))
(define-inline erc-nicks--anon-face-p (face)
(inline-quote (and (consp ,face) (pcase (car ,face)
((pred keywordp) t)
('foreground-color t)
('background-color t)))))
(defun erc-nicks--skip-p (prop option limit)
"Return non-nil if a face in PROP appears in OPTION.
Abandon search after examining LIMIT faces."
(setq prop (if (erc-nicks--anon-face-p prop) (list prop) (ensure-list prop)))
(catch 'found
(while-let (((> limit 0))
(elem (pop prop)))
(while (and (consp elem) (not (erc-nicks--anon-face-p elem)))
(when (cdr elem)
(push (cdr elem) prop))
(setq elem (car elem)))
(when elem
(cl-decf limit)
(when (if (symbolp elem) (memq elem option) (member elem option))
(throw 'found elem))))))
(defun erc-nicks--trim (nickname)
"Return downcased NICKNAME sans trailing `erc-nicks-ignore-chars'."
(erc-downcase
(if erc-nicks-ignore-chars
(string-trim-right nickname
(rx-to-string
`(: (+ (any ,erc-nicks-ignore-chars)) eot)))
nickname)))
(defun erc-nicks--gen-key-from-format-spec (nickname)
"Generate key for NICKNAME according to `erc-nicks-key-suffix-format'."
(concat nickname (format-spec erc-nicks-key-suffix-format
`((?n . ,(erc-network))
(?m . ,(erc-current-nick))))))
(defun erc-nicks--highlight (nickname &optional base-face)
"Return face for NICKNAME unless it or BASE-FACE is blacklisted."
(when-let ((trimmed (erc-nicks--trim nickname))
((not (member trimmed erc-nicks--downcased-skip-nicks)))
((not (and base-face
(erc-nicks--skip-p base-face erc-nicks-skip-faces
erc-nicks--max-skip-search))))
(key (erc-nicks--gen-key-from-format-spec trimmed))
(out (erc-nicks--get-face trimmed key)))
(if (or (null erc-nicks-backing-face)
(eq base-face erc-nicks-backing-face))
out
(cons out (erc-list erc-nicks-backing-face)))))
(defun erc-nicks--highlight-button (nick-object)
"Possibly add face to `erc-button--nick-user' NICK-OBJECT."
(when-let
((nick-object)
(face (get-text-property (car (erc-button--nick-bounds nick-object))
'font-lock-face))
(nick (erc-server-user-nickname (erc-button--nick-user nick-object)))
(out (erc-nicks--highlight nick face)))
(setf (erc-button--nick-nickname-face nick-object) out))
nick-object)
(define-erc-module nicks nil
"Uniquely colorize nicknames in target buffers."
((if erc--target
(progn
(setq erc-nicks--downcased-skip-nicks
(mapcar #'erc-downcase erc-nicks-skip-nicks))
(add-function :filter-return (local 'erc-button--modify-nick-function)
#'erc-nicks--highlight-button '((depth . 80)))
(erc-button--phantom-users-mode +1))
(unless erc-button-mode
(unless (memq 'button erc-modules)
(erc--warn-once-before-connect 'erc-nicks-mode
"Enabling default global module `button' needed by local"
" module `nicks'. This will impact \C-]all\C-] ERC"
" sessions. Add `button' to `erc-modules' to avoid this"
" warning. See Info:\"(erc) Modules\" for more."))
(erc-button-mode +1))
(when (equal erc-nicks-bg-color "unspecified-bg")
(let ((temp (if (eq (erc-nicks--bg-mode) 'light) "white" "black")))
(erc-button--display-error-notice-with-keys
"Module `nicks' unable to determine background color. Setting to \""
temp "\" globally. Please see `erc-nicks-bg-color'.")
(custom-set-variables (list 'erc-nicks-bg-color temp))))
(erc-nicks--init-pool)
(erc--restore-initialize-priors erc-nicks-mode
erc-nicks--face-table (make-hash-table :test #'equal)))
(setq erc-nicks--fg-rgb
(or (color-name-to-rgb
(face-foreground 'erc-default-face nil 'default))
(color-name-to-rgb
(readable-foreground-color erc-nicks-bg-color))))
(setf (alist-get "Edit face" erc-button--nick-popup-alist nil nil #'equal)
#'erc-nicks-customize-face)
(advice-add 'widget-create-child-and-convert :filter-args
#'erc-nicks--redirect-face-widget-link))
((kill-local-variable 'erc-nicks--face-table)
(kill-local-variable 'erc-nicks--bg-mode-value)
(kill-local-variable 'erc-nicks--bg-luminance)
(kill-local-variable 'erc-nicks--fg-rgb)
(kill-local-variable 'erc-nicks--colors-len)
(kill-local-variable 'erc-nicks--colors-pool)
(kill-local-variable 'erc-nicks--downcased-skip-nicks)
(when (fboundp 'erc-button--phantom-users-mode)
(erc-button--phantom-users-mode -1))
(remove-function (local 'erc-button--modify-nick-function)
#'erc-nicks--highlight-button)
(setf (alist-get "Edit face"
erc-button--nick-popup-alist nil 'remove #'equal)
nil)
(unless erc-button--nick-popup-alist
(kill-local-variable 'erc-button--nick-popup-alist)))
'local)
(defun erc-nicks-customize-face (nick)
"Customize or create persistent face for NICK."
(interactive (list (or (car (get-text-property (point) 'erc-data))
(completing-read "nick: " (or erc-channel-users
erc-server-users)))))
(setq nick (erc-nicks--trim (substring-no-properties nick)))
(let* ((net (erc-network))
(key (erc-nicks--gen-key-from-format-spec nick))
(old-face (erc-nicks--get-face nick key))
(new-face (intern (format "erc-nicks-%s@%s-face" nick net))))
(unless (eq new-face old-face)
(erc-nicks--revive new-face old-face nick net)
(set-face-attribute old-face nil :foreground 'unspecified)
(set-face-attribute old-face nil :inherit new-face))
(customize-face new-face)))
(defun erc-nicks--list-faces-help-button-action (face)
(when-let (((or (get face 'erc-nicks--custom-face)
(y-or-n-p (format "Create new persistent face for %s?"
(get face 'erc-nicks--key)))))
(nid (get face 'erc-nicks--netid))
(foundp (lambda ()
(erc-networks--id-equal-p nid erc-networks--id)))
(server-buffer (car (erc-buffer-filter foundp))))
(with-current-buffer server-buffer
(erc-nicks-customize-face (get face 'erc-nicks--nick)))))
(defun erc-nicks-list-faces ()
"Show faces owned by ERC-nicks in a help buffer."
(interactive)
(save-excursion
(list-faces-display (rx bot "erc-nicks-"))
(with-current-buffer "*Faces*"
(setq help-xref-stack nil
help-xref-stack-item '(erc-nicks-list-faces))
(with-silent-modifications
(goto-char (point-min))
(while (zerop (forward-line))
(when (and (get-text-property (point) 'button)
(facep (car (button-get (point) 'help-args))))
(button-put (point) 'help-function
#'erc-nicks--list-faces-help-button-action)
(if-let ((face (car (button-get (point) 'help-args)))
((not (get face 'erc-nicks--custom-face)))
((not (get face 'erc-nicks--key))))
(progn (delete-region (pos-bol) (1+ (pos-eol)))
(forward-line -1))
(when-let ((nid (get face 'erc-nicks--netid))
(net (symbol-name (erc-networks--id-symbol nid))))
(goto-char (button-end (point)))
(skip-syntax-forward "-")
(put-text-property (point) (1+ (point)) 'rear-nonsticky nil)
(forward-char)
(when (stringp (face-foreground face))
(setq net (format "%-13.13s %s" (substring-no-properties
(face-foreground face))
net)))
(insert-and-inherit net)
(delete-region (button-start (point))
(1+ (button-start (point))))
(delete-region (point) (pos-eol))))))))))
(defun erc-nicks-refresh (debug)
"Recompute faces for all nicks on current network.
With DEBUG, review affected faces or colors. Which one depends
on the value of `erc-nicks-colors'."
(interactive "P")
(unless (derived-mode-p 'erc-mode)
(user-error "Not an ERC buffer"))
(erc-with-server-buffer
(unless erc-nicks-mode (user-error "Module `nicks' disabled"))
(let ((erc-nicks--colors-rejects (and debug (list t))))
(erc-nicks--init-pool)
(dolist (nick (hash-table-keys erc-nicks--face-table))
;; User-tuned faces do not have an `erc-nicks--key' property.
(when-let ((face (gethash nick erc-nicks--face-table))
(key (get face 'erc-nicks--key)))
(setq key (erc-nicks--gen-key-from-format-spec nick))
(put face 'erc-nicks--key key)
(set-face-foreground face (erc-nicks--determine-color key))))
(when debug
(if (eq erc-nicks-colors 'all)
(erc-nicks-list-faces)
(pcase-dolist (`(,name ,pool)
`(("*erc-nicks-pool*" ,erc-nicks--colors-pool)
("*erc-nicks-rejects*"
,(cdr (nreverse erc-nicks--colors-rejects)))))
(when (buffer-live-p (get-buffer name))
(kill-buffer name))
(when pool
(save-excursion
(list-colors-display
pool name
(lambda (c)
(message "contrast: %.3f :saturation: %.3f"
(erc-nicks--get-contrast c)
(cadr (apply #'color-rgb-to-hsl
(color-name-to-rgb c))))))))))))))
(provide 'erc-nicks)
;;; erc-nicks.el ends here

287
lisp/erc/erc-speedbar.el
View file

@ -32,20 +32,31 @@
;; update-channel, update-nick, remove-nick-from-channel, ...
;; * Use indicator-strings for op/voice
;; * Extract/convert face notes field from bbdb if available
;; * Write tests that run in a term-mode subprocess
;;
;;; Code:
(require 'erc)
(require 'erc-goodies)
(require 'erc-button)
(require 'speedbar)
(condition-case nil (require 'dframe) (error nil))
;;; Customization:
(defgroup erc-speedbar nil
"Integration of ERC in the Speedbar."
"Speedbar integration for ERC.
To open an ERC-flavored speedbar in a separate frame, run the
command `erc-speedbar-browser'. To use a window-based proxy
instead, run \\[erc-nickbar-mode] in a connected ERC buffer or
put `nickbar' in `erc-modules' before connecting. See Info
node `(speedbar) Top' for more about the underlying integration."
:group 'erc)
(defcustom erc-speedbar-nicknames-window-width 18
"Default width of the nicknames sidebar (in columns)."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type 'integer)
(defcustom erc-speedbar-sort-users-type 'activity
"How channel nicknames are sorted.
@ -56,6 +67,23 @@ nil - Do not sort users"
(const :tag "Sort users alphabetically" alphabetical)
(const :tag "Do not sort users" nil)))
(defcustom erc-speedbar-hide-mode-topic 'headerline
"Hide mode and topic lines."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const :tag "Always show" nil)
(const :tag "Always hide" t)
(const :tag "Omit when headerline visible" headerline)))
(defcustom erc-speedbar-my-nick-face t
"A face to use for your nickname.
When the value is t, ERC uses `erc-current-nick-face' if
`erc-match' has been loaded and `erc-my-nick-face' otherwise.
When using the `nicks' module, you can see your nick as it
appears to others by coordinating with the option
`erc-nicks-skip-faces'."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice face (const :tag "Current nick or own speaker face" t)))
(defvar erc-speedbar-key-map nil
"Keymap used when in erc display mode.")
@ -88,10 +116,6 @@ nil - Do not sort users"
(looking-at "[0-9]+: *.-. "))])
"Additional menu-items to add to speedbar frame.")
;; Make sure our special speedbar major mode is loaded
(with-eval-after-load 'speedbar
(erc-install-speedbar-variables))
;;; ERC hierarchy display method
;;;###autoload
(defun erc-speedbar-browser ()
@ -99,6 +123,7 @@ nil - Do not sort users"
This will add a speedbar major display mode."
(interactive)
(require 'speedbar)
(erc-install-speedbar-variables)
;; Make sure that speedbar is active
(speedbar-frame-mode 1)
;; Now, throw us into Info mode on speedbar.
@ -169,12 +194,18 @@ This will add a speedbar major display mode."
t)))))
(defun erc-speedbar-insert-target (buffer depth)
(if (with-current-buffer buffer
(erc-channel-p (erc-default-target)))
(speedbar-make-tag-line
'bracket ?+ 'erc-speedbar-expand-channel buffer
(buffer-name buffer) 'erc-speedbar-goto-buffer buffer nil
depth)
(if (erc--target-channel-p (buffer-local-value 'erc--target buffer))
(progn
(speedbar-make-tag-line
'bracket ?+ 'erc-speedbar-expand-channel buffer
(erc--target-string (buffer-local-value 'erc--target buffer))
'erc-speedbar-goto-buffer buffer nil
depth)
(save-excursion
(forward-line -1)
(let ((table (buffer-local-value 'erc-channel-users buffer)))
(speedbar-add-indicator (format "(%d)" (hash-table-count table)))
(rx "(" (+ (any "0-9")) ")"))))
;; Query target
(speedbar-make-tag-line
nil nil nil nil
@ -220,6 +251,13 @@ INDENT is the current indentation level."
'angle ?i nil nil
(concat "Topic: " topic) nil nil nil
(1+ indent)))
(unless (pcase erc-speedbar-hide-mode-topic
('nil 'show)
('headerline (null erc-header-line-format)))
(save-excursion
(goto-char (point-max))
(forward-line (if (string= topic "") -1 -2))
(put-text-property (pos-bol) (point-max) 'invisible t)))
(let ((names (cond ((eq erc-speedbar-sort-users-type 'alphabetical)
(erc-sort-channel-users-alphabetically
(with-current-buffer channel
@ -233,17 +271,52 @@ INDENT is the current indentation level."
(when names
(speedbar-with-writable
(dolist (entry names)
(erc-speedbar-insert-user entry ?+ (1+ indent))))))))))
(erc-speedbar-insert-user entry ?+ (1+ indent) channel)))))))))
((string-search "-" text)
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
(speedbar-center-buffer-smartly))
(defun erc-speedbar-insert-user (entry exp-char indent)
(defvar erc-speedbar--nick-face-function #'erc-speedbar--highlight-self-and-ops
"Function called when finding a face for fontifying nicks.
Called with the proposed nick, the `erc-server-user', and the
`erc-channel-user'. Should return any valid face, possibly
composed or anonymous, or nil.")
(defun erc-speedbar--highlight-self-and-ops (buffer user cuser)
"Highlight own nick and op'd users in the speedbar."
(with-current-buffer buffer
(if (erc-current-nick-p (erc-server-user-nickname user))
(pcase erc-speedbar-my-nick-face
('t (if (facep 'erc-current-nick-face)
'erc-current-nick-face
'erc-my-nick-face))
(v v))
;; FIXME overload `erc-channel-user-owner-p' and friends to
;; accept an `erc-channel-user' object and replace this unrolled
;; stuff with a single call to `erc-get-user-mode-prefix'.
(and cuser (or (erc-channel-user-owner cuser)
(erc-channel-user-admin cuser)
(erc-channel-user-op cuser)
(erc-channel-user-halfop cuser)
(erc-channel-user-voice cuser))
erc-button-nickname-face))))
(defun erc-speedbar--on-click (nick sbtoken _indent)
;; 0: finger, 1: name, 2: info, 3: buffer-name
(with-current-buffer (nth 3 sbtoken)
(erc-nick-popup (string-trim-left nick "[~&@%+]+"))))
(defun erc-speedbar-insert-user (entry exp-char indent &optional buffer)
"Insert one user based on the channel member list ENTRY.
EXP-CHAR is the expansion character to use.
INDENT is the current indentation level."
Expect EXP-CHAR to be the expansion character to use, INDENT the
current indentation level, and BUFFER the associated channel or
query buffer. Set the `speedbar-function' text property to
`erc-speedbar--on-click', which is called with the formatted
nick, a so-called \"token\", and the indent level. The token is
a list of four items: the userhost, the GECOS, the current
`erc-server-user' info slot, and the associated buffer."
(let* ((user (car entry))
(cuser (cdr entry))
(nick (erc-server-user-nickname user))
@ -255,11 +328,12 @@ INDENT is the current indentation level."
(op (and cuser (erc-channel-user-op cuser)))
(nick-str (concat (if op "@" "") (if voice "+" "") nick))
(finger (concat login (when (or login host) "@") host))
(sbtoken (list finger name info)))
(sbtoken (list finger name info (buffer-name buffer))))
(if (or login host name info) ; we want to be expandable
(speedbar-make-tag-line
'bracket ?+ 'erc-speedbar-expand-user sbtoken
nick-str nil sbtoken nil
nick-str #'erc-speedbar--on-click sbtoken
(funcall erc-speedbar--nick-face-function buffer user cuser)
indent)
(when (equal exp-char ?-)
(forward-line -1)
@ -357,6 +431,183 @@ The INDENT level is ignored."
(t
(message "%s" txt)))))
;;;; Status-sidebar integration
(defvar erc-track-mode)
(defvar erc-track--switch-fallback-blockers)
(defvar erc-status-sidebar-buffer-name)
(declare-function erc-status-sidebar-set-window-preserve-size
"erc-status-sidebar" nil)
(declare-function erc-status-sidebar-mode--unhook "erc-status-sidebar" nil)
(defvar erc-speedbar--buffer-options
'((speedbar-update-flag . t)
(speedbar-use-images . nil)
(speedbar-hide-button-brackets-flag . t)))
(defvar erc-speedbar--hidden-speedbar-frame nil)
(defun erc-speedbar--emulate-sidebar-set-window-preserve-size ()
(let ((erc-status-sidebar-buffer-name (buffer-name speedbar-buffer))
(display-buffer-overriding-action
`(display-buffer-in-side-window
. ((side . right)
(window-width . ,erc-speedbar-nicknames-window-width)))))
(erc-status-sidebar-set-window-preserve-size)
(when-let ((window (get-buffer-window speedbar-buffer)))
(set-window-parameter window 'no-other-window nil)
(internal-show-cursor window t))))
(defun erc-speedbar--status-sidebar-mode--unhook ()
"Remove hooks installed by `erc-status-sidebar-mode'."
(remove-hook 'window-configuration-change-hook
#'erc-speedbar--emulate-sidebar-set-window-preserve-size))
(defun erc-speedbar--emulate-sidebar ()
(require 'erc-status-sidebar)
(cl-assert speedbar-frame)
(cl-assert (eq speedbar-buffer (current-buffer)))
(cl-assert (eq speedbar-frame (selected-frame)))
(setq erc-speedbar--hidden-speedbar-frame speedbar-frame
dframe-controlled #'erc-speedbar--dframe-controlled)
(add-hook 'window-configuration-change-hook
#'erc-speedbar--emulate-sidebar-set-window-preserve-size nil t)
(add-hook 'kill-buffer-hook
#'erc-speedbar--status-sidebar-mode--unhook nil t)
(with-current-buffer speedbar-buffer
(pcase-dolist (`(,var . ,val) erc-speedbar--buffer-options)
(set (make-local-variable var) val)))
(when (memq 'nicks erc-modules)
(with-current-buffer speedbar-buffer
(add-function :around (local 'erc-speedbar--nick-face-function)
#'erc-speedbar--compose-nicks-face))))
(defun erc-speedbar--toggle-nicknames-sidebar (arg)
(let ((force (numberp arg)))
(if speedbar-buffer
(progn
(cl-assert (buffer-live-p speedbar-buffer))
(if (or (and force (< arg 0))
(and (not force) (get-buffer-window speedbar-buffer nil)))
(erc-speedbar-close-nicknames-window nil)
(when (or (not force) (>= arg 0))
(with-selected-frame speedbar-frame
(erc-speedbar--emulate-sidebar-set-window-preserve-size)))))
(when (or (not force) (>= arg 0))
(let ((speedbar-frame-parameters (backquote-list*
'(visibility . nil)
'(no-other-frame . t)
speedbar-frame-parameters))
(speedbar-after-create-hook #'erc-speedbar--emulate-sidebar))
(erc-speedbar-browser)
;; If we put the remaining parts in the "create hook" along
;; with everything else, the frame with `window-main-window'
;; gets raised and steals focus if you've switched away from
;; Emacs in the meantime.
(make-frame-invisible speedbar-frame)
(select-frame (setq speedbar-frame (previous-frame)))
(erc-speedbar--emulate-sidebar-set-window-preserve-size))))))
(defun erc-speedbar--ensure (&optional force)
(when (or (erc-server-buffer) force)
(when erc-track-mode
(cl-pushnew '(derived-mode . speedbar-mode)
erc-track--switch-fallback-blockers :test #'equal))
(erc-speedbar--toggle-nicknames-sidebar +1)
(speedbar-enable-update)))
;;;###autoload(autoload 'erc-nickbar-mode "erc-speedbar" nil t)
(define-erc-module nickbar nil
"Show nicknames in a side window.
When enabling, create a speedbar session if one doesn't exist and
show its buffer in an `erc-status-sidebar' window instead of a
separate frame. When disabling, close the window or, with a
negative prefix arg, destroy the session.
WARNING: this module may produce unwanted side effects, like the
raising of frames or the stealing of input focus. If you witness
such an occurrence, and can reproduce it, please file a bug
report with \\[erc-bug]."
((add-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure)
(erc-speedbar--ensure)
(unless (or erc--updating-modules-p
(and-let* ((speedbar-buffer)
(win (get-buffer-window speedbar-buffer 'all-frames))
((eq speedbar-frame (window-frame win))))))
(if speedbar-buffer
(erc-speedbar--ensure 'force)
(setq erc-nickbar-mode nil)
(when (derived-mode-p 'erc-mode)
(erc-error "Not initializing `erc-nickbar-mode' in %s"
(current-buffer))))))
((remove-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure)
(speedbar-disable-update)
(when erc-track-mode
(setq erc-track--switch-fallback-blockers
(remove '(derived-mode . speedbar-mode)
erc-track--switch-fallback-blockers)))
(erc-speedbar--toggle-nicknames-sidebar -1)
(when-let ((arg erc--module-toggle-prefix-arg)
((numberp arg))
((< arg 0)))
(erc-speedbar-close-nicknames-window 'kill))))
(defun erc-speedbar--dframe-controlled (arg)
(when (and erc-speedbar--hidden-speedbar-frame (numberp arg) (< arg 0))
(when erc-nickbar-mode
(erc-nickbar-mode -1))
(setq speedbar-frame erc-speedbar--hidden-speedbar-frame
erc-speedbar--hidden-speedbar-frame nil)
;; It's unknown whether leaving the frame invisible interferes
;; with the upstream teardown procedure.
(when (display-graphic-p)
(make-frame-visible speedbar-frame))
(speedbar-frame-mode arg)
(when speedbar-buffer
(kill-buffer speedbar-buffer)
(setq speedbar-buffer nil))))
(defun erc-speedbar-toggle-nicknames-window-lock ()
"Toggle whether nicknames window is selectable with \\[other-window]."
(interactive)
(unless erc-nickbar-mode
(user-error "`erc-nickbar-mode' inactive"))
(when-let ((window (get-buffer-window speedbar-buffer)))
(let ((val (window-parameter window 'no-other-window)))
(set-window-parameter window 'no-other-window (not val))
(message "nick-window: %s" (if val "selectable" "protected")))))
(defun erc-speedbar-close-nicknames-window (kill)
(interactive "P")
(if kill
(with-current-buffer speedbar-buffer
(dframe-close-frame)
(cl-assert (not erc-nickbar-mode))
(setq erc-speedbar--hidden-speedbar-frame nil))
(dolist (window (get-buffer-window-list speedbar-buffer nil t))
(unless (frame-root-window-p window)
(when erc-speedbar--hidden-speedbar-frame
(cl-assert (not (eq (window-frame window)
erc-speedbar--hidden-speedbar-frame))))
(delete-window window)))))
;;;; Nicks integration
(declare-function erc-nicks--highlight "erc-nicks" (nickname &optional face))
(defun erc-speedbar--compose-nicks-face (orig buffer user cuser)
(require 'erc-nicks)
(let ((rv (funcall orig buffer user cuser)))
(if-let ((nick (erc-server-user-nickname user))
(face (with-current-buffer buffer
(erc-nicks--highlight nick rv)))
((not (eq face erc-button-nickname-face))))
(cons face (ensure-list rv))
rv)))
(provide 'erc-speedbar)
;;; erc-speedbar.el ends here
;;

21
lisp/erc/erc-stamp.el
View file

@ -179,6 +179,12 @@ from entering them and instead jump over them."
(kill-local-variable 'erc-timestamp-last-inserted-left)
(kill-local-variable 'erc-timestamp-last-inserted-right))))
(defvar erc-stamp--invisible-property nil
"Existing `invisible' property value and/or symbol `timestamp'.")
(defvar erc-stamp--skip-when-invisible nil
"Escape hatch for omitting stamps when first char is invisible.")
(defun erc-stamp--recover-on-reconnect ()
(when-let ((priors (or erc--server-reconnecting erc--target-priors)))
(dolist (var '(erc-timestamp-last-inserted
@ -209,8 +215,11 @@ or `erc-send-modify-hook'."
(progn ; remove this `progn' on next major refactor
(let* ((ct (erc-stamp--current-time))
(invisible (get-text-property (point-min) 'invisible))
(erc-stamp--invisible-property
;; FIXME on major version bump, make this `erc-' prefixed.
(if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp))
(erc-stamp--current-time ct))
(unless invisible
(unless (setq invisible (and erc-stamp--skip-when-invisible invisible))
(funcall erc-insert-timestamp-function
(erc-format-timestamp ct erc-timestamp-format)))
;; FIXME this will error when advice has been applied.
@ -380,7 +389,7 @@ message text so that stamps will be visible when yanked."
(s (if ignore-p (make-string len ? ) string)))
(unless ignore-p (setq erc-timestamp-last-inserted string))
(erc-put-text-property 0 len 'field 'erc-timestamp s)
(erc-put-text-property 0 len 'invisible 'timestamp s)
(erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s)
(insert s)))
(defun erc-insert-aligned (string pos)
@ -428,6 +437,7 @@ printed just after each line's text (no alignment)."
(goto-char (point-max))
(forward-char -1) ; before the last newline
(let* ((str-width (string-width string))
(buffer-invisibility-spec nil) ; `current-column' > 0
window ; used in computation of `pos' only
(pos (cond
(erc-timestamp-right-column erc-timestamp-right-column)
@ -477,6 +487,8 @@ printed just after each line's text (no alignment)."
(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)
(erc-put-text-property from (point) 'invisible
erc-stamp--invisible-property)
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
@ -520,9 +532,8 @@ Return the empty string if FORMAT is nil."
(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)
(erc-put-text-property 0 (length ts)
'isearch-open-invisible 'timestamp ts)
(erc-put-text-property 0 (length ts) 'invisible
erc-stamp--invisible-property ts)
;; N.B. Later use categories instead of this harmless, but
;; inelegant, hack. -- BPT
(and erc-timestamp-intangible

329
lisp/erc/erc-status-sidebar.el
View file

@ -45,6 +45,13 @@
;; Use M-x erc-status-sidebar-kill RET to kill the sidebar buffer and
;; close the sidebar on all frames.
;; In addition to the commands above, you can also try the all-in-one,
;; "DWIM" command, `erc-bufbar-mode'. See its doc string for usage.
;; If you want the status sidebar enabled whenever you use ERC, add
;; `bufbar' to `erc-modules'. Note that this library also has a major
;; mode, `erc-status-sidebar-mode', which is for internal use.
;;; Code:
(require 'erc)
@ -53,8 +60,15 @@
(require 'seq)
(defgroup erc-status-sidebar nil
"A sidebar for ERC channel status."
:group 'convenience)
"A responsive side window listing all connected ERC buffers.
More commonly known as a window list or \"buflist\", this side
panel displays clickable buffer names for switching to with the
mouse. By default, ERC highlights the name corresponding to the
selected window's buffer, if any. In this context, \"connected\"
just means associated with the same IRC session, even one that
has ceased communicating with its server. For information on how
the window itself works, see Info node `(elisp) Side Windows'."
:group 'erc)
(defcustom erc-status-sidebar-buffer-name "*ERC Status*"
"Name of the sidebar buffer."
@ -80,9 +94,78 @@
(defcustom erc-status-sidebar-channel-format
'erc-status-sidebar-default-chan-format
"Function used to format channel names for display in the sidebar."
"Function used to format channel names for display in the sidebar.
Only consulted for certain values of `erc-status-sidebar-style'."
:type 'function)
(defcustom erc-status-sidebar-highlight-active-buffer t
"Whether to highlight the selected window's buffer in the sidebar.
ERC uses the same instance across all frames. May not be
compatible with all values of `erc-status-sidebar-style'."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type 'boolean)
(defcustom erc-status-sidebar-style 'all-queries-first
"Preset style for rendering the sidebar.
When set to `channels-only', ERC limits the items in the
status bar to uniquified channels. It uses the options
and functions
`erc-channel-list',
`erc-status-sidebar-channel-sort',
`erc-status-sidebar-get-channame',
`erc-status-sidebar-channel-format'
`erc-status-sidebar-default-insert'
for selecting, formatting, naming, and inserting entries. When
set to one of the various `all-*' values, such as `all-mixed',
ERC shows channels and queries under their respective server
buffers, using the functions
`erc-status-sidebar-all-target-buffers',
`erc-status-sidebar-default-allsort',
`erc-status-sidebar-prefer-target-as-name',
`erc-status-sidebar-default-chan-format',
`erc-status-sidebar-pad-hierarchy'
for the above-mentioned purposes. ERC also accepts a list of
functions to preform these roles a la carte. See doc strings for
a description of their expected arguments and return values."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const channels-only)
(const all-mixed)
(const all-queries-first)
(const all-channels-first)
(list (function :tag "Buffer lister")
(function :tag "Buffer sorter")
(function :tag "Name extractor")
(function :tag "Name formatter")
(function :tag "Name inserter"))))
(defcustom erc-status-sidebar-click-display-action t
"How to display a buffer when clicked.
Values can be anything recognized by `display-buffer' for its
ACTION parameter."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const :tag "Always use/create other window" t)
(const :tag "Let `display-buffer' decide" nil)
(const :tag "Same window" (display-buffer-same-window
(inhibit-same-window . nil)))
(cons :tag "Action"
(choice function (repeat function))
(alist :tag "Action arguments"
:key-type symbol
:value-type (sexp :tag "Value")))))
(defcustom erc-status-sidebar-singular t
"Whether to show the sidebar on all frames or just one (default)."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type 'boolean)
(defvar hl-line-mode)
(declare-function hl-line-highlight "hl-line" nil)
(defun erc-status-sidebar-display-window ()
"Display the status buffer in a side window. Return the new window."
(display-buffer
@ -94,7 +177,8 @@
"Return the created/existing window displaying the status buffer.
If NO-CREATION is non-nil, the window is not created."
(let ((sidebar-window (get-buffer-window erc-status-sidebar-buffer-name)))
(let ((sidebar-window (get-buffer-window erc-status-sidebar-buffer-name
erc-status-sidebar-singular)))
(unless (or sidebar-window no-creation)
(with-current-buffer (erc-status-sidebar-get-buffer)
(setq-local vertical-scroll-bar nil))
@ -144,22 +228,51 @@ containing it on the current frame is closed. See
"Open or create a sidebar."
(interactive)
(save-excursion
(let ((sidebar-exists (erc-status-sidebar-buffer-exists-p))
(sidebar-buffer (erc-status-sidebar-get-buffer))
;; (sidebar-window (erc-status-sidebar-get-window))
)
(unless sidebar-exists
(with-current-buffer sidebar-buffer
(erc-status-sidebar-mode)
(erc-status-sidebar-refresh))))))
(if (erc-status-sidebar-buffer-exists-p)
(erc-status-sidebar-get-window)
(with-current-buffer (erc-status-sidebar-get-buffer)
(erc-status-sidebar-mode)
(erc-status-sidebar-refresh)))))
;;;###autoload(autoload 'erc-bufbar-mode "erc-status-sidebar" nil t)
(define-erc-module bufbar nil
"Show `erc-track'-like activity in a side window.
When enabling, show the sidebar immediately if called from a
connected ERC buffer. Otherwise, arrange for doing so on connect
or whenever next displaying a new ERC buffer. When disabling,
hide the status window if it's showing. With a negative prefix
arg, also shutdown the session."
((unless erc-track-mode
(unless (memq 'track erc-modules)
(erc--warn-once-before-connect 'erc-bufbar-mode
"Module `bufbar' needs global module `track'. Enabling now."
" This will affect \C-]all\C-] ERC sessions."
" Add `track' to `erc-modules' to silence this message."))
(erc-track-mode +1))
(add-hook 'erc--setup-buffer-hook #'erc-status-sidebar-open)
(unless erc--updating-modules-p
(if (erc-with-server-buffer erc-server-connected)
(erc-status-sidebar-open)
(setq erc-bufbar-mode nil)
(when (derived-mode-p 'erc-mode)
(erc-error "Not initializing `erc-bufbar-mode' in %s"
(current-buffer))))))
((remove-hook 'erc--setup-buffer-hook #'erc-status-sidebar-open)
(erc-status-sidebar-close erc-status-sidebar-singular)
(when-let ((arg erc--module-toggle-prefix-arg)
((numberp arg))
((< arg 0)))
(erc-status-sidebar-kill))))
;;;###autoload
(defun erc-status-sidebar-toggle ()
"Toggle the sidebar open/closed on the current frame."
"Toggle the sidebar open/closed on the current frame.
Do this regardless of `erc-status-sidebar-singular'."
(interactive)
(if (get-buffer-window erc-status-sidebar-buffer-name nil)
(erc-status-sidebar-close)
(erc-status-sidebar-open)))
(let (erc-status-sidebar-singular)
(erc-status-sidebar-open))))
(defun erc-status-sidebar-get-channame (buffer)
"Return name of BUFFER with all leading \"#\" characters removed."
@ -174,6 +287,98 @@ containing it on the current frame is closed. See
(string< (erc-status-sidebar-get-channame x)
(erc-status-sidebar-get-channame y)))))
(defvar erc-status-sidebar--trimpat nil)
(defvar erc-status-sidebar--prechan nil)
(defun erc-status-sidebar-prefer-target-as-name (buffer)
"Return some name to represent buffer in the sidebar."
(if-let ((target (buffer-local-value 'erc--target buffer)))
(cond ((and erc-status-sidebar--trimpat (erc--target-channel-p target))
(string-trim-left (erc--target-string target)
erc-status-sidebar--trimpat))
((and erc-status-sidebar--prechan (erc--target-channel-p target))
(concat erc-status-sidebar--prechan
(erc--target-string target)))
(t (erc--target-string target)))
(buffer-name buffer)))
;; This could be converted into an option if people want.
(defvar erc-status-sidebar--show-disconnected t)
(defun erc-status-sidebar-all-target-buffers (process)
(erc-buffer-filter (lambda ()
(and erc--target
(or erc-status-sidebar--show-disconnected
(erc-server-process-alive))))
process))
;; FIXME profile this. Rebuilding the graph every time track updates
;; seems wasteful for occasions where server messages are processed
;; unthrottled, such as during history playback. If it's a problem,
;; we should look into rewriting this using `ewoc' or some other
;; solution that maintains a persistent model.
(defun erc-status-sidebar-default-allsort (target-buffers)
"Return a list of servers interspersed with their targets."
(mapcan (pcase-lambda (`(,proc . ,chans))
(cons (process-buffer proc)
(let ((erc-status-sidebar--trimpat
(and (eq erc-status-sidebar-style 'all-mixed)
(with-current-buffer (process-buffer proc)
(when-let ((ch-pfxs (erc--get-isupport-entry
'CHANTYPES 'single)))
(regexp-quote ch-pfxs)))))
(erc-status-sidebar--prechan
(and (eq erc-status-sidebar-style
'all-queries-first)
"\C-?")))
(sort chans
(lambda (x y)
(string<
(erc-status-sidebar-prefer-target-as-name x)
(erc-status-sidebar-prefer-target-as-name y)))))))
(sort (seq-group-by (lambda (b)
(buffer-local-value 'erc-server-process b))
target-buffers)
(lambda (a b)
(string< (buffer-name (process-buffer (car a)))
(buffer-name (process-buffer (car b))))))))
(defvar-local erc-status-sidebar--active-marker nil
"Marker indicating currently active buffer.")
(defun erc-status-sidebar--set-active-line (erc-buffer)
(when (and erc-status-sidebar-highlight-active-buffer
(eq (window-buffer (and (minibuffer-window-active-p
(selected-window))
(minibuffer-selected-window)))
erc-buffer))
(set-marker erc-status-sidebar--active-marker (point))))
(defun erc-status-sidebar-default-insert (channame chanbuf _chanlist)
"Insert CHANNAME followed by a newline.
Maybe arrange to highlight line if CHANBUF is showing in the
focused window."
(erc-status-sidebar--set-active-line chanbuf)
(insert channame "\n"))
(defun erc-status-sidebar-pad-hierarchy (bufname buffer buflist)
"Prefix BUFNAME to emphasize BUFFER's role in BUFLIST."
(if (and (buffer-live-p buffer) (buffer-local-value 'erc--target buffer))
(insert " ")
(unless (eq buffer (car buflist))
(insert "\n"))) ; ^L
(when bufname
(erc-status-sidebar--set-active-line buffer))
(insert (or bufname
(and-let* (((not (buffer-live-p buffer)))
(next (cadr (member buffer buflist)))
((buffer-live-p next))
(proc (buffer-local-value 'erc-server-process next))
(id (process-get proc 'erc-networks--id)))
(symbol-name (erc-networks--id-symbol id)))
"???")
"\n"))
(defun erc-status-sidebar-default-chan-format (channame
&optional num-messages erc-face)
"Format CHANNAME for display in the sidebar.
@ -193,43 +398,111 @@ name stand out."
(defun erc-status-sidebar-refresh ()
"Update the content of the sidebar."
(interactive)
(let ((chanlist (apply erc-status-sidebar-channel-sort
(erc-channel-list nil) nil)))
(pcase-let* ((`(,list-fn ,sort-fn ,name-fn ,fmt-fn ,insert-fn)
(pcase erc-status-sidebar-style
('channels-only (list #'erc-channel-list
erc-status-sidebar-channel-sort
#'erc-status-sidebar-get-channame
erc-status-sidebar-channel-format
#'erc-status-sidebar-default-insert))
((or 'all-mixed 'all-queries-first 'all-channels-first)
'(erc-status-sidebar-all-target-buffers
erc-status-sidebar-default-allsort
erc-status-sidebar-prefer-target-as-name
erc-status-sidebar-default-chan-format
erc-status-sidebar-pad-hierarchy))
(v v)))
(chanlist (apply sort-fn (funcall list-fn nil) nil))
(window nil)
(winstart nil))
(with-current-buffer (erc-status-sidebar-get-buffer)
(setq window (get-buffer-window nil erc-status-sidebar-singular)
winstart (and window (window-start window)))
(erc-status-sidebar-writable
(delete-region (point-min) (point-max))
(goto-char (point-min))
(if erc-status-sidebar--active-marker
(set-marker erc-status-sidebar--active-marker nil)
(setq erc-status-sidebar--active-marker (make-marker)))
(dolist (chanbuf chanlist)
(let* ((tup (seq-find (lambda (tup) (eq (car tup) chanbuf))
erc-modified-channels-alist))
(count (if tup (cadr tup)))
(face (if tup (cddr tup)))
(channame (apply erc-status-sidebar-channel-format
(buffer-name chanbuf) count face nil))
(face (if (or (not (buffer-live-p chanbuf))
(not (erc-server-process-alive chanbuf)))
`(shadow ,face)
face))
(channame (apply fmt-fn
(copy-sequence (funcall name-fn chanbuf))
count face nil))
(cnlen (length channame)))
(put-text-property 0 cnlen 'erc-buf chanbuf channame)
(put-text-property 0 cnlen 'mouse-face 'highlight channame)
(put-text-property
0 cnlen 'help-echo
"mouse-1: switch to buffer in other window" channame)
(insert channame "\n")))))))
(funcall insert-fn channame chanbuf chanlist)))
(when winstart
(set-window-point window winstart)
(with-selected-window window (recenter 0)))
(when (and erc-status-sidebar-highlight-active-buffer
(marker-buffer erc-status-sidebar--active-marker))
(goto-char erc-status-sidebar--active-marker)
(require 'hl-line)
(unless hl-line-mode (hl-line-mode +1))
(hl-line-highlight))))))
(defun erc-status-sidebar-kill ()
"Close the ERC status sidebar and its buffer."
(interactive)
(when (and erc-bufbar-mode (not erc--module-toggle-prefix-arg))
(erc-bufbar-mode -1))
(ignore-errors (kill-buffer erc-status-sidebar-buffer-name)))
(defun erc-status-sidebar-click (event)
"Handle click EVENT in `erc-status-sidebar-mode-map'."
(interactive "e")
(save-excursion
(let ((window (posn-window (event-end event)))
(let ((window (posn-window (event-start event)))
(pos (posn-point (event-end event))))
(set-buffer (window-buffer window))
(let ((buf (get-text-property pos 'erc-buf)))
(when buf
(select-window window)
(switch-to-buffer-other-window buf))))))
;; Current buffer is "ERC Status" and its window is selected
(cl-assert (eq major-mode 'erc-status-sidebar-mode))
(cl-assert (eq (selected-window) window))
(cl-assert (eq (window-buffer window) (current-buffer)))
(when-let ((buf (get-text-property pos 'erc-buf)))
;; Option operates relative to last selected window
(select-window (get-mru-window nil nil 'not-selected))
(pop-to-buffer buf erc-status-sidebar-click-display-action)))))
(defun erc-status-sidebar-scroll-up (lines)
"Scroll sidebar buffer's content LINES linse upward.
If LINES is nil, scroll up a full screen's worth."
(interactive "P")
(let ((other-window-scroll-buffer (erc-status-sidebar-get-buffer)))
(scroll-other-window lines)))
(defun erc-status-sidebar-scroll-down (lines)
"Scroll sidebar buffer's content LINES lines downward.
If LINES is nil, scroll down a full screen's worth."
(interactive "P")
(let ((other-window-scroll-buffer (erc-status-sidebar-get-buffer)))
(scroll-other-window-down lines)))
(defun erc-status-sidebar-recenter (arg)
"Recenter the status sidebar.
Expect `erc-status-sidebar-highlight-active-buffer' to be non-nil
and to be invoked in a buffer matching the line currently
highlighted."
(interactive "P")
(let* ((buf (erc-status-sidebar-get-buffer))
(win (get-buffer-window buf)))
(with-current-buffer buf
(when (and erc-status-sidebar--active-marker
(marker-position erc-status-sidebar--active-marker))
(with-selected-window win
(goto-char erc-status-sidebar--active-marker)
(recenter arg t))))))
(defvar erc-status-sidebar-mode-map
(let ((map (make-sparse-keymap)))
@ -268,13 +541,17 @@ hooks that invoke it with arguments."
Note that preserve status needs to be reset when the window is
manually resized, so `erc-status-sidebar-mode' adds this function
to the `window-configuration-change-hook'."
(when (and (eq (selected-window) (erc-status-sidebar-get-window))
(when (and (eq (selected-window) (let (erc-status-sidebar-singular)
(erc-status-sidebar-get-window)))
(fboundp 'window-preserve-size))
(unless (eq (window-total-width) (window-min-size nil t))
(apply #'window-preserve-size (selected-window) t t nil))))
(define-derived-mode erc-status-sidebar-mode special-mode "ERC Sidebar"
"Major mode for ERC status sidebar."
;; Users invoking M-x erc-status-sidebar-mode most likely expect to
;; summon the module's minor-mode, `erc-bufbar-mode'.
:interactive nil
;; Don't scroll the buffer horizontally, if a channel name is
;; obscured then the window can be resized.
(setq-local auto-hscroll-mode nil)

30
lisp/erc/erc-track.el
View file

@ -184,9 +184,13 @@ The faces used are the same as used for text in the buffers.
erc-prompt-face)
"A list of faces used to highlight active buffer names in the mode line.
If a message contains one of the faces in this list, the buffer name will
be highlighted using that face. The first matching face is used."
:type '(repeat (choice face
(repeat :tag "Combination" face))))
be highlighted using that face. The first matching face is used.
Note that ERC prioritizes certain faces reserved for critical
messages regardless of this option's value."
:type (erc--with-dependent-type-match
(repeat (choice face (repeat :tag "Combination" face)))
erc-button))
(defcustom erc-track-priority-faces-only nil
"Only track text highlighted with a priority face.
@ -309,6 +313,8 @@ important."
(const leastactive)
(const mostactive)))
(defconst erc-track--attn-faces '((erc-error-face erc-notice-face))
"Faces whose presence always triggers mode-line inclusion.")
(defun erc-track-remove-from-mode-line ()
"Remove `erc-track-modified-channels' from the mode-line."
@ -736,6 +742,9 @@ Use `erc-make-mode-line-buffer-name' to create buttons."
(declare (obsolete erc-track-select-mode-line-face "28.1"))
(erc-track-select-mode-line-face (car faces) (cdr faces)))
;; Note that unless called by `erc-track-modified-channels',
;; `erc-track-faces-priority-list' will not begin with
;; `erc-track--attn-faces'.
(defun erc-track-select-mode-line-face (cur-face new-faces)
"Return the face to use in the mode line.
@ -802,7 +811,9 @@ the current buffer is in `erc-mode'."
;; (in the car), change its face attribute (in the cddr) if
;; necessary. See `erc-modified-channels-alist' for the
;; exact data structure used.
(let ((faces (erc-faces-in (buffer-string))))
(let ((faces (erc-faces-in (buffer-string)))
(erc-track-faces-priority-list
`(,@erc-track--attn-faces ,@erc-track-faces-priority-list)))
(unless (and
(or (eq erc-track-priority-faces-only 'all)
(member this-channel erc-track-priority-faces-only))
@ -873,7 +884,7 @@ If face is not in `erc-track-faces-priority-list', it will have a
higher number than any other face in that list."
(let ((count 0))
(catch 'done
(dolist (item erc-track-faces-priority-list)
(dolist (item `(,@erc-track--attn-faces ,@erc-track-faces-priority-list))
(if (equal item face)
(throw 'done t)
(setq count (1+ count)))))
@ -912,13 +923,20 @@ is relative to `erc-track-switch-direction'."
(setq offset 0)))
(car (nth offset erc-modified-channels-alist))))
(defvar erc-track--switch-fallback-blockers '((derived-mode . erc-mode))
"List of `buffer-match-p' conditions OR'd together.
ERC sets `erc-track-last-non-erc-buffer' to the current buffer
unless any passes.")
(defun erc-track--switch-buffer (fun arg)
(if (not erc-track-mode)
(message (concat "Enable the ERC track module if you want to use the"
" tracking minor mode"))
(cond (erc-modified-channels-alist
;; if we're not in erc-mode, set this buffer to return to
(unless (eq major-mode 'erc-mode)
(unless (buffer-match-p (cons 'or
erc-track--switch-fallback-blockers)
(current-buffer))
(setq erc-track-last-non-erc-buffer (current-buffer)))
;; and jump to the next active channel
(if-let ((buf (erc-track-get-active-buffer arg))

360
lisp/erc/erc.el
View file

@ -1302,13 +1302,18 @@ See the variable `erc-command-indicator'."
(defface erc-notice-face
'((default :weight bold)
(((class color) (min-colors 88) (supports :weight semi-bold))
:weight semi-bold :foreground "SlateBlue")
(((class color) (min-colors 88)) :foreground "SlateBlue")
(t :foreground "blue"))
"ERC face for notices."
:package-version '(ERC . "5.6") ; FIXME sync on release
:group 'erc-faces)
(defface erc-action-face '((t :weight bold))
(defface erc-action-face '((((supports :weight semi-bold)) :weight semi-bold)
(t :weight bold))
"ERC face for actions generated by /ME."
:package-version '(ERC . "5.6") ; FIXME sync on release
:group 'erc-faces)
(defface erc-error-face '((t :foreground "red"))
@ -1548,9 +1553,26 @@ Defaults to the server buffer."
"IRC port to use for encrypted connections if it cannot be \
detected otherwise.")
(defconst erc--buffer-display-choices
`(choice (const :tag "Use value of `erc-buffer-display'" nil)
(const :tag "Split window and select" window)
(const :tag "Split window but don't select" window-noselect)
(const :tag "New frame" frame)
(const :tag "Don't display" bury)
(const :tag "Use current window" buffer)
(choice :tag "Defer to a display function"
(function-item display-buffer)
(function-item pop-to-buffer)
(function :tag "User-defined")))
"Common choices for buffer-display options.")
(defvaralias 'erc-join-buffer 'erc-buffer-display)
(defcustom erc-buffer-display 'bury
"How to display a newly created ERC buffer.
This determines ERC's baseline, \"catch-all\" buffer-display
behavior. It takes a backseat to more specific options, like
`erc-interactive-display', `erc-auto-reconnect-display', and
`erc-receive-query-display'.
The available choices are:
@ -1559,17 +1581,34 @@ The available choices are:
`frame' - in another frame,
`bury' - bury it in a new buffer,
`buffer' - in place of the current buffer,
DISPLAY-FUNCTION - a `display-buffer'-like function
See related options `erc-interactive-display',
`erc-reconnect-display', and `erc-receive-query-display'."
Here, DISPLAY-FUNCTION should accept a buffer and an ACTION of
the kind described by the Info node `(elisp) Choosing Window'.
At times, ERC may add hints about the calling context to the
ACTION's alist. Keys are symbols such as user options, like
`erc-buffer-display', or module minor modes, like
`erc-autojoin-mode'. Values are non-nil constants specific to
each. For this particular option, possible values include the
symbols
`JOIN', `PRIVMSG', `NOTICE', `erc', and `erc-tls'.
The first three signify IRC commands received from the server and
the rest entry-point commands responsible for the connection.
When dealing with the latter two, users may prefer to set this
option to `bury' and instead call DISPLAY-FUNCTION directly
on (server) buffers returned by these entry points because the
context leading to their creation is plainly obvious. For
additional details, see the Info node `(erc) display-buffer'.
Note that when the selected window already shows the current
buffer, ERC pretends this option's value is `bury' unless the
variable `erc-skip-displaying-selected-window-buffer' is nil or
the value of this option is DISPLAY-FUNCTION."
:package-version '(ERC . "5.5")
:group 'erc-buffers
:type '(choice (const :tag "Split window and select" window)
(const :tag "Split window, don't select" window-noselect)
(const :tag "New frame" frame)
(const :tag "Bury in new buffer" bury)
(const :tag "Use current buffer" buffer)
(const :tag "Use current buffer" t)))
:type (cons 'choice (nthcdr 2 erc--buffer-display-choices)))
(defvaralias 'erc-query-display 'erc-interactive-display)
(defcustom erc-interactive-display 'window
@ -1578,38 +1617,58 @@ This affects commands like /QUERY and /JOIN when issued
interactively at the prompt. It does not apply when calling a
handler for such a command, like `erc-cmd-JOIN', from lisp code.
See `erc-buffer-display' for a full description of available
values."
values.
When the value is a user-provided function, ERC may inject a hint
about the invocation context as an extra item in the \"action
alist\" included as part of the second argument. The item's key
is the symbol `erc-interactive-display' and its value one of
`/QUERY', `/JOIN', `/RECONNECT', `url', `erc', or `erc-tls'.
All are symbols indicating an inciting user action, such as the
issuance of a slash command, the clicking of a URL hyperlink, or
the invocation of an entry-point command. See Info node `(erc)
display-buffer' for more."
:package-version '(ERC . "5.6") ; FIXME sync on release
:group 'erc-buffers
:type '(choice (const :tag "Use value of `erc-buffer-display'" nil)
(const :tag "Split window and select" window)
(const :tag "Split window, don't select" window-noselect)
(const :tag "New frame" frame)
(const :tag "Bury new and don't display existing" bury)
(const :tag "Use current buffer" buffer)))
:type erc--buffer-display-choices)
(defcustom erc-reconnect-display nil
"How and whether to display a channel buffer when auto-reconnecting.
This only affects automatic reconnections and is ignored, like
all other buffer-display options, when issuing a /RECONNECT or
successfully reinvoking `erc-tls' with similar arguments. See
`erc-buffer-display' for a description of possible values."
(defvaralias 'erc-reconnect-display 'erc-auto-reconnect-display)
(defcustom erc-auto-reconnect-display nil
"How to display a channel buffer when automatically reconnecting.
ERC ignores this option when a user issues a /RECONNECT or
successfully reinvokes `erc-tls' with similar arguments to those
from the prior connection. See `erc-buffer-display' for a
description of possible values.
When the value is function, ERC may inject a hint about the
calling context as an extra item in the alist making up the tail
of the second, \"action\" argument. The item's key is the symbol
`erc-auto-reconnect-display' and its value something non-nil."
:package-version '(ERC . "5.5")
:group 'erc-buffers
:type '(choice (const :tag "Use value of `erc-buffer-display'" nil)
(const :tag "Split window and select" window)
(const :tag "Split window, don't select" window-noselect)
(const :tag "New frame" frame)
(const :tag "Bury in new buffer" bury)
(const :tag "Use current buffer" buffer)))
:type erc--buffer-display-choices)
(defcustom erc-reconnect-display-timeout 10
"Duration `erc-reconnect-display' remains active.
(defcustom erc-auto-reconnect-display-timeout 10
"Duration `erc-auto-reconnect-display' remains active.
The countdown starts on MOTD and is canceled early by any
\"slash\" command."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type 'integer
:group 'erc-buffers)
(defcustom erc-reconnect-display-server-buffers nil
"Apply buffer-display options to server buffers when reconnecting.
By default, ERC does not consider `erc-auto-reconnect-display'
for server buffers when automatically reconnecting, nor does it
consider `erc-interactive-display' when users issue a /RECONNECT.
Enabling this tells ERC to always display server buffers
according to those options."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type 'boolean
:group 'erc-buffers)
(defcustom erc-frame-alist nil
"Alist of frame parameters for creating erc frames.
A value of nil means to use `default-frame-alist'."
@ -1819,9 +1878,8 @@ server connection, or nil which means all open connections."
(defalias 'erc-buffer-do 'erc-buffer-filter
"Call FUNCTION in all ERC buffers or only those for PROC.
Expect users to prefer this alias to `erc-buffer-filter' in cases
where the latter would only be called for effect and its return
value thrown away.
Expect to be preferred over `erc-buffer-filter' in cases where
the return value goes unused.
\(fn FUNCTION &optional PROC)")
@ -1988,6 +2046,7 @@ removed from the list will be disabled."
:greedy t
(const :tag "autoaway: Set away status automatically" autoaway)
(const :tag "autojoin: Join channels automatically" autojoin)
(const :tag "bufbar: Show ERC buffers in a side window" bufbar)
(const :tag "button: Buttonize URLs, nicknames, and other text" button)
(const :tag "capab: Mark unidentified users on servers supporting CAPAB"
capab-identify)
@ -2008,6 +2067,8 @@ removed from the list will be disabled."
move-to-prompt)
(const :tag "netsplit: Detect netsplits" netsplit)
(const :tag "networks: Provide data about IRC networks" networks)
(const :tag "nickbar: Show nicknames in a dyamic side window" nickbar)
(const :tag "nicks: Uniquely colorize nicknames in target buffers" nicks)
(const :tag "noncommands: Don't display non-IRC commands after evaluation"
noncommands)
(const :tag "notifications: Desktop alerts on PRIVMSG or mentions"
@ -2089,12 +2150,43 @@ anything about the dependency's implementation.")
(defvar erc--setup-buffer-hook nil
"Internal hook for module setup involving windows and frames.")
(defvar erc--display-context nil
"Extra action alist items passed to `display-buffer'.
Non-nil when a user specifies a custom display action for certain
buffer-display options, like `erc-auto-reconnect-display'. ERC
pairs the option's symbol with a context-dependent value and adds
the entry to the user-provided alist when calling `pop-to-buffer'
or `display-buffer'.")
(defvar erc-skip-displaying-selected-window-buffer t
"Whether to forgo showing a buffer that's already being displayed.
But only in the selected window. This is intended as a crutch
for non-user third-party code that might be slow to adopt the
`display-buffer' function variant available to all buffer-display
options starting in ERC 5.6. Users with rare requirements, like
wanting to change the window buffer to something other than the
one being processed, should see the Info node `(erc)
display-buffer'.")
(make-obsolete 'erc-show-already-displayed-buffer
"non-nil behavior to be made permanent" "30.1")
(defvar-local erc--display-buffer-overriding-action nil
"The value of `display-buffer-overriding-action' when non-nil.
Influences the displaying of new or reassociated ERC buffers.
Reserved for use by built-in modules.")
(defun erc-setup-buffer (buffer)
"Consults `erc-join-buffer' to find out how to display `BUFFER'."
(pcase (if (zerop (erc-with-server-buffer
erc--server-last-reconnect-count))
erc-join-buffer
(or erc-reconnect-display erc-join-buffer))
(or erc-auto-reconnect-display erc-join-buffer))
((and (pred functionp) disp-fn (let context erc--display-context))
(unless (zerop erc--server-last-reconnect-count)
(push '(erc-auto-reconnect-display . t) context))
(funcall disp-fn buffer (cons nil context)))
((guard (and erc-skip-displaying-selected-window-buffer
(eq (window-buffer) buffer))))
('window
(if (active-minibuffer-window)
(display-buffer buffer)
@ -2287,13 +2379,18 @@ Returns the buffer for the given server or channel."
(erc-update-mode-line))
;; Now display the buffer in a window as per user wishes.
(unless (eq buffer old-buffer)
(when (eq buffer old-buffer) (cl-assert (and connect (not target))))
(unless (and (not erc-reconnect-display-server-buffers)
(eq buffer old-buffer))
(when erc-log-p
;; we can't log to debug buffer, it may not exist yet
(message "erc: old buffer %s, switching to %s"
old-buffer buffer))
(erc-setup-buffer buffer)
(run-hooks 'erc--setup-buffer-hook))
(let ((display-buffer-overriding-action
(or erc--display-buffer-overriding-action
display-buffer-overriding-action)))
(erc-setup-buffer buffer)
(run-hooks 'erc--setup-buffer-hook)))
buffer))
@ -2354,13 +2451,17 @@ parameters SERVER and NICK."
(setq input (concat "irc://" input)))
input)
(defvar erc--prompt-for-server-function nil)
;;;###autoload
(defun erc-select-read-args ()
"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 or URL (default is %S): " d)
nil 'erc-server-history-list d)))
(if erc--prompt-for-server-function
(funcall erc--prompt-for-server-function)
(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)))
(server (url-host url))
@ -2401,6 +2502,8 @@ With prefix arg, also prompt for user and full name."
env)
(when erc-interactive-display
(push `(erc-join-buffer . ,erc-interactive-display) env))
(when erc--display-context
(push `(erc--display-context . ,erc--display-context) env))
(when opener
(push `(erc-server-connect-function . ,opener) env))
(when (and passwd (string= "" passwd))
@ -2419,6 +2522,14 @@ With prefix arg, also prompt for user and full name."
(cl-progv ,syms ,vals
,@body))))
;;;###autoload
(defun erc-server-select ()
"Interactively connect to a server from `erc-server-alist'."
(declare (obsolete erc-tls "30.1"))
(interactive)
(let ((erc--prompt-for-server-function #'erc-networks--server-select))
(call-interactively #'erc)))
;;;###autoload
(cl-defun erc (&key (server (erc-compute-server))
(port (erc-compute-port))
@ -2454,7 +2565,12 @@ for the values of the other parameters.
See `erc-tls' for the meaning of ID.
\(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)"
(interactive (erc-select-read-args))
(interactive (let ((erc--display-context `((erc-interactive-display . erc)
,@erc--display-context)))
(erc-select-read-args)))
(unless (assq 'erc--display-context --interactive-env--)
(push '(erc--display-context . ((erc-buffer-display . erc)))
--interactive-env--))
(erc--with-entrypoint-environment --interactive-env--
(erc-open server port nick full-name t password nil nil nil nil user id)))
@ -2519,8 +2635,11 @@ 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)))
(interactive
(let ((erc-default-port erc-default-port-tls)
(erc--display-context `((erc-interactive-display . erc-tls)
,@erc--display-context)))
(erc-select-read-args)))
;; 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
@ -2529,6 +2648,9 @@ interactively.
(not (eq erc-server-connect-function #'erc-open-network-stream)))
(push '(erc-server-connect-function . erc-open-tls-stream)
--interactive-env--))
(unless (assq 'erc--display-context --interactive-env--)
(push '(erc--display-context . ((erc-buffer-display . erc-tls)))
--interactive-env--))
(erc--with-entrypoint-environment --interactive-env--
(erc-open server port nick full-name t password
nil nil nil client-certificate user id)))
@ -2723,10 +2845,13 @@ If ARG is non-nil, show the *erc-protocol* buffer."
(erc-send-ctcp-message tgt (format "ACTION %s" str) force)
(let ((erc-insert-pre-hook
(cons (lambda (s) ; Leave newline be.
(put-text-property 0 (1- (length s)) 'erc-command 'PRIVMSG s))
erc-insert-pre-hook)))
(erc-display-message nil 'input (current-buffer)
'ACTION ?n (erc-current-nick) ?a str ?u "" ?h "")))
(put-text-property 0 (1- (length s)) 'erc-command 'PRIVMSG s)
(put-text-property 0 (1- (length s)) 'erc-ctcp 'ACTION s))
erc-insert-pre-hook))
(nick (erc-current-nick)))
(setq nick (propertize nick 'erc-speaker nick))
(erc-display-message nil '(t action input) (current-buffer)
'ACTION ?n nick ?a str ?u "" ?h "")))
;; Display interface
@ -2879,6 +3004,25 @@ If STRING is nil, the function does nothing."
(process-buffer erc-server-process)
(current-buffer))))))
(defvar erc--compose-text-properties nil
"Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.")
(defun erc--merge-prop (from to prop val &optional object)
"Compose existing PROP values with VAL between FROM and TO in OBJECT.
For spans where PROP is non-nil, cons VAL onto the existing
value, ensuring a proper list. Otherwise, just set PROP to VAL.
See also `erc-button-add-face'."
(let ((old (get-text-property from prop object))
(pos from)
(end (next-single-property-change from prop object to))
new)
(while (< pos to)
(setq new (if old (cons val (ensure-list old)) val))
(put-text-property pos end prop new object)
(setq pos end
old (get-text-property pos prop object)
end (next-single-property-change pos prop object to)))))
(defun erc-display-message-highlight (type string)
"Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face.
@ -2890,7 +3034,7 @@ See also `erc-make-notice'."
0 (length string)
'font-lock-face (or (intern-soft
(concat "erc-" (symbol-name type) "-face"))
"erc-default-face")
'erc-default-face)
string)
string)))
@ -3094,6 +3238,17 @@ returns non-nil."
ARGS, PARSED, and TYPE are used to format MSG sensibly.
When TYPE is a list of symbols, call handlers from left to right
without influencing how they behave when encountering existing
faces. As of ERC 5.6, expect a TYPE of (notice error) to insert
MSG with `font-lock-face' as `erc-error-face' throughout.
However, when the list of symbols begins with t, tell compatible
handlers to compose rather than clobber faces. For example, as
of ERC 5.6, expect a TYPE of (t notice error) to result in MSG's
`font-lock-face' being (erc-error-face erc-notice-face)
throughout when `erc-notice-highlight-type' is set to its default
`all'.
See also `erc-format-message' and `erc-display-line'."
(let ((string (if (symbolp msg)
(apply #'erc-format-message msg args)
@ -3104,10 +3259,10 @@ See also `erc-format-message' and `erc-display-line'."
((null type)
string)
((listp type)
(mapc (lambda (type)
(setq string
(erc-display-message-highlight type string)))
type)
(let ((erc--compose-text-properties
(and (eq (car type) t) (setq type (cdr type)))))
(dolist (type type)
(setq string (erc-display-message-highlight type string))))
string)
((symbolp type)
(erc-display-message-highlight type string))))
@ -3213,6 +3368,42 @@ this function from interpreting the line as a command."
(erc-display-message nil 'error (current-buffer) 'no-target)
nil)))))
(defconst erc--shell-parse-regexp
(rx (or (+ (not (any ?\s ?\t ?\n ?\\ ?\" ?' ?\;)))
(: ?' (group (* (not ?'))) (? ?'))
(: ?\" (group (* (or (not (any ?\" ?\\)) (: ?\\ nonl)))) (? ?\"))
(: ?\\ (group (? (or nonl ?\n)))))))
(defun erc--split-string-shell-cmd (string)
"Parse whitespace-separated arguments in STRING."
;; From `shell--parse-pcomplete-arguments' and friends. Quirk:
;; backslash-escaped characters appearing within spans of double
;; quotes are unescaped.
(with-temp-buffer
(insert string)
(let ((end (point))
args)
(goto-char (point-min))
(while (and (skip-chars-forward " \t") (< (point) end))
(let (arg)
(while (looking-at erc--shell-parse-regexp)
(goto-char (match-end 0))
(cond ((match-beginning 3) ; backslash escape
(push (if (= (match-beginning 3) (match-end 3))
"\\"
(match-string 3))
arg))
((match-beginning 2) ; double quote
(push (replace-regexp-in-string (rx ?\\ (group nonl))
"\\1" (match-string 2))
arg))
((match-beginning 1) ; single quote
(push (match-string 1) arg))
(t (push (match-string 0) arg))))
(push (string-join (nreverse arg)) args)))
(nreverse args))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Input commands handlers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -3683,7 +3874,10 @@ were most recently invited. See also `invitation'."
(sn (erc-extract-nick (erc-response.sender parsed)))
((erc-nick-equal-p sn (erc-current-nick)))
(erc-join-buffer (or erc-interactive-display
erc-join-buffer)))
erc-join-buffer))
(erc--display-context `((erc-interactive-display
. /JOIN)
,@erc--display-context)))
(run-hook-with-args-until-success
'erc-server-JOIN-functions proc parsed)
t))))
@ -4067,7 +4261,9 @@ on the value of `erc-interactive-display'."
;; currently broken, evil hack to display help anyway
;(erc-delete-query))))
(signal 'wrong-number-of-arguments '(erc-cmd-QUERY 0)))
(let ((erc-join-buffer erc-interactive-display))
(let ((erc-join-buffer erc-interactive-display)
(erc--display-context `((erc-interactive-display . /QUERY)
,@erc--display-context)))
(erc-with-server-buffer
(erc--open-target user))))
@ -4187,6 +4383,9 @@ the message given by REASON."
(defun erc--cmd-reconnect ()
(let ((buffer (erc-server-buffer))
(erc-join-buffer erc-interactive-display)
(erc--display-context `((erc-interactive-display . /RECONNECT)
,@erc--display-context))
(process nil))
(unless (buffer-live-p buffer)
(setq buffer (current-buffer)))
@ -4532,7 +4731,7 @@ Eventually add a # in front of it, if that turns it into a valid channel name."
(concat "#" channel)))
(defvar erc--own-property-names
'( tags erc-parsed display ; core
'( tags erc-speaker erc-parsed display ; core
;; `erc-display-prompt'
rear-nonsticky erc-prompt field front-sticky read-only
;; stamp
@ -4851,13 +5050,7 @@ compatibility flag `erc-receive-query-display-defer' to nil. Use
:package-version '(ERC . "5.6")
:group 'erc-buffers
:group 'erc-query
:type '(choice (const :tag "Defer to value of `erc-buffer-display'" nil)
(const :tag "Split window and select" window)
(const :tag "Split window, don't select" window-noselect)
(const :tag "New frame" frame)
(const :tag "Bury in new buffer" bury)
(const :tag "Use current buffer" buffer)
(const :tag "Use current buffer" t)))
:type erc--buffer-display-choices)
(defvar erc-receive-query-display-defer t
"How to interpret a null `erc-receive-query-display'.
@ -5025,6 +5218,16 @@ and as second argument the event parsed as a vector."
(and (erc-is-message-ctcp-p message)
(not (string-match "^\C-aACTION.*\C-a$" message))))
(define-inline erc--get-speaker-bounds ()
"Return the bounds of `erc-speaker' property when present.
Assume buffer is narrowed to the confines of an inserted message."
(inline-quote
(and-let*
(((memq (get-text-property (point) 'erc-command) '(PRIVMSG NOTICE)))
(beg (or (and (get-text-property (point-min) 'erc-speaker) (point-min))
(next-single-property-change (point-min) 'erc-speaker))))
(cons beg (next-single-property-change beg 'erc-speaker)))))
(defvar erc--user-from-nick-function #'erc--examine-nick
"Function to possibly consider unknown user.
Must return either nil or a cons of an `erc-server-user' and a
@ -5041,11 +5244,19 @@ the parsed NUH, and the original `erc-response' object.")
(mark-e (if msgp (if privp "*" ">") "-"))
(str (format "%s%s%s %s" mark-s nick mark-e msg))
(nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face))
(nick-prefix-face (get-text-property 0 'font-lock-face nick))
(prefix-len (or (and nick-prefix-face (text-property-not-all
0 (length nick) 'font-lock-face
nick-prefix-face nick))
0))
(msg-face (if privp 'erc-direct-msg-face 'erc-default-face)))
;; add text properties to text before the nick, the nick and after the nick
(erc-put-text-property 0 (length mark-s) 'font-lock-face msg-face str)
(erc-put-text-property (length mark-s) (+ (length mark-s) (length nick))
'font-lock-face nick-face str)
(erc-put-text-properties (+ (length mark-s) prefix-len)
(+ (length mark-s) (length nick))
'(font-lock-face erc-speaker) str
(list nick-face
(substring-no-properties nick prefix-len)))
(erc-put-text-property (+ (length mark-s) (length nick)) (length str)
'font-lock-face msg-face str)
str))
@ -5097,7 +5308,7 @@ also `erc-format-nick-function'."
(concat
(propertize open 'font-lock-face 'erc-default-face)
(propertize mode 'font-lock-face 'erc-my-nick-prefix-face)
(propertize nick 'font-lock-face 'erc-my-nick-face)
(propertize nick 'font-lock-face 'erc-my-nick-face 'erc-speaker nick)
(propertize close 'font-lock-face 'erc-default-face)))
(let ((prefix "> "))
(propertize prefix 'font-lock-face 'erc-default-face))))
@ -5285,7 +5496,7 @@ Set user modes and run `erc-after-connect' hook."
(setq erc--server-last-reconnect-count erc-server-reconnect-count
erc-server-reconnect-count 0)
(setq erc--server-reconnect-display-timer
(run-at-time erc-reconnect-display-timeout nil
(run-at-time erc-auto-reconnect-display-timeout nil
#'erc--server-last-reconnect-display-reset
(current-buffer)))
(add-hook 'erc-disconnected-hook
@ -5335,7 +5546,12 @@ See also `erc-display-message'."
'ctcp-empty ?n nick)
(while queries
(let* ((type (upcase (car (split-string (car queries)))))
(hook (intern-soft (concat "erc-ctcp-query-" type "-hook"))))
(hook (intern-soft (concat "erc-ctcp-query-" type "-hook")))
(erc-insert-pre-hook
(cons (lambda (s)
(put-text-property 0 (1- (length s)) 'erc-ctcp
(intern type) s))
erc-insert-pre-hook)))
(if (and hook (boundp hook))
(if (string-equal type "ACTION")
(run-hook-with-args-until-success
@ -5370,6 +5586,7 @@ See also `erc-display-message'."
(buf (or (erc-get-buffer to proc)
(erc-get-buffer nick proc)
(process-buffer proc))))
(setq nick (propertize nick 'erc-speaker nick))
(erc-display-message
parsed 'action buf
'ACTION ?n nick ?u login ?h host ?a s))))
@ -6049,7 +6266,7 @@ See also variable `erc-notice-highlight-type'."
(erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s)
s)
(defalias 'erc-put-text-property 'put-text-property
(defun erc-put-text-property (start end property value &optional object)
"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'.
@ -6059,7 +6276,10 @@ 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.")
EmacsSpeak support."
(if erc--compose-text-properties
(erc--merge-prop start end property value object)
(put-text-property start end property value object)))
(defalias 'erc-list 'ensure-list)
@ -7656,6 +7876,8 @@ All windows are opened in the current frame."
(s463 . "Your host isn't among the privileged")
(s464 . "Password incorrect")
(s465 . "You are banned from this server")
(s471 . "Max occupancy for channel %c exceeded: %s")
(s473 . "Channel %c is invitation only")
(s474 . "You can't join %c because you're banned (+b)")
(s475 . "You must specify the correct channel key (+k) to join %c")
(s481 . "Permission Denied - You're not an IRC operator")
@ -7857,6 +8079,8 @@ Beginning with ERC 5.5, new connections require human intervention.
Customize `erc-url-connect-function' to override this."
(when (eql port 0) (setq port nil))
(let* ((net (erc-networks--determine host))
(erc--display-context `((erc-interactive-display . url)
,@erc--display-context))
(server-buffer
;; Viable matches may slip through the cracks for unknown
;; networks. Additional passes could likely improve things.

24
lisp/startup.el
View file

@ -520,27 +520,6 @@ DIRS are relative."
xdg-dir)
(t emacs-d-dir))))
(defvar comp--compilable)
(defvar comp--delayed-sources)
(defun startup--require-comp-safely ()
"Require the native compiler avoiding circular dependencies."
(when (featurep 'native-compile)
;; Require comp with `comp--compilable' set to nil to break
;; circularity.
(let ((comp--compilable nil))
(require 'comp))
(native--compile-async comp--delayed-sources nil 'late)
(setq comp--delayed-sources nil)))
(declare-function native--compile-async "comp.el"
(files &optional recursively load selector))
(defun startup--honor-delayed-native-compilations ()
"Honor pending delayed deferred native compilations."
(when (and (native-comp-available-p)
comp--delayed-sources)
(startup--require-comp-safely))
(setq comp--compilable t))
(defvar native-comp-eln-load-path)
(defvar native-comp-jit-compilation)
(defvar native-comp-enable-subr-trampolines)
@ -859,8 +838,7 @@ It is the default value of the variable `top-level'."
nil)))
(setq env (cdr env)))))
(when display
(setq process-environment (delete display process-environment)))))
(startup--honor-delayed-native-compilations))
(setq process-environment (delete display process-environment))))))
;; Precompute the keyboard equivalents in the menu bar items.
;; Command-line options supported by tty's:

23
src/comp.c
View file

@ -5199,17 +5199,9 @@ maybe_defer_native_compilation (Lisp_Object function_name,
Fputhash (function_name, definition, Vcomp_deferred_pending_h);
/* This is so deferred compilation is able to compile comp
dependencies breaking circularity. */
if (comp__compilable)
{
/* Startup is done, comp is usable. */
CALL0I (startup--require-comp-safely);
CALLN (Ffuncall, intern_c_string ("native--compile-async"),
src, Qnil, Qlate);
}
else
Vcomp__delayed_sources = Fcons (src, Vcomp__delayed_sources);
pending_funcalls
= Fcons (list (Qnative__compile_async, src, Qnil, Qlate),
pending_funcalls);
}
@ -5674,13 +5666,6 @@ void
syms_of_comp (void)
{
#ifdef HAVE_NATIVE_COMP
DEFVAR_LISP ("comp--delayed-sources", Vcomp__delayed_sources,
doc: /* List of sources to be native-compiled when startup is finished.
For internal use. */);
DEFVAR_BOOL ("comp--compilable", comp__compilable,
doc: /* Non-nil when comp.el can be native compiled.
For internal use. */);
/* Compiler control customizes. */
DEFVAR_BOOL ("native-comp-jit-compilation", native_comp_jit_compilation,
doc: /* If non-nil, compile loaded .elc files asynchronously.
@ -5798,6 +5783,8 @@ natively-compiled one. */);
build_pure_c_string ("eln file inconsistent with current runtime "
"configuration, please recompile"));
DEFSYM (Qnative__compile_async, "native--compile-async");
defsubr (&Scomp__subr_signature);
defsubr (&Scomp_el_to_eln_rel_filename);
defsubr (&Scomp_el_to_eln_filename);

2
src/frame.h
View file

@ -1101,7 +1101,7 @@ default_pixels_per_inch_y (void)
#define FRAME_TOOL_BAR_TOP_LINES(f) \
((BASE_EQ ((f)->tool_bar_position, Qtop)) \
? (f)->tool_bar_height : 0)
? (f)->tool_bar_lines : 0)
/* Size of F's tool bar if it is placed at the bottom of the
frame. */

2
test/lisp/erc/erc-button-tests.el
View file

@ -265,7 +265,7 @@
(ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k
(erc-button-next 1)
(should (equal (get-text-property (point) 'font-lock-face)
'(erc-button erc-error-face)))
'(erc-button erc-error-face erc-notice-face)))
(should (eq (get-text-property (point) 'mouse-face) 'highlight))
(should (eq erc-button-face 'erc-button))) ; extent evaporates

23
test/lisp/erc/erc-dcc-tests.el
View file

@ -99,10 +99,11 @@
(ert-deftest erc-dcc-handle-ctcp-send--turbo ()
(erc-dcc-tests--dcc-handle-ctcp-send t))
(defun erc-dcc-tests--erc-dcc-do-GET-command (file &optional sep)
(defun erc-dcc-tests--erc-dcc-do-GET-command (file &optional sep nuh)
(unless nuh (setq nuh "tester!~tester@fake.irc"))
(with-temp-buffer
(let* ((proc (start-process "fake" (current-buffer) "sleep" "10"))
(elt (list :nick "tester!~tester@fake.irc"
(elt (list :nick nuh
:type 'GET
:peer nil
:parent proc
@ -110,6 +111,7 @@
:port "9899"
:file file
:size 1405135128))
(nic (erc-extract-nick nuh))
(erc-dcc-list (list elt))
;;
erc-accidental-paste-threshold-seconds
@ -130,7 +132,7 @@
(ert-info ("No turbo")
(should-not (plist-member elt :turbo))
(goto-char erc-input-marker)
(insert "/dcc GET tester " (or sep "") (prin1-to-string file))
(insert "/dcc GET " nic " " (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 file proc))))
@ -138,7 +140,7 @@
(ert-info ("Arg turbo in pos 2")
(should-not (plist-member elt :turbo))
(goto-char erc-input-marker)
(insert "/dcc GET -t tester " (or sep "") (prin1-to-string file))
(insert "/dcc GET -t " nic " " (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 file proc))))
@ -147,7 +149,7 @@
(setq elt (plist-put elt :turbo nil)
erc-dcc-list (list elt))
(goto-char erc-input-marker)
(insert "/dcc GET tester -t " (or sep "") (prin1-to-string file))
(insert "/dcc GET " nic " -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 file proc))))
@ -156,7 +158,7 @@
(setq elt (plist-put elt :turbo nil)
erc-dcc-list (list elt))
(goto-char erc-input-marker)
(insert "/dcc GET tester " (prin1-to-string file) " -t" (or sep ""))
(insert "/dcc GET " nic " " (prin1-to-string file) " -t" (or sep ""))
(erc-send-current-line)
(should (eq (if sep nil t) (plist-get (car erc-dcc-list) :turbo)))
(should (equal (pop calls) (if sep nil (list elt file proc)))))))))
@ -165,7 +167,14 @@
(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" "-- "))
(erc-dcc-tests--erc-dcc-do-GET-command "-t" "-- ")
;; Regression involving pipe character in nickname.
(let ((nuh "test|r!~test|r@fake.irc"))
(erc-dcc-tests--erc-dcc-do-GET-command "foo.bin" nil nuh)
(erc-dcc-tests--erc-dcc-do-GET-command "foo - file.bin" nil nuh)
(erc-dcc-tests--erc-dcc-do-GET-command "foo -t file.bin" nil nuh)
(erc-dcc-tests--erc-dcc-do-GET-command "-t" "-- " nuh)))
(defun erc-dcc-tests--pcomplete-common (test-fn &optional file)
(with-current-buffer (get-buffer-create "*erc-dcc-do-GET-command*")

5
test/lisp/erc/erc-fill-tests.el
View file

@ -153,7 +153,10 @@
(with-temp-file expect-file
(insert repr))
(if (file-exists-p expect-file)
;; Compare set-equal over intervals
;; Compare set-equal over intervals. This comparison is
;; less useful for messages treated by other modules because
;; it doesn't compare "nested" props belonging to
;; string-valued properties, like timestamps.
(should (equal-including-properties
(read repr)
(read (with-temp-buffer

226
test/lisp/erc/erc-goodies-tests.el
View file

@ -245,81 +245,179 @@
;; minor-mode toggle is allowed to disable its mode variable as
;; needed.
(ert-deftest erc-keep-place-indicator-mode ()
(defun erc-goodies-tests--assert-kp-indicator-on ()
(should erc--keep-place-indicator-overlay)
(should (local-variable-p 'window-configuration-change-hook))
(should window-configuration-change-hook)
(should (memq 'erc-keep-place erc-insert-pre-hook))
(should (eq erc-keep-place-mode
(not (local-variable-p 'erc-insert-pre-hook)))))
(defun erc-goodies-tests--assert-kp-indicator-off ()
(should-not (local-variable-p 'erc-insert-pre-hook))
(should-not (local-variable-p 'window-configuration-change-hook))
(should-not erc--keep-place-indicator-overlay))
(defun erc-goodies-tests--kp-indicator-populate ()
(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))
(defun erc-goodies-tests--keep-place-indicator (test)
(with-current-buffer (get-buffer-create "*erc-keep-place-indicator-mode*")
(erc-mode)
(erc--initialize-markers (point) nil)
(setq erc-server-process
(start-process "sleep" (current-buffer) "sleep" "1"))
(set-process-query-on-exit-flag erc-server-process 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-connect-pre-hook
(let (erc-connect-pre-hook
erc-modules)
(funcall assert-off)
(ert-info ("Clean slate")
(erc-goodies-tests--assert-kp-indicator-off)
(should-not erc-keep-place-mode)
(should-not (memq 'keep-place erc-modules)))
(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")))))
(funcall test))
(when noninteractive
(erc-keep-place-indicator-mode -1)
(erc-keep-place-mode -1)
(should-not (member 'erc-keep-place
(default-value 'erc-insert-pre-hook)))
(should-not (local-variable-p 'erc-insert-pre-hook))
(kill-buffer))))
(ert-deftest erc-keep-place-indicator-mode--no-global ()
(erc-goodies-tests--keep-place-indicator
(lambda ()
(ert-info ("Value t")
(should (eq erc-keep-place-indicator-buffer-type t))
(erc-keep-place-indicator-mode +1)
(erc-goodies-tests--assert-kp-indicator-on)
(goto-char (point-min)))
(erc-keep-place-indicator-mode -1)
(erc-goodies-tests--assert-kp-indicator-off)
(ert-info ("Value `target'")
(let ((erc-keep-place-indicator-buffer-type 'target))
;; No-op because server buffer.
(erc-keep-place-indicator-mode +1)
(erc-goodies-tests--assert-kp-indicator-off)
;; Spoof target buffer (no longer no-op).
(setq erc--target (erc--target-from-string "#chan"))
(erc-keep-place-indicator-mode +1)
(erc-goodies-tests--assert-kp-indicator-on)))
(erc-keep-place-indicator-mode -1)
(erc-goodies-tests--assert-kp-indicator-off)
(ert-info ("Value `server'")
(let ((erc-keep-place-indicator-buffer-type 'server))
(erc-keep-place-indicator-mode +1)
(erc-goodies-tests--assert-kp-indicator-off)
(setq erc--target nil)
(erc-keep-place-indicator-mode +1)
(erc-goodies-tests--assert-kp-indicator-on)))
;; Populate buffer
(erc-goodies-tests--kp-indicator-populate)
(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)))
(erc-goodies-tests--assert-kp-indicator-on)
(should (= (point) erc-input-marker))
(goto-char (overlay-start erc--keep-place-indicator-overlay))
(should (looking-at (rx "*** This buffer is for text")))))))
(ert-deftest erc-keep-place-indicator-mode--global ()
(erc-goodies-tests--keep-place-indicator
(lambda ()
(push 'keep-place erc-modules)
(ert-info ("Value t")
(should (eq erc-keep-place-indicator-buffer-type t))
(erc-keep-place-indicator-mode +1)
(erc-goodies-tests--assert-kp-indicator-on)
;; Local module activates global `keep-place'.
(should erc-keep-place-mode)
;; Does not register local version of hook (otherwise would run
;; twice).
(should-not (local-variable-p 'erc-insert-pre-hook))
(goto-char (point-min)))
(erc-keep-place-indicator-mode -1)
(erc-goodies-tests--assert-kp-indicator-off)
(should erc-keep-place-mode)
(should (member 'erc-keep-place erc-insert-pre-hook))
(ert-info ("Value `target'")
(let ((erc-keep-place-indicator-buffer-type 'target))
;; No-op because server buffer.
(erc-keep-place-indicator-mode +1)
(erc-goodies-tests--assert-kp-indicator-off)
;; Does not interfere with global activation state.
(should erc-keep-place-mode)
(should (member 'erc-keep-place erc-insert-pre-hook))
;; Morph into a target buffer (no longer no-op).
(setq erc--target (erc--target-from-string "#chan"))
(erc-keep-place-indicator-mode +1)
(erc-goodies-tests--assert-kp-indicator-on)
;; Does not register local version of hook.
(should-not (local-variable-p 'erc-insert-pre-hook))))
(erc-keep-place-indicator-mode -1)
(erc-goodies-tests--assert-kp-indicator-off)
(should erc-keep-place-mode)
(should (member 'erc-keep-place erc-insert-pre-hook))
(ert-info ("Value `server'")
(let ((erc-keep-place-indicator-buffer-type 'server))
;; No-op because we're now a target buffer.
(erc-keep-place-indicator-mode +1)
(erc-goodies-tests--assert-kp-indicator-off)
(should erc-keep-place-mode)
(should (member 'erc-keep-place erc-insert-pre-hook))
;; Back to server.
(setq erc--target nil)
(erc-keep-place-indicator-mode +1)
(erc-goodies-tests--assert-kp-indicator-on)
(should-not (local-variable-p 'erc-insert-pre-hook))))
(ert-info ("Local adapts to global toggle")
(erc-keep-place-mode -1)
(should-not (member 'erc-keep-place
(default-value 'erc-insert-pre-hook)))
(should (member 'erc-keep-place erc-insert-pre-hook))
(erc-goodies-tests--assert-kp-indicator-on)
(erc-keep-place-mode +1)
(should (member 'erc-keep-place (default-value 'erc-insert-pre-hook)))
(should-not (local-variable-p 'erc-insert-pre-hook))
(erc-goodies-tests--assert-kp-indicator-on))
;; Populate buffer
(erc-goodies-tests--kp-indicator-populate)
(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)))
(erc-goodies-tests--assert-kp-indicator-on)
(should erc-keep-place-mode)
(should (member 'erc-keep-place erc-insert-pre-hook))
(should (= (point) erc-input-marker))
(goto-char (overlay-start erc--keep-place-indicator-overlay))
(should (looking-at (rx "*** This buffer is for text")))))))
;;; erc-goodies-tests.el ends here

18
test/lisp/erc/erc-networks-tests.el
View file

@ -1750,4 +1750,22 @@
(should (eq (erc-networks--determine)
erc-networks--name-missing-sentinel))))
(ert-deftest erc-ports-list ()
(with-suppressed-warnings ((obsolete erc-server-alist))
(let* ((srv (assoc "Libera.Chat: Random server" erc-server-alist)))
(should (equal (erc-ports-list (nth 3 srv))
'(6665 6666 6667 8000 8001 8002)))
(should (equal (erc-ports-list (nth 4 srv))
'(6697 7000 7070))))
(let* ((srv (assoc "Libera.Chat: Random Europe server" erc-server-alist)))
(should (equal (erc-ports-list (nth 3 srv)) '(6667)))
(should (equal (erc-ports-list (nth 4 srv)) '(6697))))
(let* ((srv (assoc "OFTC: Random server" erc-server-alist)))
(should (equal (erc-ports-list (nth 3 srv))
'(6667 6668 6669 6670 7000)))
(should (equal (erc-ports-list (nth 4 srv))
'(6697 9999))))))
;;; erc-networks-tests.el ends here

538
test/lisp/erc/erc-nicks-tests.el Normal file
View file

@ -0,0 +1,538 @@
;;; erc-nicks-tests.el --- Tests for erc-nicks -*- 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:
;; Unlike most of ERC's tests, the ones in this file can be run
;; interactively in the same session.
;; TODO:
;;
;; * Add mock session (or scenario) with buffer snapshots, like those
;; in erc-fill-tests.el. (Should probably move helpers to a common
;; library under ./resources.)
;;; Code:
(require 'ert-x)
(require 'erc-nicks)
;; This function replicates the behavior of older "invert" strategy
;; implementations from EmacsWiki, etc. The values for the lower and
;; upper bounds (0.33 and 0.66) are likewise inherited. See
;; `erc-nicks--invert-classic--dark' below for one reason its results
;; may not be plainly obvious.
(defun erc-nicks-tests--invert-classic (color)
(if (pcase (erc-nicks--bg-mode)
('dark (< (erc-nicks--get-luminance color) (/ 1 3.0)))
('light (> (erc-nicks--get-luminance color) (/ 2 3.0))))
(list (- 1.0 (nth 0 color)) (- 1.0 (nth 1 color)) (- 1.0 (nth 2 color)))
color))
(ert-deftest erc-nicks--get-luminance ()
(should (eql 0.0 (erc-nicks--get-luminance "black")))
(should (eql 1.0 (erc-nicks--get-luminance "white")))
(should (eql 21.0 (/ (+ 0.05 1.0) (+ 0.05 0.0))))
;; RGB floats from a `display-graphic-p' session.
(let ((a (erc-nicks--get-luminance ; #9439ad
'(0.5803921568627451 0.2235294117647059 0.6784313725490196)))
(b (erc-nicks--get-luminance ; #ae54c7
'(0.6823529411764706 0.32941176470588235 0.7803921568627451)))
(c (erc-nicks--get-luminance ; #d19ddf
'(0.8196078431372549 0.615686274509804 0.8745098039215686)))
(d (erc-nicks--get-luminance ; #f5e8f8
'(0.9607843137254902 0.9098039215686274 0.9725490196078431))))
;; Low, med, high contrast comparisons against known values from
;; an external source.
(should (eql 1.42 (/ (round (* 100 (/ (+ 0.05 b) (+ 0.05 a)))) 100.0)))
(should (eql 2.78 (/ (round (* 100 (/ (+ 0.05 c) (+ 0.05 a)))) 100.0)))
(should (eql 5.16 (/ (round (* 100 (/ (+ 0.05 d) (+ 0.05 a)))) 100.0)))))
(ert-deftest erc-nicks-invert--classic ()
(let ((convert (lambda (n) (apply #'color-rgb-to-hex
(erc-nicks-tests--invert-classic
(color-name-to-rgb n))))))
(let ((erc-nicks--bg-mode-value 'dark))
(should (equal (funcall convert "white") "#ffffffffffff"))
(should (equal (funcall convert "black") "#ffffffffffff"))
(should (equal (funcall convert "green") "#0000ffff0000")))
(let ((erc-nicks--bg-mode-value 'light))
(should (equal (funcall convert "white") "#000000000000"))
(should (equal (funcall convert "black") "#000000000000"))
(should (equal (funcall convert "green") "#ffff0000ffff")))))
(ert-deftest erc-nicks--get-contrast ()
(should (= 21.0 (erc-nicks--get-contrast "white" "black")))
(should (= 21.0 (erc-nicks--get-contrast "black" "white")))
(should (= 1.0 (erc-nicks--get-contrast "black" "black")))
(should (= 1.0 (erc-nicks--get-contrast "white" "white"))))
(defun erc-nicks-tests--print-contrast (fn color)
(let* ((erc-nicks-color-adjustments (list fn))
(result (erc-nicks--reduce color))
(start (point)))
(insert (format "%16s%-16s%16s%-16s\n"
(concat color "-")
(concat ">" result)
(concat color " ")
(concat " " result)))
(put-text-property (+ start 32) (+ start 48) 'face
(list :background color :foreground result))
(put-text-property (+ start 48) (+ start 64) 'face
(list :background result :foreground color))
result))
(ert-deftest erc-nicks--invert-classic--light ()
(let ((erc-nicks--bg-luminance 1.0)
(erc-nicks--bg-mode-value 'light)
(show (lambda (c) (erc-nicks-tests--print-contrast
#'erc-nicks-tests--invert-classic c))))
(with-current-buffer (get-buffer-create
"*erc-nicks--invert-classic--light*")
(should (equal "#000000000000" (funcall show "white")))
(should (equal "#000000000000" (funcall show "black")))
(should (equal "#ffff00000000" (funcall show "red")))
(should (equal "#ffff0000ffff" (funcall show "green"))) ; magenta
(should (equal "#00000000ffff" (funcall show "blue")))
(unless noninteractive
(should (equal "#bbbbbbbbbbbb" (funcall show "#bbbbbbbbbbbb")))
(should (equal "#cccccccccccc" (funcall show "#cccccccccccc")))
(should (equal "#222122212221" (funcall show "#dddddddddddd")))
(should (equal "#111011101110" (funcall show "#eeeeeeeeeeee"))))
(when noninteractive
(kill-buffer)))))
;; This shows that the output can be darker (have less contrast) than
;; the input.
(ert-deftest erc-nicks--invert-classic--dark ()
(let ((erc-nicks--bg-luminance 0.0)
(erc-nicks--bg-mode-value 'dark)
(show (lambda (c) (erc-nicks-tests--print-contrast
#'erc-nicks-tests--invert-classic c))))
(with-current-buffer (get-buffer-create
"*erc-nicks--invert-classic--dark*")
(should (equal "#ffffffffffff" (funcall show "white")))
(should (equal "#ffffffffffff" (funcall show "black")))
(should (equal "#0000ffffffff" (funcall show "red"))) ; cyan
(should (equal "#0000ffff0000" (funcall show "green")))
(should (equal "#ffffffff0000" (funcall show "blue"))) ; yellow
(unless noninteractive
(should (equal "#aaaaaaaaaaaa" (funcall show "#555555555555")))
(should (equal "#999999999999" (funcall show "#666666666666")))
(should (equal "#888888888888" (funcall show "#777777777777")))
(should (equal "#777777777777" (funcall show "#888888888888")))
(should (equal "#666666666666" (funcall show "#999999999999")))
(should (equal "#aaaaaaaaaaaa" (funcall show "#aaaaaaaaaaaa"))))
(when noninteractive
(kill-buffer)))))
;; These are the same as the legacy version but work in terms of
;; contrast ratios. Converting the original bounds to contrast ratios
;; (assuming pure white and black backgrounds) gives:
;;
;; min-lum of 0.33 ~~> 1.465
;; max-lum of 0.66 ~~> 7.666
;;
(ert-deftest erc-nicks-invert--light ()
(let ((erc-nicks--bg-luminance 1.0)
(erc-nicks--bg-mode-value 'light)
(erc-nicks-contrast-range '(1.465))
(show (lambda (c) (erc-nicks-tests--print-contrast
#'erc-nicks-invert c))))
(with-current-buffer (get-buffer-create
"*erc-nicks--invert-classic--light*")
(should (equal "#000000000000" (funcall show "white")))
(should (equal "#000000000000" (funcall show "black")))
(should (equal "#ffff00000000" (funcall show "red")))
(should (equal "#ffff0000ffff" (funcall show "green"))) ; magenta
(should (equal "#00000000ffff" (funcall show "blue")))
(unless noninteractive
(should (equal "#bbbbbbbbbbbb" (funcall show "#bbbbbbbbbbbb")))
(should (equal "#cccccccccccc" (funcall show "#cccccccccccc")))
(should (equal "#222122212221" (funcall show "#dddddddddddd")))
(should (equal "#111011101110" (funcall show "#eeeeeeeeeeee"))))
(when noninteractive
(kill-buffer)))))
(ert-deftest erc-nicks-invert--dark ()
(let ((erc-nicks--bg-luminance 0.0)
(erc-nicks--bg-mode-value 'dark)
(erc-nicks-contrast-range '(7.666))
(show (lambda (c) (erc-nicks-tests--print-contrast
#'erc-nicks-invert c))))
(with-current-buffer (get-buffer-create "*erc-nicks-invert--dark*")
(should (equal "#ffffffffffff" (funcall show "white")))
(should (equal "#ffffffffffff" (funcall show "black")))
(should (equal "#0000ffffffff" (funcall show "red"))) ; cyan
(should (equal "#0000ffff0000" (funcall show "green")))
(should (equal "#ffffffff0000" (funcall show "blue"))) ; yellow
(unless noninteractive
(should (equal "#aaaaaaaaaaaa" (funcall show "#555555555555")))
(should (equal "#999999999999" (funcall show "#666666666666")))
(should (equal "#888888888888" (funcall show "#777777777777")))
(should (equal "#888888888888" (funcall show "#888888888888")))
(should (equal "#999999999999" (funcall show "#999999999999"))))
(when noninteractive
(kill-buffer)))))
(ert-deftest erc-nicks-add-contrast ()
(let ((erc-nicks--bg-luminance 1.0)
(erc-nicks--bg-mode-value 'light)
(erc-nicks--fg-rgb '(0.0 0.0 0.0))
(erc-nicks-bg-color "white")
(erc-nicks-contrast-range '(3.5))
(show (lambda (c) (erc-nicks-tests--print-contrast
#'erc-nicks-add-contrast c))))
(with-current-buffer (get-buffer-create "*erc-nicks-add-contrast*")
(should (equal "#893a893a893a" (funcall show "white")))
(should (equal "#893a893a893a" (funcall show "#893a893a893a")))
(should (equal "#000000000000" (funcall show "black")))
(should (equal "#ffff00000000" (funcall show "red")))
(should (equal "#0000a12e0000" (funcall show "green")))
(should (equal "#00000000ffff" (funcall show "blue")))
;; When the input is already near the desired ratio, the result
;; may not be in bounds, only close. But the difference is
;; usually imperceptible.
(unless noninteractive
;; Well inside (light slate gray)
(should (equal "#777788889999" (funcall show "#777788889999")))
;; Slightly outside -> just outside
(should (equal "#7c498bd39b5c" (funcall show "#88889999aaaa")))
;; Just outside -> just inside
(should (equal "#7bcc8b479ac0" (funcall show "#7c498bd39b5c")))
;; Just inside
(should (equal "#7bcc8b479ac0" (funcall show "#7bcc8b479ac0"))))
(when noninteractive
(kill-buffer)))))
(ert-deftest erc-nicks-cap-contrast ()
(should (= 12.5 (cdr erc-nicks-contrast-range)))
(let ((erc-nicks--bg-luminance 1.0)
(erc-nicks--bg-mode-value 'light)
(erc-nicks--fg-rgb '(0.0 0.0 0.0))
(erc-nicks-bg-color "white")
(show (lambda (c) (erc-nicks-tests--print-contrast
#'erc-nicks-cap-contrast c))))
(with-current-buffer (get-buffer-create "*erc-nicks-remove-contrast*")
(should (equal (funcall show "black") "#34e534e534e5" )) ; 21.0 -> 12.14
(should ; 12.32 -> 12.32 (same)
(equal (funcall show "#34e534e534e5") "#34e534e534e5"))
(should (equal (funcall show "white") "#ffffffffffff"))
(unless noninteractive
(should (equal (funcall show "DarkRed") "#8b8b00000000"))
(should (equal (funcall show "DarkGreen") "#000064640000"))
;; 15.29 -> 12.38
(should (equal (funcall show "DarkBlue") "#1cf11cf198b5"))
;; 12.50 -> 12.22
(should (equal (funcall show "#33e033e033e0") "#34ab34ab34ab"))
;; 12.57 -> 12.28
(should (equal (funcall show "#338033803380") "#344c344c344c"))
;; 12.67 -> 12.37
(should (equal (funcall show "#330033003300") "#33cc33cc33cc")))
(when noninteractive
(kill-buffer)))))
(ert-deftest erc-nicks--skip-p ()
;; Baseline
(should-not (erc-nicks--skip-p 'bold nil 10000000))
(should-not (erc-nicks--skip-p '(bold) nil 10000000))
(should-not (erc-nicks--skip-p nil '(bold) 10000000))
(should-not (erc-nicks--skip-p 'bold '(bold) 0))
(should-not (erc-nicks--skip-p '(bold) '(bold) 0))
(should-not (erc-nicks--skip-p 'bold '(foo bold) 0))
(should-not (erc-nicks--skip-p '((:inherit bold)) '(bold) 1))
(should (erc-nicks--skip-p 'bold '(bold) 1))
(should (erc-nicks--skip-p 'bold '(fake bold) 1))
(should (erc-nicks--skip-p 'bold '(foo bar bold) 1))
(should (erc-nicks--skip-p '(bold) '(bold) 1))
(should (erc-nicks--skip-p '((bold)) '(bold) 1))
(should (erc-nicks--skip-p '((((bold)))) '(bold) 1))
(should (erc-nicks--skip-p '(bold) '(foo bold) 1))
(should (erc-nicks--skip-p '(:inherit bold) '((:inherit bold)) 1))
(should (erc-nicks--skip-p '((:inherit bold)) '((:inherit bold)) 1))
(should (erc-nicks--skip-p '(((:inherit bold))) '((:inherit bold)) 1))
;; Composed
(should-not (erc-nicks--skip-p '(italic bold) '(bold) 1))
(should-not (erc-nicks--skip-p '((italic) bold) '(bold) 1))
(should-not (erc-nicks--skip-p '(italic (bold)) '(bold) 1))
(should (erc-nicks--skip-p '(italic bold) '(bold) 2))
(should (erc-nicks--skip-p '((italic) bold) '(bold) 2))
(should (erc-nicks--skip-p '(italic (bold)) '(bold) 2))
(should-not (erc-nicks--skip-p '(italic default bold) '(bold) 2))
(should-not (erc-nicks--skip-p '((default italic) bold) '(bold) 2))
(should-not (erc-nicks--skip-p '(italic (default bold)) '(bold) 2))
(should-not (erc-nicks--skip-p '((default italic) (bold shadow)) '(bold) 2))
(should (erc-nicks--skip-p '((default italic) bold) '(bold) 3))
(should (erc-nicks--skip-p '(italic (default bold)) '(bold) 3))
(should (erc-nicks--skip-p '((default italic) (bold shadow)) '(bold) 3))
(should (erc-nicks--skip-p '(italic (default (bold shadow))) '(bold) 3)))
(ert-deftest erc-nicks--trim ()
(should (equal (erc-nicks--trim "Bob`") "bob"))
(should (equal (erc-nicks--trim "Bob``") "bob"))
;; `erc--casemapping-rfc1459'
(let ((erc-nicks-ignore-chars "^"))
(should (equal (erc-nicks--trim "Bob~") "bob^"))
(should (equal (erc-nicks--trim "Bob^") "bob"))))
(defvar erc-nicks-tests--fake-face-list nil)
;; Since we can't delete faces, mock `face-list' to only return those
;; in `erc-nicks--face-table' created by the current test.
(defun erc-nicks-tests--face-list ()
(let ((table (buffer-local-value 'erc-nicks--face-table
(get-buffer "foonet")))
out)
(maphash (lambda (k v)
(when (member k erc-nicks-tests--fake-face-list)
(push v out)))
table)
(nreverse out)))
(defun erc-nicks-tests--create-session (test alice bob)
(should-not (memq 'nicks erc-modules))
(advice-add 'face-list :override #'erc-nicks-tests--face-list)
(let ((erc-modules (cons 'nicks erc-modules))
(inhibit-message noninteractive)
(erc-nicks-tests--fake-face-list
(list (downcase alice) (downcase bob)))
erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
(with-current-buffer
(cl-letf
(((symbol-function 'erc-server-connect)
(lambda (&rest _)
(setq erc-server-process
(start-process "sleep" (current-buffer) "sleep" "1"))
(set-process-query-on-exit-flag erc-server-process nil))))
(erc-open "localhost" 6667 "tester" "Tester" 'connect
nil nil nil nil nil "tester"))
(let ((inhibit-message noninteractive))
(dolist (line (split-string "\
:irc.foonet.org 004 tester irc.foonet.org irc.d abc 123 456
:irc.foonet.org 005 tester NETWORK=foonet :are supported
:irc.foonet.org 376 tester :End of /MOTD command."
"\n"))
(erc-parse-server-response erc-server-process line)))
(with-current-buffer (erc--open-target "#chan")
(erc-update-channel-member
"#chan" alice alice t nil nil nil nil nil "fake" "~u" nil nil t)
(erc-update-channel-member
"#chan" bob bob t nil nil nil nil nil "fake" "~u" nil nil t)
(erc-display-message
nil 'notice (current-buffer)
(concat "This server is in debug mode and is logging all user I/O. "
"Blah " alice " (1) " bob " (2) blah."))
(erc-display-message nil nil (current-buffer)
(erc-format-privmessage bob "Hi Alice" nil t))
(erc-display-message nil nil (current-buffer)
(erc-format-privmessage alice "Hi Bob" nil t)))
(funcall test)
(when noninteractive
(kill-buffer "#chan")
(when (get-buffer " *Custom-Work*")
(kill-buffer " *Custom-Work*"))
(kill-buffer))))
(advice-remove 'face-list #'erc-nicks-tests--face-list))
(ert-deftest erc-nicks-list-faces ()
(erc-nicks-tests--create-session
(lambda ()
(erc-nicks-list-faces)
(let ((table (buffer-local-value 'erc-nicks--face-table
(get-buffer "foonet")))
calls)
(cl-letf (((symbol-function 'erc-nicks--list-faces-help-button-action)
(lambda (&rest r) (push r calls))))
(with-current-buffer "*Faces*"
(set-window-buffer (selected-window) (current-buffer))
(goto-char (point-min))
(ert-info ("Clicking on face link runs action function")
(forward-button 1)
(should (looking-at "erc-nicks-alice1-face"))
(push-button)
(should (eq (car (car calls)) (gethash "alice1" table))))
(ert-info ("Clicking on sample text describes face")
(forward-button 1)
(should (looking-at (rx "#" (+ xdigit))))
(push-button)
(should (search-forward-regexp
(rx "Foreground: #" (group (+ xdigit)) eol)))
(forward-button 1)
(push-button))
(ert-info ("First entry's sample is rendered correctly")
(let ((hex (match-string 1)))
(should (looking-at (concat "#" hex)))
(goto-char (button-end (point)))
(should (looking-back " foonet"))
(should (eq (button-get (1- (point)) 'face) (car (pop calls))))
(should-not calls)))
(ert-info ("Clicking on another entry's face link runs action")
(forward-button 1)
(should (looking-at "erc-nicks-bob1-face"))
(push-button)
(should (eq (car (car calls)) (gethash "bob1" table))))
(ert-info ("Second entry's sample is rendered correctly")
(forward-button 1)
(should (looking-at (rx "#" (+ xdigit))))
(goto-char (button-end (point)))
(should (looking-back " foonet"))
(should (eq (button-get (1- (point)) 'face) (car (pop calls))))
(should-not calls))
(when noninteractive
(kill-buffer))))))
"Alice1" "Bob1"))
(ert-deftest erc-nicks-customize-face ()
(unless (>= emacs-major-version 28)
(ert-skip "Face link required in customize-face buffers"))
(erc-nicks-tests--create-session
(lambda ()
(erc-nicks-list-faces)
(with-current-buffer "*Faces*"
(set-window-buffer (selected-window) (current-buffer))
(goto-char (point-min))
(ert-info ("Clicking on face link runs action function")
(forward-button 1)
(should (looking-at "erc-nicks-alice2"))
(ert-simulate-keys "y\r"
(call-interactively #'push-button nil)))
(with-current-buffer "*Customize Face: Erc Nicks Alice2@Foonet Face*"
(should (search-forward "Erc Nicks Alice2@Foonet Face" nil t))
(widget-button-press (1- (point))))
(with-current-buffer "*New face erc-nicks-alice2@foonet-face*"
(goto-char (point-min))
(should (search-forward "(use-package erc-nicks" nil t))
(should (search-forward ":foreground \"#" nil t))
(when noninteractive
(kill-buffer)))
(with-current-buffer "*Customize Face: Erc Nicks Alice2@Foonet Face*"
(should (search-forward "Foreground: #" nil t))
(when noninteractive
(kill-buffer)))
(when noninteractive
(kill-buffer))))
"Alice2" "Bob2"))
(ert-deftest erc-nicks--gen-key-from-format-spec ()
(let ((erc-network 'OFTC)
(erc-nicks-key-suffix-format "@%-012n")
(erc-server-current-nick "tester"))
(should (equal (erc-nicks--gen-key-from-format-spec "bob")
"bob@OFTC00000000")))
(let ((erc-network 'Libera.Chat)
(erc-nicks-key-suffix-format "@%-012n")
(erc-server-current-nick "tester"))
(should (equal (erc-nicks--gen-key-from-format-spec "bob")
"bob@Libera.Chat0")))
(let* ((erc-network 'Libera.Chat)
(erc-nicks-key-suffix-format "@%n/%m")
(erc-server-current-nick "tester"))
(should (equal (erc-nicks--gen-key-from-format-spec "bob")
"bob@Libera.Chat/tester"))))
(ert-deftest erc-nicks--create-pool ()
(let ((erc-nicks--bg-luminance 1.0)
(erc-nicks--bg-mode-value 'light)
(erc-nicks--fg-rgb '(0.0 0.0 0.0))
(erc-nicks-bg-color "white")
;;
(erc-nicks--colors-rejects '(t)))
;; Reject
(should-not (erc-nicks--create-pool '(erc-nicks-invert) '("white")))
(should (equal (pop erc-nicks--colors-rejects) "white")) ; too close
(should-not (erc-nicks--create-pool '(erc-nicks-cap-contrast) '("black")))
(should (equal (pop erc-nicks--colors-rejects) "black")) ; too far
(should-not (erc-nicks--create-pool '(erc-nicks-ensaturate) '("white")))
(should (equal (pop erc-nicks--colors-rejects) "white")) ; lacks color
(should-not (erc-nicks--create-pool '(erc-nicks-ensaturate) '("red")))
(should (equal (pop erc-nicks--colors-rejects) "red")) ; too much color
;; Safe
(should
(equal (erc-nicks--create-pool '(erc-nicks-invert) '("black"))
'("black")))
(should
(equal (erc-nicks--create-pool '(erc-nicks-add-contrast) '("black"))
'("black")))
(should
(equal (erc-nicks--create-pool '(erc-nicks-cap-contrast) '("white"))
'("white")))
(let ((erc-nicks-saturation-range '(0.5 . 1.0)))
(should
(equal (erc-nicks--create-pool '(erc-nicks-ensaturate) '("green"))
'("green"))))
(let ((erc-nicks-saturation-range '(0.0 . 0.5)))
(should
(equal (erc-nicks--create-pool '(erc-nicks-ensaturate) '("gray"))
'("gray"))))
(unless noninteractive
(should
(equal (erc-nicks--create-pool '(erc-nicks-ensaturate) '("firebrick"))
'("firebrick"))))
(should (equal erc-nicks--colors-rejects '(t)))))
;;; erc-nicks-tests.el ends here

28
test/lisp/erc/erc-scenarios-base-buffer-display.el
View file

@ -26,8 +26,8 @@
(eval-when-compile (require 'erc-join))
;; These first couple `erc-reconnect-display' tests used to live in
;; erc-scenarios-base-reconnect but have since been renamed.
;; These first couple `erc-auto-reconnect-display' tests used to live
;; in erc-scenarios-base-reconnect but have since been renamed.
(defun erc-scenarios-base-buffer-display--reconnect-common
(assert-server assert-chan assert-rest)
@ -80,11 +80,11 @@
:tags '(:expensive-test)
(should (eq erc-buffer-display 'bury))
(should (eq erc-interactive-display 'window))
(should-not erc-reconnect-display)
(should-not erc-auto-reconnect-display)
(let ((erc-buffer-display 'window)
(erc-interactive-display 'buffer)
(erc-reconnect-display 'bury))
(erc-auto-reconnect-display 'bury))
(erc-scenarios-base-buffer-display--reconnect-common
@ -104,7 +104,7 @@
;; A manual /JOIN command tells ERC we're done auto-reconnecting
(with-current-buffer "FooNet" (erc-scenarios-common-say "/JOIN #spam"))
(ert-info ("#spam ignores `erc-reconnect-display'")
(ert-info ("#spam ignores `erc-auto-reconnect-display'")
;; Uses `erc-interactive-display' instead.
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))
(should (eq (window-buffer) (get-buffer "#spam")))
@ -115,10 +115,10 @@
:tags '(:expensive-test)
(should (eq erc-buffer-display 'bury))
(should (eq erc-interactive-display 'window))
(should-not erc-reconnect-display)
(should-not erc-auto-reconnect-display)
(let ((erc-buffer-display 'window-noselect)
(erc-reconnect-display 'bury)
(erc-auto-reconnect-display 'bury)
(erc-interactive-display 'buffer))
(erc-scenarios-base-buffer-display--reconnect-common
@ -155,7 +155,7 @@
(should (eq (window-buffer) (get-buffer "bob")))
(should (frame-root-window-p (selected-window)))))
(ert-info ("Newly joined chan ignores `erc-reconnect-display'")
(ert-info ("Newly joined chan ignores `erc-auto-reconnect-display'")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))
(should (eq (window-buffer) (get-buffer "bob")))
(should-not (frame-root-window-p (selected-window)))
@ -165,13 +165,13 @@
:tags '(:expensive-test)
(should (eq erc-buffer-display 'bury))
(should (eq erc-interactive-display 'window))
(should (eq erc-reconnect-display-timeout 10))
(should-not erc-reconnect-display)
(should (eq erc-auto-reconnect-display-timeout 10))
(should-not erc-auto-reconnect-display)
(let ((erc-buffer-display 'window-noselect)
(erc-reconnect-display 'bury)
(erc-auto-reconnect-display 'bury)
(erc-interactive-display 'buffer)
(erc-reconnect-display-timeout 0.5))
(erc-auto-reconnect-display-timeout 0.5))
(erc-scenarios-base-buffer-display--reconnect-common
#'ignore #'ignore ; These two are identical to the previous test.
@ -188,10 +188,10 @@
(erc-d-t-wait-for 1 (null erc--server-reconnect-display-timer))
(erc-cmd-JOIN "#spam")))
(ert-info ("Newly joined chan ignores `erc-reconnect-display'")
(ert-info ("Newly joined chan ignores `erc-auto-reconnect-display'")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))
(should (eq (window-buffer) (messages-buffer)))
;; If `erc-reconnect-display-timeout' were left alone, this
;; If `erc-auto-reconnect-display-timeout' were left alone, this
;; would be (frame-root-window-p #<window 1 on *scratch*>).
(should-not (frame-root-window-p (selected-window)))
(should (eq (current-buffer) (window-buffer (next-window))))))))))

66
test/lisp/erc/erc-scenarios-join-display-context.el Normal file
View file

@ -0,0 +1,66 @@
;;; erc-scenarios-join-display-context.el --- buffer-display autojoin ctx -*- 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)
(eval-and-compile
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-scenarios-common)))
(ert-deftest erc-scenarios-join-display-context--errors ()
:tags '(:expensive-test)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "join/buffer-display")
(erc-server-flood-penalty 0.1)
(dumb-server (erc-d-run "localhost" t 'mode-context))
(port (process-contact dumb-server :service))
(erc-buffer-display (lambda (buf action)
(when (equal
(alist-get 'erc-autojoin-mode action)
"#chan")
(pop-to-buffer buf))))
(erc-autojoin-channels-alist '((foonet "#chan" "#spam" "#foo")))
(expect (erc-d-t-make-expecter)))
(ert-info ("Connect without password")
(with-current-buffer (erc :server "127.0.0.1"
:port port
:nick "tester"
:full-name "tester")
(should (string= (buffer-name) (format "127.0.0.1:%d" port)))
;; FIXME test for effect rather than inspecting interval variables.
(erc-d-t-wait-for 10 (equal erc-join--requested-channels
'("#foo" "#spam" "#chan")))
(funcall expect 10 "Max occupancy for channel #spam exceeded")
(funcall expect 10 "Channel #foo is invitation only")))
(ert-info ("New #chan buffer displayed in new window")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
(should (eq (window-buffer) (current-buffer)))
(funcall expect 10 "#chan was created on")))
;; FIXME find a less dishonest way to do this than inspecting
;; interval variables.
(ert-info ("Ensure channels no longer tracked")
(should-not erc-join--requested-channels))))
;;; erc-scenarios-join-display-context.el ends here

257
test/lisp/erc/erc-scenarios-match.el
View file

@ -24,8 +24,12 @@
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-scenarios-common)))
(eval-when-compile
(require 'erc-join)
(require 'erc-match))
(require 'erc-stamp)
(require 'erc-match)
(require 'erc-fill)
;; This defends against a regression in which all matching by the
;; `erc-match-message' fails when `erc-add-timestamp' precedes it in
@ -57,28 +61,23 @@
(should (eq (get-text-property (1- (point)) 'font-lock-face)
'erc-current-nick-face))))))
;; This asserts that when stamps appear before a message,
;; some non-nil invisibility property spans the entire message.
(ert-deftest erc-scenarios-match--stamp-left-fools-invisible ()
:tags '(:expensive-test)
(ert-skip "WIP: fix included in bug#64301")
;; When hacking on tests that use this fixture, it's best to run it
;; interactively, and check for wierdness before and after doing
;; M-: (remove-from-invisibility-spec 'erc-match) RET.
(defun erc-scenarios-match--invisible-stamp (hiddenp visiblep)
(unless noninteractive
(kill-new "(remove-from-invisibility-spec 'erc-match)"))
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "join/legacy")
(dumb-server (erc-d-run "localhost" t 'foonet))
(port (process-contact dumb-server :service))
(erc-server-flood-penalty 0.1)
(erc-insert-timestamp-function 'erc-insert-timestamp-left)
(erc-timestamp-only-if-changed-flag nil)
(erc-fools '("bob"))
(erc-text-matched-hook '(erc-hide-fools))
(erc-autojoin-channels-alist '((FooNet "#chan")))
(expect (erc-d-t-make-expecter))
(hiddenp (lambda ()
(and (eq (field-at-pos (pos-bol)) 'erc-timestamp)
(get-text-property (pos-bol) 'invisible)
(>= (next-single-property-change (pos-bol)
'invisible nil)
(pos-eol))))))
(expect (erc-d-t-make-expecter)))
(ert-info ("Connect")
(with-current-buffer (erc :server "127.0.0.1"
@ -94,30 +93,242 @@
(ert-info ("Ensure lines featuring \"bob\" are invisible")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
(should (funcall expect 10 "<bob> tester, welcome!"))
(should (funcall hiddenp))
(ert-info ("<bob> tester, welcome!") (funcall hiddenp))
;; Alice's is the only one visible.
(should (funcall expect 10 "<alice> tester, welcome!"))
(should (eq (field-at-pos (pos-bol)) 'erc-timestamp))
(should (get-text-property (pos-bol) 'invisible))
(should-not (get-text-property (point) 'invisible))
(ert-info ("<alice> tester, welcome!") (funcall visiblep))
(should (funcall expect 10 "<bob> alice: But, as it seems"))
(should (funcall hiddenp))
(ert-info ("<bob> alice: But, as it seems") (funcall hiddenp))
(should (funcall expect 10 "<alice> bob: Well, this is the forest"))
(should (funcall hiddenp))
(ert-info ("<alice> bob: Well, this is the forest") (funcall hiddenp))
(should (funcall expect 10 "<alice> bob: And will you"))
(should (funcall hiddenp))
(ert-info ("<alice> bob: And will you") (funcall hiddenp))
(should (funcall expect 10 "<bob> alice: Live, and be prosperous"))
(should (funcall hiddenp))
(ert-info ("<bob> alice: Live, and be prosperous") (funcall hiddenp))
(should (funcall expect 10 "ERC>"))
(should-not (get-text-property (pos-bol) 'invisible))
(should-not (get-text-property (point) 'invisible))))))
(eval-when-compile (require 'erc-join))
;; This asserts that when stamps appear before a message, registered
;; invisibility properties owned by modules span the entire message.
(ert-deftest erc-scenarios-match--stamp-left-fools-invisible ()
:tags '(:expensive-test)
(let ((erc-insert-timestamp-function #'erc-insert-timestamp-left))
(erc-scenarios-match--invisible-stamp
(lambda ()
;; This is a time-stamped message.
(should (eq (field-at-pos (pos-bol)) 'erc-timestamp))
;; Leading stamp has combined `invisible' property value.
(should (equal (get-text-property (pos-bol) 'invisible)
'(timestamp erc-match)))
;; Message proper has the `invisible' property `erc-match'.
(let ((msg-beg (next-single-property-change (pos-bol) 'invisible)))
(should (eq (get-text-property msg-beg 'invisible) 'erc-match))
(should (>= (next-single-property-change msg-beg 'invisible nil)
(pos-eol)))))
(lambda ()
;; This is a time-stamped message.
(should (eq (field-at-pos (pos-bol)) 'erc-timestamp))
(should (get-text-property (pos-bol) 'invisible))
;; The entire message proper is visible.
(let ((msg-beg (next-single-property-change (pos-bol) 'invisible)))
(should
(= (next-single-property-change msg-beg 'invisible nil (pos-eol))
(pos-eol))))))))
(defun erc-scenarios-match--find-eol ()
(save-excursion
(goto-char (next-single-property-change (point) 'erc-command))
(pos-eol)))
;; In most cases, `erc-hide-fools' makes line endings invisible.
(ert-deftest erc-scenarios-match--stamp-right-fools-invisible ()
:tags '(:expensive-test)
(let ((erc-insert-timestamp-function #'erc-insert-timestamp-right))
(erc-scenarios-match--invisible-stamp
(lambda ()
(let ((end (erc-scenarios-match--find-eol)))
;; The end of the message is a newline.
(should (= ?\n (char-after end)))
;; Every message has a trailing time stamp.
(should (eq (field-at-pos (1- end)) 'erc-timestamp))
;; Stamps have a combined `invisible' property value.
(should (equal (get-text-property (1- end) 'invisible)
'(timestamp erc-match)))
;; The final newline is hidden by `match', not `stamps'
(should (equal (get-text-property end 'invisible) 'erc-match))
;; The message proper has the `invisible' property `erc-match',
;; and it starts after the preceding newline.
(should (eq (get-text-property (pos-bol) 'invisible) 'erc-match))
;; It ends just before the timestamp.
(let ((msg-end (next-single-property-change (pos-bol) 'invisible)))
(should (equal (get-text-property msg-end 'invisible)
'(timestamp erc-match)))
;; Stamp's `invisible' property extends throughout the stamp
;; and ends before the trailing newline.
(should (= (next-single-property-change msg-end 'invisible) end)))))
(lambda ()
(let ((end (erc-scenarios-match--find-eol)))
;; This message has a time stamp like all the others.
(should (eq (field-at-pos (1- end)) 'erc-timestamp))
;; The entire message proper is visible.
(should-not (get-text-property (pos-bol) 'invisible))
(let ((inv-beg (next-single-property-change (pos-bol) 'invisible)))
(should (eq (get-text-property inv-beg 'invisible)
'timestamp))))))))
;; This asserts that when `erc-fill-wrap-mode' is enabled, ERC hides
;; the preceding message's line ending.
(ert-deftest erc-scenarios-match--stamp-right-invisible-fill-wrap ()
:tags '(:expensive-test)
(let ((erc-insert-timestamp-function #'erc-insert-timestamp-right)
(erc-fill-function #'erc-fill-wrap))
(erc-scenarios-match--invisible-stamp
(lambda ()
;; Every message has a trailing time stamp.
(should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
;; Stamps appear in the right margin.
(should (equal (car (get-text-property (1- (pos-eol)) 'display))
'(margin right-margin)))
;; Stamps have a combined `invisible' property value.
(should (equal (get-text-property (1- (pos-eol)) 'invisible)
'(timestamp erc-match)))
;; The message proper has the `invisible' property `erc-match',
;; which starts at the preceding newline...
(should (eq (get-text-property (1- (pos-bol)) 'invisible) 'erc-match))
;; ... and ends just before the timestamp.
(let ((msgend (next-single-property-change (1- (pos-bol)) 'invisible)))
(should (equal (get-text-property msgend 'invisible)
'(timestamp erc-match)))
;; The newline before `erc-insert-marker' is still visible.
(should-not (get-text-property (pos-eol) 'invisible))
(should (= (next-single-property-change msgend 'invisible)
(pos-eol)))))
(lambda ()
;; This message has a time stamp like all the others.
(should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
;; Unlike hidden messages, the preceding newline is visible.
(should-not (get-text-property (1- (pos-bol)) 'invisible))
;; The entire message proper is visible.
(let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible)))
(should (eq (get-text-property inv-beg 'invisible) 'timestamp)))))))
(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static ()
:tags '(:expensive-test)
(should (eq erc-insert-timestamp-function
#'erc-insert-timestamp-left-and-right))
;; Rewind the clock to known date artificially.
(let ((erc-stamp--current-time 704591940)
(erc-stamp--tz t)
(erc-fill-function #'erc-fill-static)
(bob-utterance-counter 0))
(erc-scenarios-match--invisible-stamp
(lambda ()
(ert-info ("Baseline check")
;; False date printed initially before anyone speaks.
(when (zerop bob-utterance-counter)
(save-excursion
(goto-char (point-min))
(search-forward "[Wed Apr 29 1992]")
(search-forward "[23:59]"))))
(ert-info ("Line endings in Bob's messages are invisible")
;; The message proper has the `invisible' property `erc-match'.
(should (eq (get-text-property (pos-bol) 'invisible) 'erc-match))
(let* ((mbeg (next-single-property-change (pos-bol) 'erc-command))
(mend (next-single-property-change mbeg 'erc-command)))
(if (/= 1 bob-utterance-counter)
(should-not (field-at-pos mend))
;; For Bob's stamped message, check newline after stamp.
(should (eq (field-at-pos mend) 'erc-timestamp))
(setq mend (field-end mend)))
;; The `erc-timestamp' property spans entire messages,
;; including stamps and filled text, which makes for
;; convenient traversal when `erc-stamp-mode' is enabled.
(should (get-text-property (pos-bol) 'erc-timestamp))
(should (= (next-single-property-change (pos-bol) 'erc-timestamp)
mend))
;; Line ending has the `invisible' property `erc-match'.
(should (= (char-after mend) ?\n))
(should (eq (get-text-property mend'invisible) 'erc-match))))
;; Only the message right after Alice speaks contains stamps.
(when (= 1 bob-utterance-counter)
(ert-info ("Date stamp occupying previous line is invisible")
(save-excursion
(forward-line -1)
(goto-char (pos-bol))
(should (looking-at (rx "[Mon May 4 1992]")))
;; Date stamp has a combined `invisible' property value
;; that extends until the start of the message proper.
(should (equal (get-text-property (point) 'invisible)
'(timestamp erc-match)))
(should (= (next-single-property-change (point) 'invisible)
(1+ (pos-eol))))))
(ert-info ("Folding preserved despite invisibility")
;; Message has a trailing time stamp, but it's been folded
;; over to the next line.
(should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
(save-excursion
(forward-line)
(should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)))
;; Stamp invisibility starts where message's ends.
(let ((msgend (next-single-property-change (pos-bol) 'invisible)))
;; Stamp has a combined `invisible' property value.
(should (equal (get-text-property msgend 'invisible)
'(timestamp erc-match)))
;; Combined `invisible' property spans entire timestamp.
(should (= (next-single-property-change msgend 'invisible)
(save-excursion (forward-line) (pos-eol)))))))
(cl-incf bob-utterance-counter))
;; Alice.
(lambda ()
;; Set clock ahead a week or so.
(setq erc-stamp--current-time 704962800)
;; This message has no time stamp and is completely visible.
(should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
(should-not (next-single-property-change (pos-bol) 'invisible))))))
;;; erc-scenarios-match.el ends here

169
test/lisp/erc/erc-scenarios-status-sidebar.el Normal file
View file

@ -0,0 +1,169 @@
;;; erc-scenarios-status-sidebar.el --- erc-sidebar/speedbar 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/>.
;;; Code:
(require 'ert-x)
(eval-and-compile
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-scenarios-common)))
(require 'erc-status-sidebar)
(ert-deftest erc-scenarios-status-sidebar--bufbar ()
:tags '(:expensive-test)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "base/gapless-connect")
(erc-server-flood-penalty 0.1)
(erc-server-flood-penalty erc-server-flood-penalty)
(erc-modules `(bufbar ,@erc-modules))
(dumb-server (erc-d-run "localhost" t 'foonet 'barnet))
(port (process-contact dumb-server :service))
(expect (erc-d-t-make-expecter)))
(ert-info ("Connect to two different endpoints")
(with-current-buffer (erc :server "127.0.0.1"
:port port
:nick "tester"
:password "foonet:changeme"
:full-name "tester")
(funcall expect 10 "MOTD File is missing"))
(with-current-buffer (erc :server "127.0.0.1"
:port port
:nick "tester"
:password "barnet:changeme"
:full-name "tester")
(funcall expect 10 "marked as being away")))
(with-current-buffer (erc-d-t-wait-for 20 (get-buffer "#bar"))
(funcall expect 10 "was created on")
(funcall expect 2 "his second fit"))
(with-current-buffer (erc-d-t-wait-for 20 (get-buffer "#foo"))
(funcall expect 10 "was created on")
(funcall expect 2 "no use of him")
(ert-info ("Activity marker is in the right spot")
(let ((obuf (window-buffer))) ; *scratch*
(set-window-buffer (selected-window) "#foo")
(erc-d-t-wait-for 5
(when noninteractive
(erc-status-sidebar-refresh))
(with-current-buffer "*ERC Status*"
(and (marker-position erc-status-sidebar--active-marker)
(goto-char erc-status-sidebar--active-marker)
;; The " [N]" suffix disappears because it's selected
(search-forward "#foo" (pos-eol) t))))
(set-window-buffer (selected-window) obuf))))
(with-current-buffer (erc-d-t-wait-for 20 (get-buffer "*ERC Status*"))
(ert-info ("Hierarchy printed correctly")
(funcall expect 10 "barnet [")
(funcall expect 10 "#bar [")
(funcall expect 10 "foonet [")
(funcall expect 10 "#foo")))
(with-current-buffer "#foo"
(ert-info ("Core toggle and kill commands work")
;; Avoid using API, e.g., `erc-status-sidebar-buffer-exists-p',
;; etc. for testing commands that call those same functions.
(should (get-buffer-window "*ERC Status*"))
(erc-bufbar-mode -1)
(should-not (get-buffer-window "*ERC Status*"))
(erc-status-sidebar-kill)
(should-not (get-buffer "*ERC Status*"))))))
;; We can't currently run this on EMBA because it needs a usable
;; terminal, and we lack a fixture for that. Please try running this
;; test interactively with both graphical Emacs and non.
(declare-function erc-nickbar-mode "erc-speedbar" (arg))
(declare-function erc-speedbar-close-nicknames-window "erc-speedbar" (kill))
(declare-function speedbar-timer-fn "speedbar" nil)
(defvar erc-nickbar-mode)
(defvar speedbar-buffer)
(ert-deftest erc-scenarios-status-sidebar--nickbar ()
:tags '(:unstable :expensive-test)
(when noninteractive (ert-skip "Interactive only"))
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "base/gapless-connect")
(erc-server-flood-penalty 0.1)
(erc-server-flood-penalty erc-server-flood-penalty)
(erc-modules `(nickbar ,@erc-modules))
(dumb-server (erc-d-run "localhost" t 'foonet 'barnet))
(port (process-contact dumb-server :service))
(expect (erc-d-t-make-expecter)))
(ert-info ("Connect to two different endpoints")
(with-current-buffer (erc :server "127.0.0.1"
:port port
:nick "tester"
:password "foonet:changeme"
:full-name "tester")
(funcall expect 10 "MOTD File is missing"))
(with-current-buffer (erc :server "127.0.0.1"
:port port
:nick "tester"
:password "barnet:changeme"
:full-name "tester")
(funcall expect 10 "marked as being away")))
(erc-d-t-wait-for 20 (get-buffer "#bar"))
(with-current-buffer (pop-to-buffer "#bar")
(funcall expect 10 "was created on")
(funcall expect 2 "his second fit")
(erc-d-t-wait-for 10 (and speedbar-buffer (get-buffer speedbar-buffer)))
(speedbar-timer-fn)
(with-current-buffer speedbar-buffer
(funcall expect 10 "#bar (3)")
(funcall expect 10 '(| "@mike" "joe"))
(funcall expect 10 '(| "@mike" "joe"))
(funcall expect 10 "tester")))
(erc-d-t-wait-for 20 (get-buffer "#foo"))
(with-current-buffer (pop-to-buffer "#foo")
(delete-other-windows)
(funcall expect 10 "was created on")
(funcall expect 2 "no use of him")
(speedbar-timer-fn)
(with-current-buffer speedbar-buffer
(funcall expect 10 "#foo (3)")
(funcall expect 10 '(| "alice" "@bob"))
(funcall expect 10 '(| "alice" "@bob"))
(funcall expect 10 "tester")))
(with-current-buffer "#foo"
(ert-info ("Core toggle and kill commands work")
;; Avoid using API, e.g., `erc-status-sidebar-buffer-exists-p',
;; etc. for testing commands that call those same functions.
(erc-nickbar-mode -1)
(should-not (and speedbar-buffer
(get-buffer-window speedbar-buffer)))
(erc-nickbar-mode +1)
(should (and speedbar-buffer
(get-buffer-window speedbar-buffer)))
(should (get-buffer " SPEEDBAR"))
(erc-speedbar-close-nicknames-window 'kill)
(should-not (get-buffer " SPEEDBAR"))
(should-not erc-nickbar-mode)
(should-not (cdr (frame-list)))))))
;;; erc-scenarios-status-sidebar.el ends here

241
test/lisp/erc/erc-tests.el
View file

@ -129,6 +129,15 @@
(advice-remove 'buffer-local-value 'erc-with-server-buffer)))
(ert-deftest erc--with-dependent-type-match ()
(should (equal (macroexpand-1
'(erc--with-dependent-type-match (repeat face) erc-match))
'(backquote
(repeat :match ,(lambda (w v)
(require 'erc-match)
(widget-editable-list-match w v))
face)))))
(defun erc-tests--send-prep ()
;; Caller should probably shadow `erc-insert-modify-hook' or
;; populate user tables for erc-button.
@ -418,8 +427,9 @@
(should (looking-at-p (regexp-quote "*** Welcome"))))
(ert-info ("Reconnect")
(erc-open "localhost" 6667 "tester" "Tester" nil
"fake" nil "#chan" proc nil "user" nil)
(with-current-buffer (erc-server-buffer)
(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")
@ -503,6 +513,50 @@
(dolist (b '("server" "other" "#chan" "#foo" "#fake"))
(kill-buffer b))))
(ert-deftest erc-setup-buffer--custom-action ()
(erc-mode)
(erc-tests--set-fake-server-process "sleep" "1")
(setq erc--server-last-reconnect-count 0)
(let ((owin (selected-window))
(obuf (window-buffer))
(mbuf (messages-buffer))
calls)
(cl-letf (((symbol-function 'switch-to-buffer) ; regression
(lambda (&rest r) (push (cons 'switch-to-buffer r) calls)))
((symbol-function 'erc--test-fun)
(lambda (&rest r) (push (cons 'erc--test-fun r) calls)))
((symbol-function 'display-buffer)
(lambda (&rest r) (push (cons 'display-buffer r) calls))))
;; Baseline
(let ((erc-join-buffer 'bury))
(erc-setup-buffer mbuf)
(should-not calls))
(should-not erc--display-context)
;; `display-buffer'
(let ((erc--display-context '((erc-buffer-display . 1)))
(erc-join-buffer 'erc--test-fun))
(erc-setup-buffer mbuf)
(should (equal `(erc--test-fun ,mbuf (nil (erc-buffer-display . 1)))
(pop calls)))
(should-not calls))
;; `pop-to-buffer' with `erc-auto-reconnect-display'
(let* ((erc--server-last-reconnect-count 1)
(erc--display-context '((erc-buffer-display . 1)))
(erc-auto-reconnect-display 'erc--test-fun))
(erc-setup-buffer mbuf)
(should (equal `(erc--test-fun ,mbuf
(nil (erc-auto-reconnect-display . t)
(erc-buffer-display . 1)))
(pop calls)))
(should-not calls)))
(should (eq owin (selected-window)))
(should (eq obuf (window-buffer)))))
(ert-deftest erc-lurker-maybe-trim ()
(let (erc-lurker-trim-nicks
(erc-lurker-ignore-chars "_`"))
@ -1218,6 +1272,52 @@
(should-not calls))))))
(ert-deftest erc--split-string-shell-cmd ()
;; Leading and trailing space
(should (equal (erc--split-string-shell-cmd "1 2 3") '("1" "2" "3")))
(should (equal (erc--split-string-shell-cmd " 1 2 3 ") '("1" "2" "3")))
;; Empty string
(should (equal (erc--split-string-shell-cmd "\"\"") '("")))
(should (equal (erc--split-string-shell-cmd " \"\" ") '("")))
(should (equal (erc--split-string-shell-cmd "1 \"\"") '("1" "")))
(should (equal (erc--split-string-shell-cmd "1 \"\" ") '("1" "")))
(should (equal (erc--split-string-shell-cmd "\"\" 1") '("" "1")))
(should (equal (erc--split-string-shell-cmd " \"\" 1") '("" "1")))
(should (equal (erc--split-string-shell-cmd "''") '("")))
(should (equal (erc--split-string-shell-cmd " '' ") '("")))
(should (equal (erc--split-string-shell-cmd "1 ''") '("1" "")))
(should (equal (erc--split-string-shell-cmd "1 '' ") '("1" "")))
(should (equal (erc--split-string-shell-cmd "'' 1") '("" "1")))
(should (equal (erc--split-string-shell-cmd " '' 1") '("" "1")))
;; Backslash
(should (equal (erc--split-string-shell-cmd "\\ ") '(" ")))
(should (equal (erc--split-string-shell-cmd " \\ ") '(" ")))
(should (equal (erc--split-string-shell-cmd "1\\ ") '("1 ")))
(should (equal (erc--split-string-shell-cmd "1\\ 2") '("1 2")))
;; Embedded
(should (equal (erc--split-string-shell-cmd "\"\\\"\"") '("\"")))
(should (equal (erc--split-string-shell-cmd "1 \"2 \\\" \\\" 3\"")
'("1" "2 \" \" 3")))
(should (equal (erc--split-string-shell-cmd "1 \"2 ' ' 3\"")
'("1" "2 ' ' 3")))
(should (equal (erc--split-string-shell-cmd "1 '2 \" \" 3'")
'("1" "2 \" \" 3")))
(should (equal (erc--split-string-shell-cmd "1 '2 \\ 3'")
'("1" "2 \\ 3")))
(should (equal (erc--split-string-shell-cmd "1 \"2 \\\\ 3\"")
'("1" "2 \\ 3"))) ; see comment re ^
;; Realistic
(should (equal (erc--split-string-shell-cmd "GET bob \"my file.txt\"")
'("GET" "bob" "my file.txt")))
(should (equal (erc--split-string-shell-cmd "GET EXAMPLE|bob \"my file.txt\"")
'("GET" "EXAMPLE|bob" "my file.txt")))) ; regression
;; The behavior of `erc-pre-send-functions' differs between versions
;; in how hook members see and influence a trailing newline that's
@ -1388,6 +1488,49 @@
(kill-buffer "ExampleNet")
(kill-buffer "#chan")))
(defmacro erc-tests--equal-including-properties (a b)
(list (if (< emacs-major-version 29)
'ert-equal-including-properties
'equal-including-properties)
a b))
(ert-deftest erc-format-privmessage ()
;; Basic PRIVMSG
(should (erc-tests--equal-including-properties
(erc-format-privmessage (copy-sequence "bob")
(copy-sequence "oh my")
nil 'msgp)
#("<bob> oh my"
0 1 (font-lock-face erc-default-face)
1 4 (erc-speaker "bob" font-lock-face erc-nick-default-face)
4 11 (font-lock-face erc-default-face))))
;; Basic NOTICE
(should (erc-tests--equal-including-properties
(erc-format-privmessage (copy-sequence "bob")
(copy-sequence "oh my")
nil nil)
#("-bob- oh my"
0 1 (font-lock-face erc-default-face)
1 4 (erc-speaker "bob" font-lock-face erc-nick-default-face)
4 11 (font-lock-face erc-default-face))))
;; Prefixed PRIVMSG
(let* ((user (make-erc-server-user :nickname (copy-sequence "Bob")))
(cuser (make-erc-channel-user :op t))
(erc-channel-users (make-hash-table :test #'equal)))
(puthash "bob" (cons user cuser) erc-channel-users)
(should (erc-tests--equal-including-properties
(erc-format-privmessage (erc-format-@nick user cuser)
(copy-sequence "oh my")
nil 'msgp)
#("<@Bob> oh my"
0 1 (font-lock-face erc-default-face)
1 2 (font-lock-face erc-nick-prefix-face help-echo "operator")
2 5 (erc-speaker "Bob" font-lock-face erc-nick-default-face)
5 12 (font-lock-face erc-default-face))))))
(defvar erc-tests--ipv6-examples
'("1:2:3:4:5:6:7:8"
"::ffff:10.0.0.1" "::ffff:1.2.3.4" "::ffff:0.0.0.0"
@ -1439,14 +1582,18 @@
(erc-join-buffer . window))))))
(ert-info ("Switches to TLS when URL is ircs://")
(should (equal (ert-simulate-keys "ircs://irc.gnu.org\r\r\r\r"
(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 . window))))))
(let ((erc--display-context '((erc-interactive-display . erc))))
(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)
'&interactive-env
'((erc-server-connect-function
. erc-open-tls-stream)
(erc--display-context
. ((erc-interactive-display . erc)))
(erc-join-buffer . window)))))))
(setq-local erc-interactive-display nil) ; cheat to save space
@ -1526,6 +1673,7 @@
((symbol-function 'erc-open)
(lambda (&rest r)
(push `((erc-join-buffer ,erc-join-buffer)
(erc--display-context ,@erc--display-context)
(erc-server-connect-function
,erc-server-connect-function))
env)
@ -1538,6 +1686,7 @@
nil nil nil nil nil "user" nil)))
(should (equal (pop env)
'((erc-join-buffer bury)
(erc--display-context (erc-buffer-display . erc-tls))
(erc-server-connect-function erc-open-tls-stream)))))
(ert-info ("Full")
@ -1554,6 +1703,7 @@
"bob:changeme" nil nil nil t "bobo" GNU.org)))
(should (equal (pop env)
'((erc-join-buffer bury)
(erc--display-context (erc-buffer-display . erc-tls))
(erc-server-connect-function erc-open-tls-stream)))))
;; Values are often nil when called by lisp code, which leads to
@ -1573,6 +1723,7 @@
"bob:changeme" nil nil nil nil "bobo" nil)))
(should (equal (pop env)
'((erc-join-buffer bury)
(erc--display-context (erc-buffer-display . erc-tls))
(erc-server-connect-function erc-open-tls-stream)))))
(ert-info ("Interactive")
@ -1583,6 +1734,8 @@
nil nil nil nil "user" nil)))
(should (equal (pop env)
'((erc-join-buffer window)
(erc--display-context
(erc-interactive-display . erc-tls))
(erc-server-connect-function erc-open-tls-stream)))))
(ert-info ("Custom connect function")
@ -1593,6 +1746,8 @@
nil nil nil nil nil "user" nil)))
(should (equal (pop env)
'((erc-join-buffer bury)
(erc--display-context
(erc-buffer-display . erc-tls))
(erc-server-connect-function my-connect-func))))))
(ert-info ("Advised default function overlooked") ; intentional
@ -1604,6 +1759,7 @@
nil nil nil nil nil "user" nil)))
(should (equal (pop env)
'((erc-join-buffer bury)
(erc--display-context (erc-buffer-display . erc-tls))
(erc-server-connect-function erc-open-tls-stream))))
(advice-remove 'erc-server-connect-function 'erc-tests--erc-tls))
@ -1617,6 +1773,8 @@
'("irc.libera.chat" 6697 "tester" "unknown" t
nil nil nil nil nil "user" nil)))
(should (equal (pop env) `((erc-join-buffer bury)
(erc--display-context
(erc-buffer-display . erc-tls))
(erc-server-connect-function ,f))))
(advice-remove 'erc-server-connect-function
'erc-tests--erc-tls)))))))
@ -1631,6 +1789,7 @@
((symbol-function 'erc-open)
(lambda (&rest r)
(push `((erc-join-buffer ,erc-join-buffer)
(erc--display-context ,@erc--display-context)
(erc-server-connect-function
,erc-server-connect-function))
env)
@ -1643,8 +1802,9 @@
'("irc.libera.chat" 6697 "tester" "unknown" t nil
nil nil nil nil "user" nil)))
(should (equal (pop env)
'((erc-join-buffer window) (erc-server-connect-function
erc-open-tls-stream)))))
'((erc-join-buffer window)
(erc--display-context (erc-interactive-display . erc))
(erc-server-connect-function erc-open-tls-stream)))))
(ert-info ("Nick supplied, decline TLS upgrade")
(ert-simulate-keys "\r\rdummy\r\rn\r"
@ -1654,6 +1814,45 @@
nil nil nil nil "user" nil)))
(should (equal (pop env)
'((erc-join-buffer window)
(erc--display-context (erc-interactive-display . erc))
(erc-server-connect-function
erc-open-network-stream))))))))
(ert-deftest erc-server-select ()
(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--display-context ,@erc--display-context)
(erc-server-connect-function
,erc-server-connect-function))
env)
(push r calls))))
(ert-info ("Selects Libera.Chat Europe, automatic TSL")
(ert-simulate-keys "Libera.Chat\rirc.eu.\t\r\r\r"
(with-suppressed-warnings ((obsolete erc-server-select))
(call-interactively #'erc-server-select)))
(should (equal (pop calls)
'("irc.eu.libera.chat" 6697 "tester" "unknown" t nil
nil nil nil nil "user" nil)))
(should (equal (pop env)
'((erc-join-buffer window)
(erc--display-context (erc-interactive-display . erc))
(erc-server-connect-function erc-open-tls-stream)))))
(ert-info ("Selects entry that doesn't support TLS")
(ert-simulate-keys "IRCnet\rirc.fr.\t\rdummy\r\r"
(with-suppressed-warnings ((obsolete erc-server-select))
(call-interactively #'erc-server-select)))
(should (equal (pop calls)
'("irc.fr.ircnet.net" 6667 "dummy" "unknown" t nil
nil nil nil nil "user" nil)))
(should (equal (pop env)
'((erc-join-buffer window)
(erc--display-context (erc-interactive-display . erc))
(erc-server-connect-function
erc-open-network-stream))))))))
@ -1752,9 +1951,9 @@
(kill-buffer "#chan")))
(defconst erc-tests--modules
'( autoaway autojoin button capab-identify completion dcc fill identd
'( autoaway autojoin bufbar 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
networks nickbar nicks noncommands notifications notify page readonly
replace ring sasl scrolltobottom services smiley sound
spelling stamp track truncate unmorse xdcc))
@ -2005,9 +2204,10 @@ Some docstring."
:group (erc--find-group 'mname 'malias)
:require 'nil
:type "mname"
(if erc-mname-mode
(erc-mname-enable)
(erc-mname-disable)))
(let ((erc--module-toggle-prefix-arg arg))
(if erc-mname-mode
(erc-mname-enable)
(erc-mname-disable))))
(defun erc-mname-enable ()
"Enable ERC mname mode."
@ -2060,9 +2260,10 @@ ARG is omitted or nil.
Some docstring."
:global nil
:group (erc--find-group 'mname nil)
(if erc-mname-mode
(erc-mname-enable)
(erc-mname-disable)))
(let ((erc--module-toggle-prefix-arg arg))
(if erc-mname-mode
(erc-mname-enable)
(erc-mname-disable))))
(defun erc-mname-enable (&optional ,arg-en)
"Enable ERC mname mode.

8
test/lisp/erc/resources/base/gapless-connect/foonet.eld
View file

@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*-
((pass 1 "PASS :foonet:changeme"))
((nick 1 "NICK tester"))
((user 1 "USER user 0 * :tester")
((pass 10 "PASS :foonet:changeme"))
((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 Sun, 25 Apr 2021 11:28:28 UTC")
@ -21,7 +21,7 @@
;; No mode answer
(0 ":irc.znc.in 306 tester :You have been marked as being away")
(0 ":tester!~u@xrir8fpe4d7ak.irc JOIN #foo")
(0 ":irc.foonet.org 353 tester = #foo :joe @mike tester")
(0 ":irc.foonet.org 353 tester = #foo :alice @bob tester")
(0 ":irc.foonet.org 366 tester #foo :End of /NAMES list.")
(0 ":***!znc@znc.in PRIVMSG #foo :Buffer Playback...")
(0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :[07:02:41] bob: To-morrow is the joyful day, Audrey; to-morrow will we be married.")

38
test/lisp/erc/resources/join/buffer-display/mode-context.eld Normal file
View file

@ -0,0 +1,38 @@
;; -*- mode: lisp-data; -*-
((nick 1 "NICK tester"))
((user 1 "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.8.0")
(0.00 ":irc.foonet.org 003 tester :This server was created Tue, 24 May 2022 05:28:42 UTC")
(0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.8.0 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=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
(0.01 ":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:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
(0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
(0.00 ":irc.foonet.org 251 tester :There are 0 users and 4 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 2 :channels formed")
(0.00 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers")
(0.00 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4")
(0.00 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
(0.00 ":irc.foonet.org 422 tester :MOTD File is missing"))
((mode 6 "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.02 ":irc.foonet.org 221 tester +i"))
((join-chan 10 "JOIN #chan")
(0.03 ":tester!~u@w9rfqveugz722.irc JOIN #chan"))
((~mode-chan 10 "MODE #chan")
(0.01 ":irc.foonet.org 353 tester = #chan :@tester")
(0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list")
(0.01 ":irc.foonet.org 324 tester #chan +nt")
(0.03 ":irc.foonet.org 329 tester #chan 1653370308"))
((~join-spam 10 "JOIN #spam")
(0.03 ":irc.foonet.org 471 tester #spam :Cannot join channel (+l)"))
((~join-foo 10 "JOIN #foo")
(0.03 ":irc.foonet.org 473 tester #foo :Cannot join channel (+i)"))