</div>
</div>")
-(defun admin--require-external-package (pkg)
- (package-initialize)
- (require pkg nil t)
- (unless (featurep pkg)
- (when (yes-or-no-p (format "Package \"%s\" is missing. Install now?" pkg))
- (package-install pkg)
- (require pkg nil t))))
-
(declare-function org-html-export-as-html "ox-html.el")
(defvar org-html-postamble)
(defvar org-html-mathjax-template)
(defvar htmlize-output-type)
-(defun make-news-html-file (root version)
- "Convert the NEWS file into an HTML file."
- (interactive (let ((root
- (if noninteractive
- (or (pop command-line-args-left)
- default-directory)
- (read-directory-name "Emacs root directory: "
- source-directory nil t))))
- (list root
- (read-string "Major version number: "
- (number-to-string emacs-major-version)))))
- (unless (file-exists-p (expand-file-name "src/emacs.c" root))
- (user-error "%s doesn't seem to be the root of an Emacs source tree" root))
- (admin--require-external-package 'htmlize)
- (let* ((newsfile (expand-file-name "etc/NEWS" root))
- (orgfile (expand-file-name (format "etc/NEWS.%s.org" version) root))
- (html (format "%s.html" (file-name-base orgfile)))
- (copyright-years (format-time-string "%Y")))
- (delete-file orgfile)
- (copy-file newsfile orgfile t)
- (find-file orgfile)
-
- ;; Find the copyright range.
- (goto-char (point-min))
- (re-search-forward "^Copyright (C) \\([0-9-]+\\) Free Software Foundation, Inc.")
- (setq copyright-years (match-string 1))
-
- ;; Delete some unnecessary stuff.
- (replace-regexp-in-region "^---$" "" (point-min) (point-max))
- (replace-regexp-in-region "^\\+\\+\\+$" "" (point-min) (point-max))
- (dolist (str '("\f\n"
- "GNU Emacs NEWS -- history of user-visible changes."
- "Temporary note:"
- "+++ indicates that all relevant manuals in doc/ have been updated."
- "--- means no change in the manuals is needed."
- "When you add a new item, use the appropriate mark if you are sure it"
- "applies, and please also update docstrings as needed."
- "You can narrow news to a specific version by calling 'view-emacs-news'"
- "with a prefix argument or by typing 'C-u C-h C-n'."))
- (replace-string-in-region str "" (point-min) (point-max)))
-
- ;; Escape some characters.
- (replace-regexp-in-region (rx "$") "@@html:$@@" (point-min) (point-max))
-
- ;; Use Org-mode markers for 'symbols', 'C-x k', etc.
- (replace-regexp-in-region
- (rx (or (: (group (in " \t\n("))
- "'"
- (group (+ (or (not (in "'\n"))
- (: "'" (not (in " .,\t\n)"))))))
- "'"
- (group (in ",.;:!? \t\n)")))
- ;; Buffer names, e.g. "*scratch*".
- (: "\""
- (group-n 2 "*" (+ (not (in "*\""))) "*")
- "\"")))
- "\\1~\\2~\\3" (point-min) (point-max))
-
- ;; Format code blocks.
- (while (re-search-forward "^ " nil t)
- (let ((elisp-block (looking-at "(")))
- (backward-paragraph)
- (insert (if elisp-block
- "\n#+BEGIN_SRC emacs-lisp"
- "\n#+BEGIN_EXAMPLE"))
- (forward-paragraph)
- (insert (if elisp-block
- "#+END_SRC\n"
- "#+END_EXAMPLE\n"))))
-
- ;; Delete buffer local variables.
- (goto-char (point-max))
- (when (re-search-backward "Local variables:")
- (forward-line -1)
- (delete-region (point) (point-max)))
-
- ;; Insert Org-mode export headers.
- (goto-char (point-min))
- (insert (format admin--org-export-headers-format version))
- (org-mode)
- (save-buffer)
-
- ;; Make everything one level lower.
- (goto-char (point-min))
- (while (re-search-forward (rx bol (group (+ "*")) " ") nil t)
- (replace-match "*\\1" nil nil nil 1))
-
- ;; Insert anchors for different versions.
- (goto-char (point-min))
- (let (last-major last-minor)
- (while (re-search-forward (rx bol "** " (+ (not "\n")) "in Emacs "
- (group digit digit) "." (group digit)
- eol)
- nil t)
- (unless (and (equal (match-string 1) last-major)
- (equal (match-string 2) last-minor))
- (setq last-major (match-string 1))
- (setq last-minor (match-string 2))
- (forward-line -1)
- (insert (format
- (concat
- "#+HTML: <p> </p>\n"
- "* Changes in Emacs %s.%s\n"
- ;; Add anchor to allow linking to
- ;; e.g. "NEWS.28.html#28.1".
- ":PROPERTIES:\n"
- ":CUSTOM_ID: %s.%s\n"
- ":END:\n")
- last-major last-minor
- last-major last-minor)))))
-
- (save-buffer)
-
- ;; Make the HTML export.
- (let* ((org-html-postamble
- (format admin--org-html-postamble
- copyright-years
- ;; e.g. "2022/09/13 09:13:13"
- (format-time-string "%Y/%m/%d %H:%m:%S")))
- (org-html-mathjax-template "")
- (htmlize-output-type 'css))
- (org-html-export-as-html))
-
- ;; Write HTML to file.
- (let ((html (expand-file-name html (expand-file-name "etc" root))))
- (write-file html)
- (unless noninteractive
- (find-file html)
- (html-mode))
- (message "Successfully exported HTML to %s" html))))
-
\f
;; Stuff to check new `defcustom's got :version tags.
;; Adapted from check-declare.el.
dnl Again, it's best not to use a variable. Though you can add
dnl ", [], [opt_makefile='$opt_makefile']" and it should work.
ARCH_INDEPENDENT_CONFIG_FILES([test/Makefile])
- ARCH_INDEPENDENT_CONFIG_FILES([test/manual/noverlay/Makefile])
fi
opt_makefile=test/infra/Makefile
if test -f "$srcdir/$opt_makefile.in"; then
to do is specify the name of the gateway machine by setting the
variable @code{ange-ftp-gateway-host}, and set
@code{ange-ftp-smart-gateway} to @code{t}. Otherwise you may be able
-to make remote file names work, but the procedure is complex. You can
-read the instructions by typing @kbd{M-x finder-commentary @key{RET}
-ange-ftp @key{RET}}.
+to make remote file names work, but the procedure is complex.
@node Quoted File Names
@section Quoted File Names
@item C-h C-f
This displays the Emacs FAQ, using Info.
-
-@item C-h p
-This displays the available Emacs packages based on keywords.
-@xref{Package Keywords}.
-
-@item M-x list-packages
-This displays a list of external packages. @xref{Packages}.
@end table
@kbd{C-h} or @key{F1} mean ``help'' in various other contexts as
* Key Help:: Asking what a key does in Emacs.
* Name Help:: Asking about a command, variable or function name.
* Help Mode:: Special features of Help mode and Help buffers.
-* Package Keywords:: Finding Lisp libraries by keywords (topics).
* Language Help:: Help relating to international language support.
* Misc Help:: Other help commands.
* Help Files:: Commands to display auxiliary help files.
Display documentation of the Lisp symbol named @var{symbol}
(@code{describe-symbol}). This will show the documentation of all
kinds of symbols: functions, variables, and faces. @xref{Name Help}.
-@item C-h p
-Find packages by topic keyword (@code{finder-by-keyword}).
-@xref{Package Keywords}. This lists packages using a package menu
-buffer. @xref{Packages}.
-@item C-h P @var{package} @key{RET}
-Display documentation about the specified package
-(@code{describe-package}). @xref{Package Keywords}.
@item C-h r
Display the Emacs manual in Info (@code{info-emacs-manual}).
@item C-h s
This shows the documentation for all the meanings of the symbol---as a
variable, as a function, and/or as a face.
-@node Package Keywords
-@section Keyword Search for Packages
-@cindex finder
-
-Most optional features in Emacs are grouped into @dfn{packages}.
-Emacs contains several hundred built-in packages, and more can be
-installed over the network (@pxref{Packages}).
-
-@kindex C-h p
-@findex finder-by-keyword
- To make it easier to find packages related to a topic, most packages
-are associated with one or more @dfn{keywords} based on what they do.
-Type @kbd{C-h p} (@code{finder-by-keyword}) to bring up a list of
-package keywords, together with a description of what the keywords
-mean. To view a list of packages for a given keyword, type @key{RET}
-on that line; this displays the list of packages in a Package Menu
-buffer (@pxref{Package Menu}).
-
-@findex describe-package
-@kindex C-h P
- @kbd{C-h P} (@code{describe-package}) prompts for the name of a
-package (@pxref{Packages}), and displays a help buffer describing the
-attributes of the package and the features that it implements. The
-buffer lists the keywords that relate to the package in the form of
-buttons. Click on a button with @kbd{mouse-1} or @kbd{mouse-2} to see
-the list of other packages related to that keyword.
-
@node Language Help
@section Help for International Language Support
+++ /dev/null
-@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2025 Free Software
-@c Foundation, Inc.
-@c See file emacs.texi for copying conditions.
-@node Packages
-@chapter Emacs Lisp Packages
-@cindex Package
-@cindex Package archive
-
- Emacs is extended by implementing additional features in
-@dfn{packages}, which are Emacs Lisp libraries. These could be
-written by you or provided by someone else. If you want to install
-such a package so it is available in your future Emacs session, you
-need to compile it and put it in a directory where Emacs looks for
-Lisp libraries. @xref{Lisp Libraries}, for more details about this
-manual installation method. Many packages provide installation and
-usage instructions in the large commentary near the beginning of the
-Lisp file; you can use those instructions for installing and
-fine-tuning your use of the package.
-
-@cindex Emacs Lisp package archive
- Packages can also be provided by @dfn{package archives}, which are
-large collections of Emacs Lisp packages. Each package is a separate
-Emacs Lisp program, sometimes including other components such as an
-Info manual. Emacs includes a facility that lets you easily download
-and install packages from such archives. The rest of this chapter
-describes this facility.
-
- To list the packages available for installation from package
-archives, type @w{@kbd{M-x list-packages @key{RET}}}. It brings up a
-buffer named @file{*Packages*} with a list of all packages. You can
-install or uninstall packages via this buffer. @xref{Package Menu}.
-
- The command @kbd{C-h P} (@code{describe-package}) prompts for the
-name of a package, and displays a help buffer describing the
-attributes of the package and the features that it implements.
-
- By default, Emacs downloads packages from a package archive
-maintained by the Emacs developers and hosted by the GNU project.
-Optionally, you can also download packages from archives maintained by
-third parties. @xref{Package Installation}.
-
- For information about turning an Emacs Lisp program into an
-installable package, @xref{Packaging,,,elisp, The Emacs Lisp Reference
-Manual}.
-
-@menu
-* Package Menu:: Buffer for viewing and managing packages.
-* Package Statuses:: Which statuses a package can have.
-* Package Installation:: Options for package installation.
-* Package Files:: Where packages are installed.
-* Fetching Package Sources:: Managing packages directly from source.
-@end menu
-
-@node Package Menu
-@section The Package Menu Buffer
-@cindex package menu
-@cindex built-in package
-@findex list-packages
-
-The command @kbd{M-x list-packages} brings up the @dfn{package menu}.
-This is a buffer listing all the packages that Emacs knows about, one
-on each line, with the following information:
-
-@itemize @bullet
-@item
-The package name (e.g., @samp{auctex}).
-
-@item
-The package's version number (e.g., @samp{11.86}).
-
-@item
-The package's status---normally one of @samp{available} (can be
-downloaded from the package archive), @samp{installed},
-@c @samp{unsigned} (installed, but not signed; @pxref{Package Signing}),
-or @samp{built-in} (included in Emacs by default).
-@xref{Package Statuses}.
-
-@item
-Which package archive this package is from, if you have more than one
-package archive enabled.
-
-@item
-A short description of the package.
-@end itemize
-
-@noindent
-The @code{list-packages} command accesses the network, to retrieve the
-list of available packages from package archive servers. If the
-network is unavailable, it falls back on the most recently retrieved
-list.
-
-The main command to use in the package list buffer is the @key{x}
-command. If the package under point isn't installed already, this
-command will install it. If the package under point is already
-installed, this command will delete it.
-
-The following commands are available in the package menu:
-
-@table @kbd
-@item h
-@kindex h @r{(Package Menu)}
-@findex package-menu-quick-help
-Print a short message summarizing how to use the package menu
-(@code{package-menu-quick-help}).
-
-@item ?
-@itemx @key{RET}
-@kindex ? @r{(Package Menu)}
-@kindex RET @r{(Package Menu)}
-@findex package-menu-describe-package
-Display a help buffer for the package on the current line
-(@code{package-menu-describe-package}), similar to the help window
-displayed by the @kbd{C-h P} command (@pxref{Packages}).
-
-@item i
-@kindex i @r{(Package Menu)}
-@findex package-menu-mark-install
-Mark the package on the current line for installation
-(@code{package-menu-mark-install}). If the package status is
-@samp{available}, this adds an @samp{I} character to the start of the
-line; typing @kbd{x} (see below) will download and install the
-package.
-
-@item d
-@kindex d @r{(Package Menu)}
-@findex package-menu-mark-delete
-Mark the package on the current line for deletion
-(@code{package-menu-mark-delete}). If the package status is
-@samp{installed}, this adds a @samp{D} character to the start of the
-line; typing @kbd{x} (see below) will delete the package.
-@xref{Package Files}, for information about what package deletion
-entails.
-
-@item w
-@kindex w @r{(Package Menu)}
-@findex package-browse-url
-Open the package website on the current line in a browser
-(@code{package-browse-url}). @code{browse-url} is used to open the
-browser.
-
-@item ~
-@kindex ~ @r{(Package Menu)}
-@findex package-menu-mark-obsolete-for-deletion
-Mark all obsolete packages for deletion
-(@code{package-menu-mark-obsolete-for-deletion}). This marks for
-deletion all the packages whose status is @samp{obsolete}.
-
-@item u
-@itemx @key{DEL}
-@kindex u @r{(Package Menu)}
-@findex package-menu-mark-unmark
-Remove any installation or deletion mark previously added to the
-current line by an @kbd{i} or @kbd{d} command
-(@code{package-menu-mark-unmark}).
-
-@item U
-@kindex U @r{(Package Menu)}
-@findex package-menu-mark-upgrades
-Mark all package with a newer available version for upgrading
-(@code{package-menu-mark-upgrades}). This places an installation mark
-on the new available versions, and a deletion mark on the old
-installed versions (marked with status @samp{obsolete}). By default,
-this won't mark built-in packages for which a newer version is
-available, but customizing @code{package-install-upgrade-built-in} can
-change that. @xref{Package Installation}. If you customize
-@code{package-install-upgrade-built-in} to a non-@code{nil} value, be
-sure to review all the built-in packages the @kbd{U} command marks, to
-avoid updating built-in packages you don't want to overwrite.
-
-@item x
-@kindex x @r{(Package Menu)}
-@vindex package-menu-async
-@findex package-menu-execute
-Download and install all packages marked with @kbd{i}, and their
-dependencies; also, delete all packages marked with @kbd{d}
-(@code{package-menu-execute}). This also removes the marks. If no
-packages are marked, this command will install the package under point
-(if it isn't installed already), or delete the package under point (if
-it's already installed).
-
-@item g
-@item r
-@kindex g @r{(Package Menu)}
-@kindex r @r{(Package Menu)}
-Refresh the package list (@code{revert-buffer}). This fetches the
-list of available packages from the package archive again, and
-redisplays the package list.
-
-@item H
-@kindex H @r{(Package Menu)}
-@findex package-menu-hide-package
-Hide packages whose names match a regexp
-(@code{package-menu-hide-package}). This prompts for a regexp, and
-then hides the packages with matching names. The default value of the
-regexp will hide only the package whose name is at point, so just
-pressing @key{RET} to the prompt will hide the current package.
-
-@item (
-@kindex ( @r{(Package Menu)}
-@findex package-menu-toggle-hiding
-Toggle visibility of old versions of packages and also of versions
-from lower-priority archives (@code{package-menu-toggle-hiding}).
-
-@item / a
-@kindex / a @r{(Package Menu)}
-@findex package-menu-filter-by-archive
-Filter package list by archive (@code{package-menu-filter-by-archive}).
-This prompts for a package archive (e.g., @samp{gnu}), then shows only
-packages from that archive. You can specify several archives by
-typing their names separated by commas.
-
-@item / d
-@kindex / d @r{(Package Menu)}
-@findex package-menu-filter-by-description
-Filter package list by description
-(@code{package-menu-filter-by-description}). This prompts for a
-regular expression, then shows only packages with descriptions
-matching that regexp.
-
-@item / k
-@kindex / k @r{(Package Menu)}
-@findex package-menu-filter-by-keyword
-Filter package list by keyword (@code{package-menu-filter-by-keyword}).
-This prompts for a keyword (e.g., @samp{games}), then shows only
-packages with that keyword. You can specify several keywords by
-typing them separated by commas.
-
-@item / N
-@kindex / N @r{(Package Menu)}
-@findex package-menu-filter-by-name-or-description
-Filter package list by name or description
-(@code{package-menu-filter-by-name-or-description}). This prompts for
-a regular expression, then shows only packages with a name or
-description matching that regexp.
-
-@item / n
-@kindex / n @r{(Package Menu)}
-@findex package-menu-filter-by-name
-Filter package list by name (@code{package-menu-filter-by-name}).
-This prompts for a regular expression, then shows only packages
-with names matching that regexp.
-
-@item / s
-@kindex / s @r{(Package Menu)}
-@findex package-menu-filter-by-status
-Filter package list by status (@code{package-menu-filter-by-status}).
-This prompts for one or more statuses (e.g., @samp{available},
-@pxref{Package Statuses}), then shows only packages with matching
-status. You can specify several status values by typing them
-separated by commas.
-
-@item / v
-@kindex / v @r{(Package Menu)}
-@findex package-menu-filter-by-version
-Filter package list by version (@code{package-menu-filter-by-version}).
-This prompts first for one of the comparison symbols @samp{<},
-@samp{>} or @samp{=} and for a version string, and then shows packages
-whose versions are correspondingly lower, equal or higher than the
-version you typed.
-
-@item / m
-@kindex / m @r{(Package Menu)}
-@findex package-menu-filter-marked
-Filter package list by non-empty mark (@code{package-menu-filter-marked}).
-This shows only the packages that have been marked to be installed or deleted.
-
-@item / u
-@kindex / u @r{(Package Menu)}
-@findex package-menu-filter-upgradable
-Filter package list to show only packages for which there are
-available upgrades (@code{package-menu-filter-upgradable}). By
-default, this filter excludes the built-in packages for which a newer
-version is available, but customizing
-@code{package-install-upgrade-built-in} can change that.
-@xref{Package Installation}.
-
-@item / /
-@kindex / / @r{(Package Menu)}
-@findex package-menu-filter-clear
-Clear filter currently applied to the package list
-(@code{package-menu-filter-clear}).
-@end table
-
-@noindent
-For example, you can install a package by typing @kbd{i} on the line
-listing that package, followed by @kbd{x}.
-
-@node Package Statuses
-@section Package Statuses
-@cindex package status
-
-A package can have one of the following statuses:
-
-@table @samp
-@item available
-The package is not installed, but can be downloaded and installed from
-the package archive.
-
-@item avail-obso
-The package is available for installation, but a newer version is also
-available. Packages with this status are hidden by default.
-
-@cindex built-in package
-@item built-in
-The package is included in Emacs by default. It cannot be deleted
-through the package menu, and by default is not considered for
-upgrading (but you can change that by customizing
-@code{package-install-upgrade-built-in}, @pxref{Package Installation}).
-
-@item dependency
-The package was installed automatically to satisfy a dependency of
-another package.
-
-@item disabled
-The package has been disabled using the @code{package-load-list}
-variable.
-
-@item external
-The package is not built-in and not from the directory specified by
-@code{package-user-dir} (@pxref{Package Files}). External packages
-are treated much like @samp{built-in} packages and cannot be deleted.
-
-@item held
-The package is held, @xref{Package Installation}.
-
-@item incompat
-The package cannot be installed for some reason, for example because
-it depends on uninstallable packages.
-
-@item installed
-The package is installed.
-
-@item new
-Equivalent to @samp{available}, except that the package became newly
-available on the package archive after your last invocation of
-@kbd{M-x list-packages}.
-
-@item obsolete
-The package is an outdated installed version; in addition to this
-version of the package, a newer version is also installed.
-
-@c @samp{unsigned} (installed, but not signed; @pxref{Package Signing}),
-@end table
-
-@node Package Installation
-@section Package Installation
-
-@findex package-install
-@findex package-upgrade
-@findex package-upgrade-all
- Packages are most conveniently installed using the package menu
-(@pxref{Package Menu}), but you can also use the command @kbd{M-x
-package-install}. This prompts for the name of a package with the
-@samp{available} status, then downloads and installs it. Similarly,
-if you want to upgrade a package, you can use the @kbd{M-x
-package-upgrade} command, and if you want to upgrade all the packages,
-you can use the @kbd{M-x package-upgrade-all} command.
-
-@vindex package-install-upgrade-built-in
- By default, @code{package-install} doesn't consider built-in
-packages for which new versions are available from the archives. (A
-package is built-in if it is included in the Emacs distribution.) In
-particular, it will not show built-in packages in the list of
-completion candidates when you type at its prompt. But if you invoke
-@code{package-install} with a prefix argument, it will also consider
-built-in packages that can be upgraded. You can make this behavior
-the default by customizing the variable
-@code{package-install-upgrade-built-in}: if its value is
-non-@code{nil}, @code{package-install} will consider built-in packages
-even when invoked without a prefix argument. Note that the
-package-menu commands (@pxref{Package Menu}) are also affected by
-@code{package-install-upgrade-built-in}.
-
- By contrast, @code{package-upgrade} and @code{package-upgrade-all}
-never consider built-in packages. If you want to use these commands
-for upgrading some built-in packages, you need to upgrade each of
-those packages, once, either via @kbd{C-u M-x package-install
-@key{RET}}, or by customizing @code{package-install-upgrade-built-in}
-to a non-@code{nil} value, and then upgrading the package once via the
-package menu or by @code{package-install}.
-
- If you customize @code{package-install-upgrade-built-in} to a
-non-@code{nil} value, be very careful when using commands that update
-many packages at once, like @code{package-upgrade-all} and @kbd{U} in
-the package menu: those might overwrite built-in packages that you
-didn't intent to replace with newer versions from the archives. Don't
-use these bulk commands if you want to update only a small number of
-built-in packages.
-
-@cindex package requirements
- A package may @dfn{require} certain other packages to be installed,
-because it relies on functionality provided by them. When Emacs
-installs such a package, it also automatically downloads and installs
-any required package that is not already installed. (If a required
-package is somehow unavailable, Emacs signals an error and stops
-installation.) A package's requirements list is shown in its help
-buffer.
-
-@vindex package-archives
- By default, packages are downloaded from a single package archive
-maintained by the Emacs developers. This is controlled by the
-variable @code{package-archives}, whose value is a list of package
-archives known to Emacs. Each list element must have the form
-@code{(@var{id} . @var{location})}, where @var{id} is the name of a
-package archive and @var{location} is the @acronym{URL} or
-name of the package archive directory. You can alter this list if you
-wish to use third party package archives---but do so at your own risk,
-and use only third parties that you think you can trust!
-
-@anchor{Package Signing}
-@cindex package security
-@cindex package signing
- The maintainers of package archives can increase the trust that you
-can have in their packages by @dfn{signing} them. They generate a
-private/public pair of cryptographic keys, and use the private key to
-create a @dfn{signature file} for each package. With the public key, you
-can use the signature files to verify the package creator and make sure
-the package has not been tampered with. Signature verification uses
-@uref{https://www.gnupg.org/, the GnuPG package} via the EasyPG
-interface (@pxref{Top,, EasyPG, epa, Emacs EasyPG Assistant Manual}).
-A valid signature is not a cast-iron
-guarantee that a package is not malicious, so you should still
-exercise caution. Package archives should provide instructions
-on how you can obtain their public key. One way is to download the
-key from a server such as @url{https://pgp.mit.edu/}.
-Use @kbd{M-x package-import-keyring} to import the key into Emacs.
-Emacs stores package keys in the directory specified by the variable
-@code{package-gnupghome-dir}, by default in the @file{gnupg}
-subdirectory of @code{package-user-dir}, which causes Emacs to invoke
-GnuPG with the option @samp{--homedir} when verifying signatures.
-If @code{package-gnupghome-dir} is @code{nil}, GnuPG's option
-@samp{--homedir} is omitted.
-The public key for the GNU package archive is distributed with Emacs,
-in the @file{etc/package-keyring.gpg}. Emacs uses it automatically.
-
-@vindex package-check-signature
-@vindex package-unsigned-archives
- If the user option @code{package-check-signature} is non-@code{nil},
-Emacs attempts to verify signatures when you install packages. If the
-option has the value @code{allow-unsigned}, and a usable OpenPGP
-configuration is found, signed packages will be checked, but you can
-still install a package that is not signed. If you use some archives
-that do not sign their packages, you can add them to the list
-@code{package-unsigned-archives}. (If the value is
-@code{allow-unsigned} and no usable OpenPGP is found, this option is
-treated as if its value was @code{nil}.) If the value is @code{t}, at
-least one signature must be valid; if the value is @code{all}, all of
-them must be valid.
-
- For more information on cryptographic keys and signing,
-@pxref{Top,, GnuPG, gnupg, The GNU Privacy Guard Manual}.
-Emacs comes with an interface to GNU Privacy Guard,
-@pxref{Top,, EasyPG, epa, Emacs EasyPG Assistant Manual}.
-
-@vindex package-pinned-packages
- If you have more than one package archive enabled, and some of them
-offer different versions of the same package, you may find the option
-@code{package-pinned-packages} useful. You can add package/archive
-pairs to this list, to ensure that the specified package is only ever
-downloaded from the specified archive.
-
-@vindex package-archive-priorities
-@vindex package-menu-hide-low-priority
- Another option that is useful when you have several package archives
-enabled is @code{package-archive-priorities}. It specifies the
-priority of each archive (higher numbers specify higher priority
-archives). By default, archives have the priority of zero, unless
-specified otherwise by this option's value. Packages from
-lower-priority archives will not be shown in the menu, if the same
-package is available from a higher-priority archive. (This is
-controlled by the value of @code{package-menu-hide-low-priority}.)
-
- Once a package is downloaded, byte-compiled and installed, it is
-made available to the current Emacs session. Making a package
-available adds its directory to @code{load-path} and loads its
-autoloads. The effect of a package's autoloads varies from package to
-package. Most packages just make some new commands available, while
-others have more wide-ranging effects on the Emacs session. For such
-information, consult the package's help buffer.
-
- Installed packages are automatically made available by Emacs in all
-subsequent sessions. This happens at startup, before processing the
-init file but after processing the early init file (@pxref{Early Init
-File}). As an exception, Emacs does not make packages available at
-startup if invoked with the @samp{-q} or @samp{--no-init-file} options
-(@pxref{Initial Options}).
-
-@vindex package-enable-at-startup
- To keep Emacs from automatically making packages available at
-startup, change the variable @code{package-enable-at-startup} to
-@code{nil}. You must do this in the early init file, as the variable
-is read before loading the regular init file. Therefore, if you
-customize this variable via Customize, you should save your customized
-setting into your early init file. To do this, set or change the value
-of the variable @code{custom-file} (@pxref{Saving Customizations}) to
-point to your early init file before saving the customized value of
-@code{package-enable-at-startup}.
-
-@findex package-quickstart-refresh
-@vindex package-quickstart
- If you have many packages installed, you can improve startup times
-by setting the user option @code{package-quickstart} to @code{t}.
-Setting this option will make Emacs precompute many things instead of
-re-computing them on every Emacs startup. However, if you do this,
-then you have to manually run the command
-@code{package-quickstart-refresh} when the activations need to be
-changed, such as when you change the value of
-@code{package-load-list}.
-
-@findex package-activate-all
- If you have set @code{package-enable-at-startup} to @code{nil}, you
-can still make packages available either during or after startup. To
-make installed packages available during startup, call the function
-@code{package-activate-all} in your init file. To make installed
-packages available after startup, invoke the command @kbd{M-:
-(package-activate-all) RET}.
-
-@vindex package-load-list
- For finer control over which packages are made available at startup,
-you can use the variable @code{package-load-list}. Its value should
-be a list. A list element of the form @w{@code{(@var{name}
-@var{version})}} tells Emacs to make available version @var{version} of
-the package named @var{name}. Here, @var{version} should be a version
-string (corresponding to a specific version of the package), or
-@code{t} (which means to make available any installed version), or
-@code{nil} (which means no version; this disables the package,
-preventing it from being made available). A list element can also be
-the symbol @code{all}, which means to make available the latest
-installed version of any package not named by the other list elements.
-The default value is just @code{'(all)}.
-
- For example, if you set @code{package-load-list} to @w{@code{'((muse
-"3.20") all)}}, then Emacs only makes available version 3.20 of the
-@samp{muse} package, plus any installed version of packages other than
-@samp{muse}. Any other version of @samp{muse} that happens to be
-installed will be ignored. The @samp{muse} package will be listed in
-the package menu with the @samp{held} status.
-
-@findex package-recompile
-@findex package-recompile-all
- Emacs byte code is quite stable, but it's possible for byte code to
-become outdated, or for the compiled files to rely on macros that have
-changed in new versions of Emacs. You can use the command @w{@kbd{M-x
-package-recompile}} to recompile a particular package, or
-@w{@kbd{M-x package-recompile-all}} to recompile all the packages. (The
-latter command might take quite a while to run if you have many
-installed packages.)
-
-@node Package Files
-@section Package Files and Directory Layout
-@cindex package directory
-
-@cindex package file
-@findex package-install-file
- Each package is downloaded from the package archive in the form of a
-single @dfn{package file}---either an Emacs Lisp source file, or a tar
-file containing multiple Emacs Lisp source and other files. Package
-files are automatically retrieved, processed, and disposed of by the
-Emacs commands that install packages. Normally, you will not need to
-deal directly with them, unless you are making a package
-(@pxref{Packaging,,,elisp, The Emacs Lisp Reference Manual}). Should
-you ever need to install a package directly from a package file, use
-the command @kbd{M-x package-install-file}.
-
-@vindex package-user-dir
- Once installed, the contents of a package are placed in a
-subdirectory of @file{~/.emacs.d/elpa/} (you can change the name of
-that directory by customizing the variable @code{package-user-dir}). The
-package subdirectory is named @file{@var{name}-@var{version}}, where
-@var{name} is the package name and @var{version} is its version
-string.
-
-@cindex system-wide packages
-@vindex package-directory-list
- In addition to @code{package-user-dir}, Emacs looks for installed
-packages in the directories listed in @code{package-directory-list}.
-These directories are meant for system administrators to make Emacs
-packages available system-wide; Emacs itself never installs packages
-there. The package subdirectories for @code{package-directory-list}
-are laid out in the same way as in @code{package-user-dir}.
-
- Deleting a package (@pxref{Package Menu}) involves deleting the
-corresponding package subdirectory. This only works for packages
-installed in @code{package-user-dir}; if told to act on a package in a
-system-wide package directory, the deletion command signals an error.
-
-@node Fetching Package Sources
-@section Fetching Package Sources
-@cindex package development source
-@cindex upstream source, for packages
-@cindex git source of package @c "git" is not technically correct
-
- By default @code{package-install} downloads a Tarball from a package
-archive and installs its files. This might be inadequate if you wish
-to hack on the package sources and share your changes with others. In
-that case, you may prefer to directly fetch and work on the upstream
-source. This often makes it easier to develop patches and report
-bugs.
-
-@findex package-vc-install
-@findex package-vc-checkout
- One way to do this is to use @code{package-vc-install}, to fetch the
-source code for a package directly from source. The command will also
-automatically ensure that all files are byte-compiled and auto-loaded,
-just like with a regular package. Packages installed this way behave
-just like any other package. You can upgrade them using
-@code{package-upgrade} or @code{package-upgrade-all} and delete them
-again using @code{package-delete}. They are even displayed in the
-regular package listing. If you just wish to clone the source of a
-package, without adding it to the package list, use
-@code{package-vc-checkout}.
-
- Note that currently, built-in packages cannot be upgraded using
-@code{package-vc-install}.
-
-@findex package-report-bug
-@findex package-vc-prepare-patch
- With the source checkout, you might want to reproduce a bug against
-the current development head or implement a new feature to scratch an
-itch. If the package metadata indicates how to contact the
-maintainer, you can use the command @code{package-report-bug} to
-report a bug via Email. This report will include all the user options
-that you have customized. If you have made a change you wish to share
-with the maintainers, first commit your changes then use the command
-@code{package-vc-prepare-patch} to share it. @xref{Preparing Patches}.
-
-@findex package-vc-install-from-checkout
-@findex package-vc-rebuild
- If you maintain your own packages you might want to use a local
-checkout instead of cloning a remote repository. You can do this by
-using @code{package-vc-install-from-checkout}, which creates a symbolic link
-from the package directory (@pxref{Package Files}) to your checkout
-and initializes the code. Note that you might have to use
-@code{package-vc-rebuild} to repeat the initialization and update the
-autoloads.
-
-@subsection Specifying Package Sources
-@cindex package specification
-@cindex specification, for source packages
-
- To install a package from source, Emacs must know where to get the
-package's source code (such as a code repository) and basic
-information about the structure of the code (such as the main file in
-a multi-file package). A @dfn{package specification} describes these
-properties.
-
- When supported by a package archive (@pxref{Package
-Archives,,,elisp, The Emacs Lisp Reference Manual}), Emacs can
-automatically download a package's specification from said archive.
-If the first argument passed to @code{package-vc-install} is a symbol
-naming a package, then Emacs will use the specification provided by
-the archive for that package.
-
-@example
-@group
-;; Emacs will download BBDB's specification from GNU ELPA:
-(package-vc-install 'bbdb)
-@end group
-@end example
-
- The first argument to @code{package-vc-install} may also be a
-package specification. This allows you to install source packages
-from locations other than the known archives listed in the user option
-@code{package-archives}. A package specification is a list of the
-form @code{(@var{name} . @var{spec})}, in which @var{spec} should be a
-property list using any of the keys in the table below.
-
-For definitions of basic terms for working with code repositories and
-version control systems, see @ref{VCS Concepts,,,emacs, The GNU Emacs
-Manual}.
-
-@table @code
-@item :url
-A string providing the URL that specifies the repository from which to
-fetch the package's source code.
-
-@item :branch
-A string providing the revision of the code to install. Do not
-confuse this with a package's version number.
-
-@item :lisp-dir
-A string providing the repository-relative name of the directory to
-use for loading the Lisp sources, which defaults to the root directory
-of the repository.
-
-@item :main-file
-A string providing the main file of the project, from which to gather
-package metadata. If not given, the default is the package name with
-".el" appended to it.
-
-@item :doc
-A string providing the repository-relative name of the documentation
-file from which to build an Info file. This can be a Texinfo file or
-an Org file.
-
-@item :make
-A string or list of strings providing the target or targets defined in
-the repository Makefile which should run before building the Info file.
-Only takes effect when @code{package-vc-allow-build-commands} is
-non-@code{nil}.
-
-@item :shell-command
-A string providing the shell command to run before building the Info
-file. Only takes effect when @code{package-vc-allow-build-commands}
-is non-@code{nil}.
-
-@item :vc-backend
-A symbol naming the VC backend to use for downloading a copy of the
-package's repository (@pxref{Version Control Systems,,,emacs, The GNU
-Emacs Manual}). If omitted, Emacs will attempt to make a guess based
-on the provided URL, or, failing that, the process will fall back onto
-the value of @code{package-vc-default-backend}.
-@end table
-
-@example
-@group
-;; Specifying information manually:
-(package-vc-install
- '(bbdb :url "https://git.savannah.nongnu.org/git/bbdb.git"
- :lisp-dir "lisp"
- :doc "doc/bbdb.texi"))
-@end group
-@end example
+++ /dev/null
-@c -*-texinfo-*-
-@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 2010--2025 Free Software Foundation, Inc.
-@c See the file elisp.texi for copying conditions.
-@node Packaging
-@chapter Preparing Lisp code for distribution
-@cindex package
-@cindex Lisp package
-
- Emacs provides a standard way to distribute Emacs Lisp code to
-users. A @dfn{package} is a collection of one or more files,
-formatted and bundled in such a way that users can easily download,
-install, uninstall, and upgrade it.
-
- The following sections describe how to create a package, and how to
-put it in a @dfn{package archive} for others to download.
-@xref{Packages,,, emacs, The GNU Emacs Manual}, for a description of
-user-level features of the packaging system.
-
- These sections are mostly directed towards package archive
-maintainers---much of this information is not relevant for package
-authors (i.e., people who write code that will be distributed via
-these archives).
-
-@menu
-* Packaging Basics:: The basic concepts of Emacs Lisp packages.
-* Simple Packages:: How to package a single .el file.
-* Multi-file Packages:: How to package multiple files.
-* Package Archives:: Maintaining package archives.
-* Archive Web Server:: Interfacing to an archive web server.
-* Forwards-Compatibility:: Supporting older versions of Emacs.
-@end menu
-
-@node Packaging Basics
-@section Packaging Basics
-@cindex package attributes
-@cindex package name
-@cindex package version
-@cindex dependencies
-@cindex package dependencies
-
- A package is either a @dfn{simple package} or a @dfn{multi-file
-package}. A simple package is stored in a package archive as a single
-Emacs Lisp file, while a multi-file package is stored as a tar file
-(containing multiple Lisp files, and possibly non-Lisp files such as a
-manual).
-
- In ordinary usage, the difference between simple packages and
-multi-file packages is relatively unimportant; the Package Menu
-interface makes no distinction between them. However, the procedure
-for creating them differs, as explained in the following sections.
-
- Each package (whether simple or multi-file) has certain
-@dfn{attributes}:
-
-@table @asis
-@item Name
-A short word (e.g., @samp{auctex}). This is usually also the symbol
-prefix used in the program (@pxref{Coding Conventions}).
-
-@item Version
-A version number, in a form that the function @code{version-to-list}
-understands (e.g., @samp{11.86}). Each release of a package should be
-accompanied by an increase in the version number so that it will be
-recognized as an upgrade by users querying the package archive.
-
-@item Brief description
-This is shown when the package is listed in the Package Menu. It
-should occupy a single line, ideally in 36 characters or less.
-
-@item Long description
-This is shown in the buffer created by @kbd{C-h P}
-(@code{describe-package}), following the package's brief description
-and installation status. It normally spans multiple lines, and should
-fully describe the package's capabilities and how to begin using it
-once it is installed.
-
-@item Dependencies
-A list of other packages (possibly including minimal acceptable
-version numbers) on which this package depends. The list may be
-empty, meaning this package has no dependencies. Otherwise,
-installing this package also automatically installs its dependencies,
-recursively; if any dependency cannot be found, the package cannot be
-installed.
-@end table
-
-@cindex content directory, package
- Installing a package, either via the command @code{package-install-file},
-or via the Package Menu, creates a subdirectory of
-@code{package-user-dir} named @file{@var{name}-@var{version}}, where
-@var{name} is the package's name and @var{version} its version
-(e.g., @file{~/.emacs.d/elpa/auctex-11.86/}). We call this the
-package's @dfn{content directory}. It is where Emacs puts the
-package's contents (the single Lisp file for a simple package, or the
-files extracted from a multi-file package).
-
-@cindex package autoloads
- Emacs then searches every Lisp file in the content directory for
-autoload magic comments (@pxref{Autoload}). These autoload
-definitions are saved to a file named @file{@var{name}-autoloads.el}
-in the content directory. They are typically used to autoload the
-principal user commands defined in the package, but they can also
-perform other tasks, such as adding an element to
-@code{auto-mode-alist} (@pxref{Auto Major Mode}). Note that a package
-typically does @emph{not} autoload every function and variable defined
-within it---only the handful of commands typically called to begin
-using the package. Emacs then byte-compiles every Lisp file in the
-package.
-
- After installation, the installed package is @dfn{loaded}: Emacs
-adds the package's content directory to @code{load-path}, and
-evaluates the autoload definitions in @file{@var{name}-autoloads.el}.
-
- Whenever Emacs starts up, it automatically calls the function
-@code{package-activate-all} to make installed packages available to the
-current session. This is done after loading the early init file, but
-before loading the regular init file (@pxref{Startup Summary}).
-Packages are not automatically made available if the user option
-@code{package-enable-at-startup} is set to @code{nil} in the early
-init file.
-
-@defun package-activate-all
-This function makes the packages available to the current session.
-The user option @code{package-load-list} specifies which packages to
-make available; by default, all installed packages are made available.
-@xref{Package Installation,,, emacs, The GNU Emacs Manual}.
-
-In most cases, you should not need to call @code{package-activate-all},
-as this is done automatically during startup. Simply make sure to put
-any code that should run before @code{package-activate-all} in the early
-init file, and any code that should run after it in the primary init
-file (@pxref{Init File,,, emacs, The GNU Emacs Manual}).
-@end defun
-
-@deffn Command package-initialize &optional no-activate
-This function initializes Emacs's internal record of which packages are
-installed, and then calls @code{package-activate-all}.
-
-The optional argument @var{no-activate}, if non-@code{nil}, causes
-Emacs to update its record of installed packages without actually
-making them available.
-@end deffn
-
-@node Simple Packages
-@section Simple Packages
-@cindex single file package
-@cindex simple package
-
- A simple package consists of a single Emacs Lisp source file. The
-file must conform to the Emacs Lisp library header conventions
-(@pxref{Library Headers}). The package's attributes are taken from
-the various headers, as illustrated by the following example:
-
-@example
-@group
-;;; superfrobnicator.el --- Frobnicate and bifurcate flanges -*- lexical-binding:t -*-
-
-;; Copyright (C) 2022, 2025 Free Software Foundation, Inc.
-@end group
-
-;; Author: J. R. Hacker <jrh@@example.com>
-;; Version: 1.3
-;; Package-Requires: ((flange "1.0"))
-;; Keywords: multimedia, hypermedia
-;; URL: https://example.com/jrhacker/superfrobnicate
-
-@dots{}
-
-;;; Commentary:
-
-;; This package provides a minor mode to frobnicate and/or
-;; bifurcate any flanges you desire. To activate it, just type
-@dots{}
-
-;;;###autoload
-(define-minor-mode superfrobnicator-mode
-@dots{}
-@end example
-
- The name of the package is the same as the base name of the file, as
-written on the first line. Here, it is @samp{superfrobnicator}.
-
- The brief description is also taken from the first line. Here, it
-is @samp{Frobnicate and bifurcate flanges}.
-
- The version number comes from the @samp{Package-Version} header, if
-it exists, or from the @samp{Version} header otherwise. One or the
-other @emph{must} be present. Here, the version number is 1.3.
-
- If the file has a @samp{;;; Commentary:} section, this section is
-used as the long description. (When displaying the description, Emacs
-omits the @samp{;;; Commentary:} line, as well as the leading comment
-characters in the commentary itself.)
-
- If the file has a @samp{Package-Requires} header, that is used as the
-package dependencies. In the above example, the package depends on the
-@samp{flange} package, version 1.0 or higher. @xref{Library Headers},
-for a description of the @samp{Package-Requires} header. To depend on a
-specific version of Emacs, specify @samp{emacs} as the package name. If
-the header is omitted, the package has no dependencies.
-
- The @samp{Keywords} and @samp{URL} headers are optional, but recommended.
-The command @code{describe-package} uses these to add links to its
-output. The @samp{Keywords} header should contain at least one
-standard keyword from the @code{finder-known-keywords} list.
-
- The file ought to also contain one or more autoload magic comments,
-as explained in @ref{Packaging Basics}. In the above example, a magic
-comment autoloads @code{superfrobnicator-mode}.
-
- @xref{Package Archives}, for an explanation of how to add a
-single-file package to a package archive.
-
-@node Multi-file Packages
-@section Multi-file Packages
-@cindex multi-file package
-
- A multi-file package is less convenient to create than a single-file
-package, but it offers more features: it can include multiple Emacs
-Lisp files, an Info manual, and other file types (such as images).
-
- Prior to installation, a multi-file package is stored in a package
-archive as a tar file. The tar file must be named
-@file{@var{name}-@var{version}.tar}, where @var{name} is the package
-name and @var{version} is the version number. Its contents, once
-extracted, must all appear in a directory named
-@file{@var{name}-@var{version}}, the @dfn{content directory}
-(@pxref{Packaging Basics}). Files may also extract into
-subdirectories of the content directory.
-
- One of the files in the content directory must be named
-@file{@var{name}-pkg.el}. It must contain a single Lisp form,
-consisting of a call to the function @code{define-package}, described
-below. This defines the package's attributes: version, brief
-description, and requirements.
-
- For example, if we distribute version 1.3 of the superfrobnicator as
-a multi-file package, the tar file would be
-@file{superfrobnicator-1.3.tar}. Its contents would extract into the
-directory @file{superfrobnicator-1.3}, and one of these would be the
-file @file{superfrobnicator-pkg.el}.
-
-@defun define-package name version &optional docstring requirements
-This function defines a package. @var{name} is the package name, a
-string. @var{version} is the version, as a string of a form that can
-be understood by the function @code{version-to-list}. @var{docstring}
-is the brief description.
-
-@var{requirements} is a list of required packages and their versions.
-Each element in this list should have the form @code{(@var{dep-name}
-@var{dep-version})}, where @var{dep-name} is a symbol whose name is the
-dependency's package name, and @var{dep-version} is the dependency's
-version (a string). The special value @samp{emacs} means that the
-package depends on the given version of Emacs.
-@end defun
-
- If the content directory contains a file named @file{README}, this
-file is used as the long description (overriding any @samp{;;;
-Commentary:} section).
-
- If the content directory contains a file named @file{dir}, this is
-assumed to be an Info directory file made with @command{install-info}.
-@xref{Invoking install-info, Invoking install-info, Invoking
-install-info, texinfo, Texinfo}. The relevant Info files should also
-be present in the content directory. In this case, Emacs will
-automatically add the content directory to @code{Info-directory-list}
-when the package is activated.
-
- Do not include any @file{.elc} files in the package. Those are
-created when the package is installed. Note that there is no way to
-control the order in which files are byte-compiled.
-
- Do not include any file named @file{@var{name}-autoloads.el}. This
-file is reserved for the package's autoload definitions
-(@pxref{Packaging Basics}). It is created automatically when the
-package is installed, by searching all the Lisp files in the package
-for autoload magic comments.
-
- If the multi-file package contains auxiliary data files (such as
-images), the package's Lisp code can refer to these files via the
-variable @code{load-file-name} (@pxref{Loading}). Here is an example:
-
-@smallexample
-(defconst superfrobnicator-base (file-name-directory load-file-name))
-
-(defun superfrobnicator-fetch-image (file)
- (expand-file-name file superfrobnicator-base))
-@end smallexample
-
-@cindex @file{.elpaignore} file
- If your package contains files that you don't wish to distribute to
-users (e.g.@: regression tests), you can add them to an
-@file{.elpaignore} file. In this file, each line lists a file or a
-wildcard matching files; those files should be ignored when producing
-your package's tarball on ELPA (@pxref{Package Archives}). (ELPA
-will pass this file to the @command{tar} command via the @option{-X}
-command-line option, when it prepares the package for download.)
-
-@node Package Archives
-@section Creating and Maintaining Package Archives
-@cindex package archive
-
-@cindex GNU ELPA
-@cindex non-GNU ELPA
- Via the Package Menu, users may download packages from @dfn{package
-archives}. Such archives are specified by the variable
-@code{package-archives}, whose default value lists the archives
-hosted on @url{https://elpa.gnu.org, GNU ELPA} and
-@url{https://elpa.nongnu.org, non-GNU ELPA}. This section describes
-how to set up and maintain a package archive.
-
-@cindex base location, package archive
-@defopt package-archives
-The value of this variable is an alist of package archives recognized
-by the Emacs package manager.
-
-Each alist element corresponds to one archive, and should have the
-form @code{(@var{id} . @var{location})}, where @var{id} is the name of
-the archive (a string) and @var{location} is its @dfn{base location}
-(a string).
-
-If the base location starts with @samp{http:} or @samp{https:}, it
-is treated as an HTTP(S) URL, and packages are downloaded from this
-archive via HTTP(S) (as is the case for the default GNU archive).
-
-Otherwise, the base location should be a directory name. In this
-case, Emacs retrieves packages from this archive via ordinary file
-access. Such local archives are mainly useful for testing.
-@end defopt
-
- A package archive is simply a directory in which the package files,
-and associated files, are stored. If you want the archive to be
-reachable via HTTP, this directory must be accessible to a web server;
-@xref{Archive Web Server}.
-
-@noindent
-After you create an archive, remember that it is not accessible in the
-Package Menu interface unless it is in @code{package-archives}.
-
-@cindex package archive security
-@cindex package signing
-Maintaining a public package archive entails a degree of responsibility.
-When Emacs users install packages from your archive, those packages
-can cause Emacs to run arbitrary code with the permissions of the
-installing user. (This is true for Emacs code in general, not just
-for packages.) So you should ensure that your archive is
-well-maintained and keep the hosting system secure.
-
- One way to increase the security of your packages is to @dfn{sign}
-them using a cryptographic key. If you have generated a
-private/public gpg key pair, you can use gpg to sign the package like
-this:
-
-@c FIXME EasyPG / package-x way to do this.
-@example
-gpg -ba -o @var{file}.sig @var{file}
-@end example
-
-@noindent
-For a single-file package, @var{file} is the package Lisp file;
-for a multi-file package, it is the package tar file.
-You can also sign the archive's contents file in the same way.
-Make the @file{.sig} files available in the same location as the packages.
-You should also make your public key available for people to download;
-e.g., by uploading it to a key server such as @url{https://pgp.mit.edu/}.
-When people install packages from your archive, they can use
-your public key to verify the signatures.
-
-A full explanation of these matters is outside the scope of this
-manual. For more information on cryptographic keys and signing,
-@pxref{Top,, GnuPG, gnupg, The GNU Privacy Guard Manual}. Emacs comes
-with an interface to GNU Privacy Guard, @pxref{Top,, EasyPG, epa,
-Emacs EasyPG Assistant Manual}.
-
-@node Archive Web Server
-@section Interfacing to an archive web server
-@cindex archive web server
-
-A web server providing access to a package archive must support the
-following queries:
-
-@table @asis
-@item archive-contents
-Return a lisp form describing the archive contents. The form is a list
-of 'package-desc' structures (see @file{package.el}), except the first
-element of the list is the archive version.
-
-@item <package name>-readme.txt
-Return the long description of the package.
-
-@item <file name>.sig
-Return the signature for the file.
-
-@item <file name>
-Return the file. This will be the tarball for a multi-file
-package, or the single file for a simple package.
-
-@end table
-
-@node Forwards-Compatibility
-@section Supporting older versions of Emacs
-@cindex compatibility compat
-
-Packages that wish to support older releases of Emacs, without giving
-up on newer functionality from recent Emacs releases, one can make use
-of the Compat package on GNU ELPA. By depending on the package, Emacs
-can provide compatibility definitions for missing functionality.
-
-The versioning of Compat follows that of Emacs, so next to the oldest
-version that a package relies on (via the @code{emacs}-package), one
-can also indicate what the newest version of Emacs is, that a package
-wishes to use definitions from:
-
-@example
-;; Package-Requires: ((emacs "27.2") (compat "29.1"))
-@end example
-
-Note that Compat provides replacement functions with extended
-functionality for functions that are already defined (@code{sort},
-@code{assoc}, @dots{}). These functions may have changed their
-calling convention (additional optional arguments) or may have changed
-their behavior. These functions must be looked up explicitly with
-@code{compat-function} or called explicitly with @code{compat-call}.
-We call them @dfn{Extended Definitions}. In contrast, newly @dfn{Added
-Definitions} can be called as usual.
-
-@defmac compat-call fun &rest args
-This macro calls the compatibility function @var{fun} with @var{args}.
-Many functions provided by Compat can be called directly without this
-macro. However in the case where Compat provides an alternative
-version of an existing function, the function call has to go through
-@code{compat-call}.
-@end defmac
-
-@defmac compat-function fun
-This macro returns the compatibility function symbol for @var{fun}.
-See @code{compat-call} for a more convenient macro to directly call
-compatibility functions.
-@end defmac
-
-For further details on how to make use of the package, see
-@ref{Usage,, Usage, compat, "Compat" Manual}. In case you don't have
-the manual installed, you can also read the
-@url{https://elpa.gnu.org/packages/doc/compat.html#Usage, Online
-Compat manual}.
:if (memq window-system '(ns x))
@end lisp
-@item
-Installed package
-
-The following example loads a package only when the @samp{foo} package
-is installed.
-
-@lisp
-:if (package-installed-p 'foo)
-@end lisp
-
@item
Libraries in @code{load-path}
# All generated autoload files.
loaddefs = $(shell find ${srcdir} -name '*loaddefs.el' ! -name '.*')
# Elisp files auto-generated.
-AUTOGENEL = ${loaddefs} ${srcdir}/cus-load.el ${srcdir}/finder-inf.el \
+AUTOGENEL = ${loaddefs} ${srcdir}/cus-load.el \
${srcdir}/subdirs.el ${srcdir}/eshell/esh-groups.el
# Set load-prefer-newer for the benefit of the non-bootstrappers.
# cus-load, finder-inf and autoloads are not explicitly requested by
# anything, so we add them here to make sure they get built.
-all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el generate-ja-dic \
+all: compile-main $(lisp)/cus-load.el generate-ja-dic \
org-manuals autoloads
PHONY_EXTRAS =
-.PHONY: all custom-deps finder-data autoloads update-subdirs $(PHONY_EXTRAS) \
+.PHONY: all custom-deps autoloads update-subdirs $(PHONY_EXTRAS) \
generate-ja-dic org-manuals
# custom-deps and finder-data both used to scan _all_ the *.el files.
--eval '(setq generated-custom-dependencies-file (unmsys--file-name "$(srcdir)/cus-load.el"))' \
-f custom-make-dependencies ${SUBDIRS_ALMOST}
-finder-data:
- $(AM_V_at)$(MAKE) PHONY_EXTRAS=$(lisp)/finder-inf.el \
- $(lisp)/finder-inf.el
-$(lisp)/finder-inf.el:
- $(AM_V_GEN)$(emacs) -l finder \
- --eval '(setq generated-finder-keywords-file (unmsys--file-name "$(srcdir)/finder-inf.el"))' \
- -f finder-compile-keywords-make-dist ${SUBDIRS_FINDER}
-
# This is the OKURO-NASI compilation trigger.
generate-ja-dic: main-first
$(AM_V_at)$(MAKE) -C ../leim generate-ja-dic EMACS="$(EMACS)"
.PHONY: updates repo-update update-authors
# Some modes of make-dist use this.
-updates: update-subdirs autoloads finder-data custom-deps
+updates: update-subdirs autoloads custom-deps
# This is useful after updating from the repository; but it doesn't do
# anything that a plain "make" at top-level doesn't. The only
# runs "autoloads" as well (because it uses "compile" rather than
# "compile-main"). In a bootstrap, $(lisp) in src/Makefile triggers
# this directory's autoloads rule.
-repo-update: compile finder-data custom-deps
+repo-update: compile custom-deps
# Update etc/AUTHORS
'(if (search-backward "&" (line-beginning-position) t)
(replace-match (capitalize (user-login-name)) t t))
'(end-of-line 1) " <" (progn user-mail-address) ">
-;; Keywords: "
- '(require 'finder)
- ;;'(setq v1 (apply 'vector (mapcar 'car finder-known-keywords)))
- '(setq v1 (mapcar (lambda (x) (list (symbol-name (car x))))
- finder-known-keywords))
- ((completing-read "Keyword, C-h: " v1 nil t) str ", ")
- & -2 "
+;; Keywords:
-\;; This program 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.
+;; This program 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.
-\;; This program 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.
+;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>.
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-\;;; Commentary:
+;;; Commentary:
-\;; " _ "
+;; " _ "
-\;;; Code:
+;;; Code:
-\(provide '"
+(provide '"
(file-name-base (buffer-file-name))
")
-\;;; " (file-name-nondirectory (buffer-file-name)) " ends here\n")
+;;; " (file-name-nondirectory (buffer-file-name)) " ends here\n")
(("\\.texi\\(nfo\\)?\\'" . "Texinfo file skeleton")
"Title: "
"\\input texinfo @c -*-texinfo-*-
;; See finder-no-scan-regexp in finder.el.
(defvar custom-dependencies-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|\
-ldefs-boot\\|cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
+ldefs-boot\\|cus-load\\|esh-groups\\|subdirs\\)\\.el$\\)"
"Regexp matching file names not to scan for `custom-make-dependencies'.")
(require 'loaddefs-gen)
(dolist (hook modehooks)
(remove-hook hook #'editorconfig-major-mode-hook))))))
-
-;; (defconst editorconfig--version
-;; (eval-when-compile
-;; (require 'lisp-mnt)
-;; (declare-function lm-version "lisp-mnt" nil)
-;; (lm-version))
-;; "EditorConfig version.")
-
-;; ;;;###autoload
-;; (defun editorconfig-version (&optional show-version)
-;; "Get EditorConfig version as string.
-;;
-;; If called interactively or if SHOW-VERSION is non-nil, show the
-;; version in the echo area and the messages buffer."
-;; (interactive (list t))
-;; (let ((version-full
-;; (if (fboundp 'package-get-version)
-;; (package-get-version)
-;; (let* ((version
-;; (with-temp-buffer
-;; (require 'find-func)
-;; (declare-function find-library-name "find-func" (library))
-;; (insert-file-contents (find-library-name "editorconfig"))
-;; (require 'lisp-mnt)
-;; (declare-function lm-version "lisp-mnt" nil)
-;; (lm-version)))
-;; (pkg (and (eval-and-compile (require 'package nil t))
-;; (cadr (assq 'editorconfig
-;; package-alist))))
-;; (pkg-version (and pkg (package-version-join
-;; (package-desc-version pkg)))))
-;; (if (and pkg-version
-;; (not (string= version pkg-version)))
-;; (concat version "-" pkg-version)
-;; version)))))
-;; (when show-version
-;; (message "EditorConfig Emacs v%s" version-full))
-;; version-full))
-
(provide 'editorconfig)
;;; editorconfig.el ends here
:type 'boolean)
;;;###autoload(put 'checkdoc-arguments-in-order-flag 'safe-local-variable #'booleanp)
-(defcustom checkdoc-package-keywords-flag nil
- "Non-nil means warn if this file's package keywords are not recognized.
-Currently, all recognized keywords must be on `finder-known-keywords'."
- :version "25.1"
- :type 'boolean)
-;;;###autoload(put 'checkdoc-package-keywords-flag 'safe-local-variable #'booleanp)
-
(defvar checkdoc-style-functions nil
"Hook run after the standard style check is completed.
All functions must return nil or a string representing the error found.
(checkdoc-start take-notes)
(checkdoc-message-text)
(checkdoc-rogue-spaces)
- (when checkdoc-package-keywords-flag
- (checkdoc-package-keywords))
(not (called-interactively-p 'interactive))
(if take-notes (checkdoc-show-diagnostics))
(message "Checking buffer for style...Done."))))
(when (re-search-forward "^;; Keywords: \\(.*\\)$" nil t)
(split-string (match-string-no-properties 1) ", " t))))
-(defvar finder-known-keywords)
-
-;;;###autoload
-(defun checkdoc-package-keywords ()
- "Find package keywords that aren't in `finder-known-keywords'."
- (interactive nil emacs-lisp-mode)
- (require 'finder)
- (let ((unrecognized-keys
- (cl-remove-if
- (lambda (x) (assoc (intern-soft x) finder-known-keywords))
- (checkdoc-get-keywords))))
- (if unrecognized-keys
- (let* ((checkdoc-autofix-flag 'never)
- (checkdoc-generate-compile-warnings-flag t))
- (save-excursion
- (goto-char (point-min))
- (re-search-forward "^;; Keywords: \\(.*\\)$" nil t)
- (checkdoc-start-section "checkdoc-package-keywords")
- (checkdoc-create-error
- (concat "Unrecognized keywords: "
- (mapconcat #'identity unrecognized-keys ", "))
- (match-beginning 1) (match-end 1)))
- (checkdoc-show-diagnostics))
- (when (called-interactively-p 'any)
- (message "No Package Keyword Errors.")))))
-
(custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode)
(define-obsolete-function-alias 'checkdoc-run-hooks
load-path
backtrace-line-length
byte-compile-warnings
- comp-sanitizer-emit
- ;; package-load-list
- ;; package-user-dir
- ;; package-directory-list
- ))
+ comp-sanitizer-emit))
(when (boundp var)
(push var set)
(push `',(symbol-value var) set)))
(nreverse set))
- ;; FIXME: Activating all packages would align the
- ;; functionality offered with what is usually done
- ;; for ELPA packages (and thus fix some compilation
- ;; issues with some ELPA packages), but it's too
- ;; blunt an instrument (e.g. we don't even know if
- ;; we're compiling such an ELPA package at
- ;; this point).
- ;;(package-activate-all)
,native-comp-async-env-modifier-form
(message "Compiling %s..." ,source-file)
(comp--native-compile ,source-file ,(and load t))))
(put 'find-library 'minibuffer-action '(display-library . "find"))
-(defvar finder-known-keywords)
-(declare-function finder-unknown-keywords "finder" ())
+(declare-function lm-keywords-list "lisp-mnt" (&optional library))
(declare-function lm-keywords "lisp-mnt" (&optional library))
(declare-function lm-summary "lisp-mnt" (&optional library))
-(defun find-func--finder-keyword-affixation (keywords)
- "Add annotations to list of keyword completion candidates KEYWORDS."
- (require 'finder) ; `finder-known-keywords'
- (let ((max (seq-max (cons 0 (mapcar #'string-width keywords)))))
- (mapcar (lambda (keyword)
- (list keyword
- ""
- (concat
- (make-string (1+ (- max (string-width keyword))) ?\s)
- (propertize
- (alist-get (intern keyword) finder-known-keywords "")
- 'face 'completions-annotations))))
- keywords)))
+(defvar find-func-library-keywords-cache (make-hash-table :test 'equal))
+
+(defun find-func-library-keywords ()
+ (seq-uniq
+ (mapcan (lambda (f)
+ (let ((mod-time (file-attribute-modification-time (file-attributes f)))
+ (cached (gethash f find-func-library-keywords-cache '(0))))
+ (if (time-less-p (car cached) mod-time)
+ (let ((res (with-temp-buffer
+ (insert-file-contents f nil nil 1024)
+ (lm-keywords-list))))
+ (puthash f (cons mod-time res) find-func-library-keywords-cache)
+ res)
+ (copy-sequence (cdr cached)))))
+ (mapcan (lambda (d)
+ (when (file-exists-p d)
+ (directory-files d t (rx ".el" eos))))
+ load-path))))
(defun read-library-name-narrow-completions-by-keyword ()
"Restrict library completions list to libraries with a given keyword."
- (require 'finder) ; `finder-(un)known-keywords'
(require 'lisp-mnt) ; `lm-keywords'
- (let* ((keyword (completing-read
- "Keep libraries with keyword: "
- (completion-table-with-metadata
- (mapcar (compose #'symbol-name #'car)
- (append finder-known-keywords
- (finder-unknown-keywords)))
- `((category . finder-keyword)
- ,@(when completions-detailed
- `((affixation-function
- . find-func--finder-keyword-affixation))))))))
+ (let* ((kws :unset)
+ (keyword (completing-read
+ "Library keyword: "
+ (lambda (string pred action)
+ (unless (or (eq (car-safe action) 'boundaries) (eq action 'metadata))
+ (when (eq kws :unset) (setq kws (find-func-library-keywords)))
+ (complete-with-action action kws string pred))))))
(cons (lambda (cand &rest _)
(let* ((string (cond
((stringp cand) cand)
((symbolp cand) (symbol-name cand))
(t (car cand))))
(sym (intern string)))
- (string-match (concat "\\<" keyword "\\>")
- (or (get sym 'library-keywords)
- (let ((kws (or (lm-keywords (find-library-name string)) "")))
- (put sym 'library-keywords kws)
- kws)))))
+ (string-match
+ (concat "\\<" keyword "\\>")
+ (or (get sym 'library-keywords)
+ (let ((kws (or (with-temp-buffer
+ (insert-file-contents (find-library-name string) nil nil 1024)
+ (lm-keywords))
+ "")))
+ (put sym 'library-keywords kws)
+ kws)))))
(concat "keyword=" keyword))))
(defun read-library-name-affixation (libraries)
(split-string keywords ",[ \t\n]*" t "[ ]+")
(split-string keywords "[ \t\n]+" t "[ ]+")))))
-(defvar finder-known-keywords)
-(defun lm-keywords-finder-p (&optional file)
- "Return non-nil if any keywords in FILE are known to finder."
- (require 'finder)
- (let ((keys (lm-keywords-list file)))
- (catch 'keyword-found
- (while keys
- (if (assoc (intern (car keys)) finder-known-keywords)
- (throw 'keyword-found t))
- (setq keys (cdr keys)))
- nil)))
-
(defun lm-adapted-by (&optional file)
"Return the adapted-by names in file FILE, or current buffer if FILE is nil.
This is the name of the person who cleaned up this package for
"Can't find the one-line summary description")
((not (lm-keywords))
"`Keywords:' tag missing")
- ((not (lm-keywords-finder-p))
- "`Keywords:' has no valid finder keywords (see `finder-known-keywords')")
((not (lm-commentary-start))
"Can't find a `Commentary' section marker")
((not (lm-history-start))
+++ /dev/null
-;;; package-vc.el --- Manage packages from VC checkouts -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; Author: Philip Kaludercic <philipk@posteo.net>
-;; Maintainer: Philip Kaludercic <philipk@posteo.net>
-;; Keywords: tools
-
-;; 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:
-
-;; While packages managed by package.el use tarballs for distributing
-;; the source code, this extension allows for packages to be fetched
-;; and upgraded directly from a version control system.
-;;
-;; To install a package from source use `package-vc-install'. If you
-;; aren't interested in activating a package, you can use
-;; `package-vc-checkout' instead, which will prompt you for a target
-;; directory. If you wish to reuse an existing checkout, the command
-;; `package-vc-install-from-checkout' will create a symbolic link and
-;; prepare the package.
-;;
-;; If you make local changes that you wish to share with an upstream
-;; maintainer, the command `package-vc-prepare-patch' can prepare
-;; these as patches to send via Email.
-
-;;; TODO:
-
-;; - Allow maintaining patches that are ported back onto regular
-;; packages and maintained between versions.
-
-;;; Code:
-
-(eval-when-compile (require 'rx))
-(eval-when-compile (require 'map))
-(eval-when-compile (require 'cl-lib))
-(require 'package)
-(require 'lisp-mnt)
-(require 'vc)
-(require 'seq)
-
-(defgroup package-vc nil
- "Manage packages from VC checkouts."
- :group 'package
- :link '(custom-manual "(emacs) Fetching Package Sources")
- :prefix "package-vc-"
- :version "29.1")
-
-(defconst package-vc--elpa-packages-version 1
- "Version number of the package specification format understood by package-vc.")
-
-(define-obsolete-variable-alias
- 'package-vc-heuristic-alist
- 'vc-clone-heuristic-alist "31.1")
-
-(defcustom package-vc-default-backend 'Git
- "Default VC backend to use for cloning package repositories.
-`package-vc-install' uses this backend when you specify neither
-the backend nor a repository URL that's recognized via
-`vc-clone-heuristic-alist'.
-
-The value must be a member of `vc-handled-backends' that supports
-the `clone' VC function."
- :type vc-cloneable-backends-custom-type
- :version "29.1")
-
-(defcustom package-vc-register-as-project t
- "Non-nil means that packages should be registered as projects."
- :type 'boolean
- :version "30.1")
-
-(defvar package-vc-selected-packages) ; pacify byte-compiler
-
-;;;###autoload
-(defun package-vc-install-selected-packages ()
- "Ensure packages specified in `package-vc-selected-packages' are installed."
- (interactive)
- (pcase-dolist (`(,name . ,spec) package-vc-selected-packages)
- (when (stringp name)
- (setq name (intern name)))
- (let ((pkg-descs (assoc name package-alist #'string=)))
- (unless (seq-some #'package-vc-p (cdr pkg-descs))
- (cond
- ((null spec)
- (package-vc-install name))
- ((stringp spec)
- (package-vc-install name spec))
- ((listp spec)
- (package-vc--archives-initialize)
- (package-vc--unpack
- (or (cadr (assoc name package-archive-contents))
- (package-desc-create :name name :kind 'vc))
- spec)))))))
-
-
-(defcustom package-vc-selected-packages nil
- "List of packages to install from their VCS repositories.
-Each element is of the form (NAME . SPEC), where NAME is a symbol
-designating the package and SPEC is one of:
-
-- nil, if any package version can be installed;
-- a version string, if that specific revision is to be installed;
-- a property list, describing a package specification. For possible
- values, see the subsection \"Specifying Package Sources\" in the
- Info node `(emacs)Fetching Package Sources'.
-
-The command `package-vc-install' updates the value of this user
-option to store package specifications for packages that are not
-specified in any archive."
- :type '(alist :tag "List of packages you want to be installed"
- :key-type (symbol :tag "Package")
- :value-type
- (choice (const :tag "Any revision" nil)
- (string :tag "Specific revision")
- (plist :options ((:url string)
- (:branch string)
- (:lisp-dir string)
- (:main-file string)
- (:doc string)
- (:vc-backend symbol)))))
- :version "29.1")
-
-(defvar package-vc--archive-spec-alists nil
- "List of package specifications for each archive.
-The list maps each package name, as a string, to a plist as
-specified in `package-vc-selected-packages'.")
-
-(defvar package-vc--archive-data-alist nil
- "List of package specification metadata for archives.
-Each element of the list has the form (ARCHIVE . PLIST), where
-PLIST keys are one of:
-
- `:version' (integer)
- Indicates the version of the file formatting, to be compared
- with `package-vc--elpa-packages-version'.
-
- `:vc-backend' (symbol)
- A symbol of the default VC backend to use if a package specification
- does not indicate a backend. The value ought to be a member of
- `vc-handled-backends'. If omitted, `vc-clone' will fall back on
- `package-vc-default-backend'.
-
-All other values are ignored.")
-
-(defun package-vc--desc->spec (pkg-desc &optional name)
- "Retrieve the package specification for PKG-DESC.
-The optional argument NAME can be used to override the default
-name for PKG-DESC."
- (alist-get
- (setq name (or name (package-desc-name pkg-desc)))
- (if (and (package-desc-archive pkg-desc)
- (not (alist-get name package-vc-selected-packages
- nil nil #'string=)))
- (alist-get (intern (package-desc-archive pkg-desc))
- package-vc--archive-spec-alists)
- ;; Consult both our local list of package specifications, as well
- ;; as the lists provided by the archives.
- (apply #'append (cons package-vc-selected-packages
- (mapcar #'cdr package-vc--archive-spec-alists))))
- '() nil #'string=))
-
-(defun package-vc--read-archive-data (archive)
- "Update `package-vc--archive-spec-alists' for ARCHIVE.
-This function is meant to be used as a hook for `package-read-archive-hook'."
- (let ((contents-file (expand-file-name
- (format "archives/%s/elpa-packages.eld" archive)
- package-user-dir)))
- (when (file-exists-p contents-file)
- (with-temp-buffer
- (let ((coding-system-for-read 'utf-8))
- (insert-file-contents contents-file)
- ;; The response from the server is expected to have the form
- ;;
- ;; ((("foo" :url "..." ...) ...)
- ;; :version 1
- ;; :default-vc Git)
- (let ((spec (read (current-buffer))))
- (when (eq package-vc--elpa-packages-version
- (plist-get (cdr spec) :version))
- (setf (alist-get (intern archive) package-vc--archive-spec-alists)
- (car spec)))
- (setf (alist-get (intern archive) package-vc--archive-data-alist)
- (cdr spec))
- (when-let ((default-vc (plist-get (cdr spec) :default-vc))
- ((not (memq default-vc vc-handled-backends))))
- (warn "Archive `%S' expects missing VC backend %S"
- archive (plist-get (cdr spec) :default-vc)))))))))
-
-(defun package-vc--download-and-read-archives (&optional async)
- "Download specifications of all `package-archives' and read them.
-Populate `package-vc--archive-spec-alists' with the result.
-
-If optional argument ASYNC is non-nil, perform the downloads
-asynchronously."
- (dolist (archive package-archives)
- (condition-case err
- (package--download-one-archive archive "elpa-packages.eld" async)
- (error (message "Failed to download `%s' archive: %S" (car archive) err)))))
-
-(add-hook 'package-read-archive-hook #'package-vc--read-archive-data 20)
-
-(defun package-vc-commit (pkg-desc)
- "Return the last commit of a development package PKG-DESC."
- (cl-assert (package-vc-p pkg-desc))
- ;; FIXME: vc should be extended to allow querying the commit of a
- ;; directory (as is possible when dealing with git repositories).
- ;; This should be a fallback option.
- (cl-loop with dir = (package-desc-dir pkg-desc)
- for file in (directory-files dir t "\\.el\\'" t)
- when (vc-working-revision file) return it
- finally return "unknown"))
-
-(defun package-vc--version (pkg)
- "Return the version number for the VC package PKG."
- (cl-assert (package-vc-p pkg))
- (if-let ((main-file (package-vc--main-file pkg)))
- (with-temp-buffer
- (insert-file-contents main-file)
- (package-strip-rcs-id
- (or (lm-header "package-version")
- (lm-header "version")
- "0")))
- "0"))
-
-(defun package-vc--main-file (pkg-desc)
- "Return the name of the main file for PKG-DESC."
- (cl-assert (package-vc-p pkg-desc))
- (let* ((pkg-spec (package-vc--desc->spec pkg-desc))
- (name (symbol-name (package-desc-name pkg-desc)))
- (directory (file-name-concat
- (or (package-desc-dir pkg-desc)
- (expand-file-name name package-user-dir))
- (plist-get pkg-spec :lisp-dir)))
- (file (expand-file-name
- (or (plist-get pkg-spec :main-file)
- (concat name ".el"))
- directory)))
- (if (file-exists-p file) file
- ;; The following heuristic is only necessary when fetching a
- ;; repository with URL that would break the above assumptions.
- ;; Concrete example: https://github.com/sachac/waveform-el does
- ;; not have a file waveform-el.el, but a file waveform.el, so we
- ;; try and find the closest match.
- (let ((distance most-positive-fixnum) (best nil))
- (dolist (alt (directory-files directory t "\\.el\\'" t))
- (let ((sd (string-distance file alt)))
- (when (and (not (string-match-p (rx (or (: "-autoloads.el")
- (: "-pkg.el"))
- eos)
- alt))
- (< sd distance))
- (when (< sd distance)
- (setq distance (string-distance file alt)
- best alt)))))
- best))))
-
-(defun package-vc--generate-description-file (pkg-desc pkg-file)
- "Generate a package description file for PKG-DESC and write it to PKG-FILE."
- (let ((name (package-desc-name pkg-desc)))
- ;; Infer the subject if missing.
- (unless (package-desc-summary pkg-desc)
- (setf (package-desc-summary pkg-desc)
- (let ((main-file (package-vc--main-file pkg-desc)))
- (or (package-desc-summary pkg-desc)
- (and-let* ((pkg (cadr (assq name package-archive-contents))))
- (package-desc-summary pkg))
- (and main-file (file-exists-p main-file)
- (lm-summary main-file))
- package--default-summary))))
- (let ((print-level nil)
- (print-quoted t)
- (print-length nil))
- (write-region
- (concat
- ";;; Generated package description from "
- (replace-regexp-in-string
- "-pkg\\.el\\'" ".el"
- (file-name-nondirectory pkg-file))
- " -*- no-byte-compile: t -*-\n"
- (prin1-to-string
- (nconc
- (list 'define-package
- (symbol-name name)
- (package-vc--version pkg-desc)
- (package-desc-summary pkg-desc)
- (let ((requires (package-desc-reqs pkg-desc)))
- (list 'quote
- ;; Turn version lists into string form.
- (mapcar
- (lambda (elt)
- (list (car elt)
- (package-version-join (cadr elt))))
- requires))))
- (list :kind 'vc)
- (package--alist-to-plist-args
- (let ((extras (copy-alist (package-desc-extras pkg-desc))))
- (setf (alist-get :commit extras)
- (package-vc-commit pkg-desc))
- extras)
- )))
- "\n")
- nil pkg-file nil 'silent))))
-
-(defcustom package-vc-allow-build-commands nil
- "Whether to run extra build commands when installing VC packages.
-
-Some packages specify \"make\" targets or other shell commands
-that should run prior to building the package, by including the
-:make or :shell-command keywords in their specification. By
-default, Emacs ignores these keywords when installing and
-upgrading VC packages, but if the value is a list of package
-names (symbols), the build commands will be run for those
-packages. If the value is t, always respect :make and
-:shell-command keywords.
-
-It may be necessary to run :make and :shell-command arguments in
-order to initialize a package or build its documentation, but
-please be careful when changing this option, as installing and
-updating a package can run potentially harmful code.
-
-This applies to package specifications that come from your
-configured package archives, as well as from entries in
-`package-vc-selected-packages' and specifications that you give
-to `package-vc-install' directly."
- :type '(choice (const :tag "Run for all packages" t)
- (repeat :tag "Run only for selected packages" (symbol :tag "Package name"))
- (const :tag "Never run" nil))
- :version "30.1")
-
-(defun package-vc--make (pkg-spec pkg-desc)
- "Process :make and :shell-command in PKG-SPEC.
-PKG-DESC is the package descriptor for the package that is being
-prepared."
- (let ((target (plist-get pkg-spec :make))
- (cmd (plist-get pkg-spec :shell-command))
- (buf (format " *package-vc make %s*" (package-desc-name pkg-desc))))
- (when (or cmd target)
- (with-current-buffer (get-buffer-create buf)
- (erase-buffer)
- (when (and cmd (/= 0 (call-process shell-file-name nil t nil shell-command-switch cmd)))
- (warn "Failed to run %s, see buffer %S" cmd (buffer-name)))
- (when (and target (/= 0 (apply #'call-process "make" nil t nil (if (consp target) target (list target)))))
- (warn "Failed to make %s, see buffer %S" target (buffer-name)))))))
-
-(declare-function org-export-to-file "ox" (backend file))
-
-(defun package-vc--build-documentation (pkg-desc file)
- "Build documentation for package PKG-DESC from documentation source in FILE.
-FILE can be an Org file, indicated by its \".org\" extension,
-otherwise it's assumed to be an Info file."
- (let* ((pkg-name (package-desc-name pkg-desc))
- (default-directory (package-desc-dir pkg-desc))
- (docs-directory (file-name-directory (expand-file-name file)))
- (output (expand-file-name (format "%s.info" pkg-name)))
- (log-buffer (get-buffer-create (format " *package-vc doc: %s*" pkg-name)))
- clean-up)
- (with-current-buffer log-buffer
- (erase-buffer))
- (condition-case err
- (progn
- (when (string-match-p "\\.org\\'" file)
- (require 'ox)
- (require 'ox-texinfo)
- (with-temp-buffer
- (insert-file-contents file)
- (setq file (make-temp-file "ox-texinfo-"))
- (let ((default-directory docs-directory))
- (org-export-to-file 'texinfo file))
- (setq clean-up t)))
- (cond
- ((/= 0 (call-process "makeinfo" nil log-buffer nil
- "-I" docs-directory
- "--no-split" file
- "-o" output))
- (message "Failed to build manual %s, see buffer %S"
- file (buffer-name)))
- ((/= 0 (call-process "install-info" nil log-buffer nil
- output (expand-file-name "dir")))
- (message "Failed to install manual %s, see buffer %S"
- output (buffer-name)))
- ((kill-buffer log-buffer))))
- (error (with-current-buffer log-buffer
- (insert (error-message-string err)))
- (message "Failed to export org manual for %s, see buffer %S" pkg-name log-buffer)))
- (when clean-up
- (delete-file file))))
-
-(defun package-vc-install-dependencies (deps)
- "Install missing dependencies according to DEPS.
-
-DEPS is a list of elements (PACKAGE VERSION-LIST), where
-PACKAGE is a package name and VERSION-LIST is the required
-version of that package.
-
-Return a list of dependencies that couldn't be met (or nil, when
-this function successfully installs all given dependencies)."
- (let ((to-install '()) (missing '()))
- (cl-labels ((search (pkg)
- "Attempt to find all dependencies for PKG."
- (cond
- ((assq (car pkg) to-install)) ;inhibit cycles
- ((package-installed-p (car pkg)))
- ((let* ((pac package-archive-contents)
- (desc (cadr (assoc (car pkg) pac))))
- (if desc
- (let ((reqs (package-desc-reqs desc)))
- (push desc to-install)
- (mapc #'search reqs))
- (push pkg missing))))))
- (version-order (a b)
- "Predicate to sort packages in order."
- (version-list-<
- (package-desc-version b)
- (package-desc-version a)))
- (duplicate-p (a b)
- "Are A and B the same package?"
- (eq (package-desc-name a) (package-desc-name b)))
- (depends-on-p (target package)
- "Does PACKAGE depend on TARGET?"
- (or (eq target package)
- (let* ((pac package-archive-contents)
- (desc (cadr (assoc package pac))))
- (and desc (seq-some
- (apply-partially #'depends-on-p target)
- (mapcar #'car (package-desc-reqs desc)))))))
- (dependent-order (a b)
- (let ((desc-a (package-desc-name a))
- (desc-b (package-desc-name b)))
- (depends-on-p desc-a desc-b))))
- (mapc #'search deps)
- (cl-callf sort to-install #'version-order)
- (cl-callf seq-uniq to-install #'duplicate-p)
- (cl-callf sort to-install #'dependent-order))
- (mapc #'package-install-from-archive to-install)
- missing))
-
-(defun package-vc--unpack-1 (pkg-desc pkg-dir)
- "Prepare PKG-DESC that is already checked-out in PKG-DIR.
-This includes downloading missing dependencies, generating
-autoloads, generating a package description file (used to
-identify a package as a VC package later on), building
-documentation and marking the package as installed."
- (let* ((pkg-spec (package-vc--desc->spec pkg-desc))
- (lisp-dir (plist-get pkg-spec :lisp-dir))
- (lisp-path (file-name-concat pkg-dir lisp-dir))
- missing)
-
- ;; In case the package was installed directly from source, the
- ;; dependency list wasn't know beforehand, and they might have
- ;; to be installed explicitly.
- (let ((ignored-files
- (if (plist-get pkg-spec :ignored-files)
- (mapconcat
- (lambda (ignore)
- (wildcard-to-regexp
- (if (string-match-p "\\`/" ignore)
- (concat pkg-dir ignore)
- (concat "*/" ignore))))
- (plist-get pkg-spec :ignored-files)
- "\\|")
- regexp-unmatchable))
- (deps '()))
- (dolist (file (directory-files lisp-path t "\\.el\\'" t))
- (unless (string-match-p ignored-files file)
- (with-temp-buffer
- (insert-file-contents file)
- (when-let* ((require-lines (lm-header-multiline "package-requires")))
- (thread-last
- (mapconcat #'identity require-lines " ")
- package-read-from-string
- lm--prepare-package-dependencies
- (nconc deps)
- (setq deps))))))
- (dolist (dep deps)
- (cl-callf version-to-list (cadr dep)))
- (setf (package-desc-reqs pkg-desc) deps)
- (setf missing (package-vc-install-dependencies (delete-dups deps)))
- (setf missing (delq (assq (package-desc-name pkg-desc)
- missing)
- missing)))
-
- (let ((default-directory (file-name-as-directory pkg-dir))
- (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir)))
- ;; Generate autoloads
- (let* ((name (package-desc-name pkg-desc))
- (auto-name (format "%s-autoloads.el" name)))
- (package-generate-autoloads name lisp-path)
- (when lisp-dir
- (write-region
- (with-temp-buffer
- (insert ";; Autoload indirection for package-vc\n\n")
- (prin1 `(load (expand-file-name
- ,(file-name-concat lisp-dir auto-name)
- (or (and load-file-name
- (file-name-directory load-file-name))
- (car load-path))))
- (current-buffer))
- (buffer-string))
- nil (expand-file-name auto-name pkg-dir))))
-
- ;; Generate package file
- (package-vc--generate-description-file pkg-desc pkg-file)
-
- ;; Process :make and :shell-command arguments before building documentation
- (when (or (eq package-vc-allow-build-commands t)
- (memq (package-desc-name pkg-desc)
- package-vc-allow-build-commands))
- (package-vc--make pkg-spec pkg-desc))
-
- ;; Detect a manual
- (when (executable-find "install-info")
- (dolist (doc-file (ensure-list (plist-get pkg-spec :doc)))
- (package-vc--build-documentation pkg-desc doc-file))))
-
- ;; Remove any previous instance of PKG-DESC from `package-alist'
- (let ((pkgs (assq (package-desc-name pkg-desc) package-alist)))
- (when pkgs
- (setf (cdr pkgs) (seq-remove #'package-vc-p (cdr pkgs)))))
-
- ;; Update package-alist.
- (let ((new-desc (package-load-descriptor pkg-dir)))
- ;; Activation has to be done before compilation, so that if we're
- ;; upgrading and macros have changed we load the new definitions
- ;; before compiling.
- (when (package-activate-1 new-desc :reload :deps)
- ;; FIXME: Compilation should be done as a separate, optional, step.
- ;; E.g. for multi-package installs, we should first install all packages
- ;; and then compile them.
- (package--compile new-desc)
- (when package-native-compile
- (package--native-compile-async new-desc))
- ;; After compilation, load again any files loaded by
- ;; `activate-1', so that we use the byte-compiled definitions.
- (package--reload-previously-loaded new-desc)))
-
- ;; Mark package as selected
- (let ((name (package-desc-name pkg-desc)))
- (unless (memq name package-selected-packages)
- (package--save-selected-packages
- (cons name package-selected-packages))))
-
- (package--quickstart-maybe-refresh)
-
- ;; Confirm that the installation was successful
- (let ((main-file (package-vc--main-file pkg-desc)))
- (message "VC package `%s' installed (Version %s, Revision %S).%s"
- (package-desc-name pkg-desc)
- (lm-with-file main-file
- (package-strip-rcs-id
- (or (lm-header "package-version")
- (lm-header "version"))))
- (vc-working-revision main-file)
- (if missing
- (format
- " Failed to install the following dependencies: %s"
- (mapconcat
- (lambda (p)
- (format "%s (%s)" (car p) (cadr p)))
- missing ", "))
- "")))
- t))
-
-(declare-function project-remember-projects-under "project" (dir &optional recursive))
-
-(defun package-vc--clone (pkg-desc pkg-spec dir rev)
- "Clone the package PKG-DESC whose spec is PKG-SPEC into the directory DIR.
-REV specifies a specific revision to checkout. This overrides the `:branch'
-attribute in PKG-SPEC."
- (pcase-let* ((name (package-desc-name pkg-desc))
- ((map :url :branch) pkg-spec))
-
- ;; Clone the repository into `repo-dir' if necessary
- (unless (file-exists-p dir)
- (make-directory (file-name-directory dir) t)
- (let ((backend (or (plist-get pkg-spec :vc-backend)
- (vc-guess-url-backend url)
- (plist-get (alist-get (package-desc-archive pkg-desc)
- package-vc--archive-data-alist
- nil nil #'string=)
- :vc-backend)
- package-vc-default-backend)))
- (unless (vc-clone url backend dir
- (or (and (not (eq rev :last-release)) rev) branch))
- (error "Failed to clone %s from %s" name url))))
-
- (when package-vc-register-as-project
- (let ((default-directory dir))
- (require 'project)
- (project-remember-projects-under dir)))
-
- ;; Check out the latest release if requested
- (when (eq rev :last-release)
- (if-let ((release-rev (package-vc--release-rev pkg-desc)))
- (vc-retrieve-tag dir release-rev)
- (message "No release revision was found, continuing...")))))
-
-(defvar package-vc-non-code-file-names
- '(".dir-locals.el" ".dir-locals-2.el")
- "List of file names that do not contain Emacs Lisp code.
-This list is used by `package-vc--unpack' to better check if the
-user is fetching code from a repository that does not contain any
-Emacs Lisp files.")
-
-(defun package-vc--unpack (pkg-desc pkg-spec &optional rev)
- "Install the package described by PKG-DESC.
-PKG-SPEC is a package specification, a property list describing
-how to fetch and build the package. See `package-vc--archive-spec-alists'
-for details. The optional argument REV specifies a specific revision to
-checkout. This overrides the `:branch' attribute in PKG-SPEC."
- (unless (eq (package-desc-kind pkg-desc) 'vc)
- (let ((copy (copy-package-desc pkg-desc)))
- (setf (package-desc-kind copy) 'vc
- pkg-desc copy)))
- (pcase-let* (((map :lisp-dir) pkg-spec)
- (name (package-desc-name pkg-desc))
- (dirname (package-desc-full-name pkg-desc))
- (pkg-dir (file-name-as-directory (expand-file-name dirname package-user-dir))))
- (when (string-empty-p name)
- (user-error "Empty package name"))
- (setf (package-desc-dir pkg-desc) pkg-dir)
- (when (file-exists-p pkg-dir)
- (if (yes-or-no-p (format "Overwrite previous checkout for package `%s'?" name))
- (package--delete-directory pkg-dir)
- (error "There already exists a checkout for %s" name)))
- (package-vc--clone pkg-desc pkg-spec pkg-dir rev)
- (when (directory-empty-p pkg-dir)
- (delete-directory pkg-dir)
- (error "Empty checkout for %s" name))
- (unless (seq-remove
- (lambda (file)
- (member (file-name-nondirectory file) package-vc-non-code-file-names))
- (directory-files-recursively pkg-dir "\\.el\\'" nil))
- (when (yes-or-no-p (format "No Emacs Lisp files found when fetching \"%s\", \
-abort installation?" name))
- (delete-directory pkg-dir t)
- (user-error "Installation aborted")))
-
- ;; When nothing is specified about a `lisp-dir', then should
- ;; heuristically check if there is a sub-directory with lisp
- ;; files. These are conventionally just called "lisp" or "src".
- ;; If this directory exists and contains non-zero number of lisp
- ;; files, we will use that instead of `pkg-dir'.
- (catch 'done
- (dolist (name '("lisp" "src"))
- (when-let* (((null lisp-dir))
- (dir (expand-file-name name pkg-dir))
- ((file-directory-p dir))
- ((directory-files dir nil "\\`[^.].+\\.el\\'" t 1)))
- ;; We won't use `dir', since dir is an absolute path and we
- ;; don't want `lisp-dir' to depend on the current location of
- ;; the package installation, ie. to break if moved around the
- ;; file system or between installations.
- (throw 'done (setq lisp-dir name)))))
-
- ;; Ensure we have a copy of the package specification
- (unless (seq-some (lambda (alist) (equal (alist-get name (cdr alist)) pkg-spec))
- package-vc--archive-spec-alists)
- (customize-save-variable
- 'package-vc-selected-packages
- (cons (cons name pkg-spec)
- (seq-remove (lambda (spec) (string= name (car spec)))
- package-vc-selected-packages))))
-
- (package-vc--unpack-1 pkg-desc pkg-dir)))
-
-(defun package-vc--read-package-name (prompt &optional allow-url installed)
- "Query the user for a VC package and return a name with PROMPT.
-If the optional argument ALLOW-URL is non-nil, the user is also
-allowed to specify a non-package name. If the optional argument
-INSTALLED is non-nil, the selection will be filtered down to
-VC packages that have already been installed."
- (package-vc--archives-initialize)
- (completing-read prompt (if installed package-alist package-archive-contents)
- (if installed
- (lambda (pkg) (package-vc-p (cadr pkg)))
- (lambda (pkg)
- (or (package-vc--desc->spec (cadr pkg))
- ;; If we have no explicit VC data, we can try a kind of
- ;; heuristic and use the URL header, that might already be
- ;; pointing towards a repository, and use that as a backup
- (and-let* ((extras (package-desc-extras (cadr pkg)))
- (url (alist-get :url extras))
- ((vc-guess-url-backend url)))))))
- (not allow-url)))
-
-(defun package-vc--read-package-desc (prompt &optional installed)
- "Query the user for a VC package and return a description with PROMPT.
-If the optional argument INSTALLED is non-nil, the selection will
-be filtered down to VC packages that have already been
-installed, and the package description will be that of an
-installed package."
- (cadr (assoc (package-vc--read-package-name prompt nil installed)
- (if installed package-alist package-archive-contents)
- #'string=)))
-
-;;;###autoload
-(defun package-vc-upgrade-all ()
- "Upgrade all installed VC packages.
-
-This may fail if the local VCS state of one of the packages
-conflicts with its remote repository state."
- (interactive)
- (dolist (package package-alist)
- (dolist (pkg-desc (cdr package))
- (when (package-vc-p pkg-desc)
- (package-vc-upgrade pkg-desc))))
- (message "Done upgrading packages."))
-
-(declare-function vc-dir-prepare-status-buffer "vc-dir"
- (bname dir backend &optional create-new))
-
-;;;###autoload
-(defun package-vc-upgrade (pkg-desc)
- "Upgrade the package described by PKG-DESC from package's VC repository.
-
-This may fail if the local VCS state of the package conflicts
-with the remote repository state."
- (interactive (list (package-vc--read-package-desc "Upgrade VC package: " t)))
- ;; HACK: To run `package-vc--unpack-1' after checking out the new
- ;; revision, we insert a hook into `vc-post-command-functions', and
- ;; remove it right after it ran. To avoid running the hook multiple
- ;; times or even for the wrong repository (as `vc-pull' is often
- ;; asynchronous), we extract the relevant arguments using a pseudo
- ;; filter for `vc-filter-command-function', executed only for the
- ;; side effect, and store them in the lexical scope. When the hook
- ;; is run, we check if the arguments are the same (`eq') as the ones
- ;; previously extracted, and only in that case will be call
- ;; `package-vc--unpack-1'. Ugh...
- ;;
- ;; If there is a better way to do this, it should be done.
- (cl-assert (package-vc-p pkg-desc))
- (letrec ((pkg-dir (package-desc-dir pkg-desc))
- (vc-flags)
- (vc-filter-command-function
- (lambda (command file-or-list flags)
- (setq vc-flags flags)
- (list command file-or-list flags)))
- (post-upgrade
- (lambda (_command _file-or-list flags)
- (when (and (file-equal-p pkg-dir default-directory)
- (eq flags vc-flags))
- (unwind-protect
- (with-demoted-errors "Failed to activate: %S"
- (package-vc--unpack-1 pkg-desc pkg-dir))
- (remove-hook 'vc-post-command-functions post-upgrade))))))
- (add-hook 'vc-post-command-functions post-upgrade)
- (with-demoted-errors "Failed to fetch: %S"
- (require 'vc-dir)
- (with-current-buffer (vc-dir-prepare-status-buffer
- (format " *package-vc-dir: %s*" pkg-dir)
- pkg-dir (vc-responsible-backend pkg-dir))
- (vc-pull)))))
-
-(defun package-vc--archives-initialize ()
- "Initialize package.el and fetch package specifications."
- (package--archives-initialize)
- (unless package-vc--archive-data-alist
- (package-vc--download-and-read-archives)))
-
-(defun package-vc--release-rev (pkg-desc)
- "Return the latest revision that bumps the \"Version\" tag for PKG-DESC.
-If no such revision can be found, return nil."
- (with-current-buffer (find-file-noselect (package-vc--main-file pkg-desc))
- (vc-buffer-sync)
- (save-excursion
- (goto-char (point-min))
- (let ((case-fold-search t))
- (when (cond
- ((re-search-forward
- (concat (lm-get-header-re "package-version") ".*$")
- (lm-code-start) t))
- ((re-search-forward
- (concat (lm-get-header-re "version") ".*$")
- (lm-code-start) t)))
- (ignore-error vc-not-supported
- (vc-call-backend (vc-backend (buffer-file-name))
- 'last-change
- (buffer-file-name)
- (line-number-at-pos nil t))))))))
-
-;;;###autoload
-(defun package-vc-install (package &optional rev backend name)
- "Fetch a package described by PACKAGE and set it up for use with Emacs.
-
-PACKAGE specifies which package to install, where to find its
-source repository and how to build it.
-
-If PACKAGE is a symbol, install the package with that name
-according to metadata that package archives provide for it. This
-is the simplest way to call this function, but it only works if
-the package you want to install is listed in a package archive
-you have configured.
-
-If PACKAGE is a string, it specifies the URL of the package
-repository. In this case, optional argument BACKEND specifies
-the VC backend to use for cloning the repository; if it's nil,
-this function tries to infer which backend to use according to
-the value of `vc-clone-heuristic-alist' and if that fails it
-uses `package-vc-default-backend'. Optional argument NAME
-specifies the package name in this case; if it's nil, this
-package uses `file-name-base' on the URL to obtain the package
-name, otherwise NAME is the package name as a symbol.
-
-PACKAGE can also be a cons cell (PNAME . SPEC) where PNAME is the
-package name as a symbol, and SPEC is a plist that specifies how
-to fetch and build the package. For possible values, see the
-subsection \"Specifying Package Sources\" in the Info
-node `(emacs)Fetching Package Sources'.
-
-By default, this function installs the last revision of the
-package available from its repository. If REV is a string, it
-describes the revision to install, as interpreted by the relevant
-VC backend. The special value `:last-release' (interactively,
-the prefix argument), says to use the commit of the latest
-release, if it exists. The last release is the latest revision
-which changed the \"Version:\" header of the package's main Lisp
-file.
-
-If you use this function to install a package that you also have
-installed from a package archive, the version this function
-installs takes precedence."
- (interactive
- (progn
- ;; Initialize the package system to get the list of package
- ;; symbols for completion.
- (package-vc--archives-initialize)
- (let* ((name-or-url (package-vc--read-package-name
- "Fetch and install package: " t))
- (name (file-name-base (directory-file-name name-or-url))))
- (when (string-empty-p name)
- (user-error "Empty package name"))
- (list name-or-url
- (and current-prefix-arg :last-release)
- nil
- (intern (string-remove-prefix "emacs-" name))))))
- (package-vc--archives-initialize)
- (cond
- ((null package)
- (signal 'wrong-type-argument nil))
- ((consp package)
- (package-vc--unpack
- (package-desc-create :name (car package)
- :kind 'vc)
- (cdr package)
- rev))
- ((and-let* (((stringp package))
- (backend (or backend (vc-guess-url-backend package))))
- (package-vc--unpack
- (package-desc-create
- :name (or name (intern (file-name-base package)))
- :kind 'vc)
- (list :vc-backend backend :url package)
- rev)))
- ((and-let* ((desc (assoc package package-archive-contents #'string=)))
- (package-vc--unpack
- (cadr desc)
- (or (package-vc--desc->spec (cadr desc))
- (and-let* ((extras (package-desc-extras (cadr desc)))
- (url (alist-get :url extras))
- (backend (vc-guess-url-backend url)))
- (list :vc-backend backend :url url))
- (user-error "Package `%s' has no VC data" package))
- rev)))
- ((user-error "Unknown package to fetch: %s" package))))
-
-;;;###autoload
-(defun package-vc-checkout (pkg-desc directory &optional rev)
- "Clone the sources for PKG-DESC into DIRECTORY and visit that directory.
-Unlike `package-vc-install', this does not yet set up the package
-for use with Emacs; use `package-vc-install-from-checkout' for
-setting the package up after this function finishes. Optional
-argument REV means to clone a specific version of the package; it
-defaults to the last version available from the package's
-repository. If REV has the special value
-`:last-release' (interactively, the prefix argument), that stands
-for the last released version of the package."
- (interactive
- (let* ((name (package-vc--read-package-name "Fetch package source: ")))
- (list (cadr (assoc name package-archive-contents #'string=))
- (read-directory-name "Clone into new or empty directory: " nil nil
- (lambda (dir) (or (not (file-exists-p dir))
- (directory-empty-p dir))))
- (and current-prefix-arg :last-release))))
- (package-vc--archives-initialize)
- (let ((pkg-spec (or (package-vc--desc->spec pkg-desc)
- (and-let* ((extras (package-desc-extras pkg-desc))
- (url (alist-get :url extras))
- (backend (vc-guess-url-backend url)))
- (list :vc-backend backend :url url))
- (user-error "Package `%s' has no VC data"
- (package-desc-name pkg-desc)))))
- (package-vc--clone pkg-desc pkg-spec directory rev)
- (find-file directory)))
-
-;;;###autoload
-(defun package-vc-install-from-checkout (dir &optional name)
- "Install the package NAME from its source directory DIR.
-NAME defaults to the base name of DIR.
-Interactively, prompt the user for DIR, which should be a directory
-under version control, typically one created by `package-vc-checkout'.
-If invoked interactively with a prefix argument, prompt the user
-for the NAME of the package to set up."
- (interactive (let* ((dir (read-directory-name "Directory: "))
- (base (file-name-base (directory-file-name dir))))
- (list dir (and current-prefix-arg
- (read-string
- (format-prompt "Package name" base)
- nil nil base)))))
- (unless (vc-responsible-backend dir)
- (user-error "Directory %S is not under version control" dir))
- (package-vc--archives-initialize)
- (let* ((name (or name (file-name-base (directory-file-name dir))))
- (pkg-dir (expand-file-name name package-user-dir)))
- (when (file-exists-p pkg-dir)
- (if (yes-or-no-p (format "Overwrite previous checkout for package `%s'?" name))
- (package--delete-directory pkg-dir)
- (error "There already exists a checkout for %s" name)))
- (make-symbolic-link (expand-file-name dir) pkg-dir)
- (package-vc--unpack-1
- (package-desc-create
- :name (intern name)
- :dir pkg-dir
- :kind 'vc)
- (file-name-as-directory pkg-dir))))
-
-;;;###autoload
-(defun package-vc-rebuild (pkg-desc)
- "Rebuild the installation for package given by PKG-DESC.
-Rebuilding an installation means scraping for new autoload
-cookies, re-compiling Emacs Lisp files, building and installing
-any documentation, downloading any missing dependencies. This
-command does not fetch new revisions from a remote server. That
-is the responsibility of `package-vc-upgrade'. Interactively,
-prompt for the name of the package to rebuild."
- (interactive (list (package-vc--read-package-desc "Rebuild package: " t)))
- (package-vc--unpack-1 pkg-desc (package-desc-dir pkg-desc)))
-
-;;;###autoload
-(defun package-vc-prepare-patch (pkg-desc subject revisions)
- "Email patches for REVISIONS to maintainer of package PKG-DESC using SUBJECT.
-
-PKG-DESC is a package descriptor and SUBJECT is the subject of
-the message.
-
-Interactively, prompt for PKG-DESC, SUBJECT, and REVISIONS. When
-invoked with a numerical prefix argument, use the last N
-revisions. When invoked interactively in a Log View buffer with
-marked revisions, use those.
-
-See also `vc-prepare-patch'."
- (interactive
- (list (package-vc--read-package-desc "Package to prepare a patch for: " t)
- (and (not vc-prepare-patches-separately)
- (read-string "Subject: " "[PATCH] " nil nil t))
- (vc-prepare-patch-prompt-revisions)))
- (let ((default-directory (package-desc-dir pkg-desc)))
- (vc-prepare-patch (package-maintainers pkg-desc t)
- subject revisions)))
-
-(defun package-vc-log-incoming (pkg-desc)
- "Call `vc-log-incoming' for the package PKG-DESC."
- (interactive
- (list (package-vc--read-package-desc "Incoming log for package: " t)))
- (let ((default-directory (package-desc-dir pkg-desc)))
- (call-interactively #'vc-log-incoming)))
-
-(provide 'package-vc)
-;;; package-vc.el ends here
+++ /dev/null
-;;; package.el --- Simple package system for Emacs -*- lexical-binding:t -*-
-
-;; Copyright (C) 2007-2025 Free Software Foundation, Inc.
-
-;; Author: Tom Tromey <tromey@redhat.com>
-;; Daniel Hackney <dan@haxney.org>
-;; Created: 10 Mar 2007
-;; Version: 1.1.0
-;; Keywords: tools
-;; Package-Requires: ((tabulated-list "1.0"))
-
-;; 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:
-
-;; The idea behind package.el is to be able to download packages and
-;; install them. Packages are versioned and have versioned
-;; dependencies. Furthermore, this supports built-in packages which
-;; may or may not be newer than user-specified packages. This makes
-;; it possible to upgrade Emacs and automatically disable packages
-;; which have moved from external to core. (Note though that we don't
-;; currently register any of these, so this feature does not actually
-;; work.)
-
-;; A package is described by its name and version. The distribution
-;; format is either a tar file or a single .el file.
-
-;; A tar file should be named "NAME-VERSION.tar". The tar file must
-;; unpack into a directory named after the package and version:
-;; "NAME-VERSION". It must contain a file named "PACKAGE-pkg.el"
-;; which consists of a call to define-package. It may also contain a
-;; "dir" file and the info files it references.
-
-;; A .el file is named "NAME-VERSION.el" in the remote archive, but is
-;; installed as simply "NAME.el" in a directory named "NAME-VERSION".
-
-;; The downloader downloads all dependent packages. By default,
-;; packages come from the official GNU sources, but others may be
-;; added by customizing the `package-archives' alist. Packages get
-;; byte-compiled at install time.
-
-;; At activation time we will set up the load-path and the info path,
-;; and we will load the package's autoloads. If a package's
-;; dependencies are not available, we will not activate that package.
-
-;; Conceptually a package has multiple state transitions:
-;;
-;; * Download. Fetching the package from ELPA.
-;; * Install. Untar the package, or write the .el file, into
-;; ~/.emacs.d/elpa/ directory.
-;; * Autoload generation.
-;; * Byte compile. Currently this phase is done during install,
-;; but we may change this.
-;; * Activate. Evaluate the autoloads for the package to make it
-;; available to the user.
-;; * Load. Actually load the package and run some code from it.
-
-;; Other external functions you may want to use:
-;;
-;; M-x list-packages
-;; Enters a mode similar to buffer-menu which lets you manage
-;; packages. You can choose packages for install (mark with "i",
-;; then "x" to execute) or deletion, and you can see what packages
-;; are available. This will automatically fetch the latest list of
-;; packages from ELPA.
-;;
-;; M-x package-install-from-buffer
-;; Install a package consisting of a single .el file that appears
-;; in the current buffer. This only works for packages which
-;; define a Version header properly; package.el also supports the
-;; extension headers Package-Version (in case Version is an RCS id
-;; or similar), and Package-Requires (if the package requires other
-;; packages).
-;;
-;; M-x package-install-file
-;; Install a package from the indicated file. The package can be
-;; either a tar file or a .el file. A tar file must contain an
-;; appropriately-named "-pkg.el" file; a .el file must be properly
-;; formatted as with `package-install-from-buffer'.
-
-;;; Thanks:
-;;; (sorted by sort-lines):
-
-;; Jim Blandy <jimb@red-bean.com>
-;; Karl Fogel <kfogel@red-bean.com>
-;; Kevin Ryde <user42@zip.com.au>
-;; Lawrence Mitchell
-;; Michael Olson <mwolson@member.fsf.org>
-;; Sebastian Tennant <sebyte@smolny.plus.com>
-;; Stefan Monnier <monnier@iro.umontreal.ca>
-;; Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
-;; Phil Hagelberg <phil@hagelb.org>
-
-;;; ToDo:
-
-;; - putting info dirs at the start of the info path means
-;; users see a weird ordering of categories. OTOH we want to
-;; override later entries. maybe emacs needs to enforce
-;; the standard layout?
-;; - put bytecode in a separate directory tree
-;; - perhaps give users a way to recompile their bytecode
-;; or do it automatically when emacs changes
-;; - give users a way to know whether a package is installed ok
-;; - give users a way to view a package's documentation when it
-;; only appears in the .el
-;; - use/extend checkdoc so people can tell if their package will work
-;; - "installed" instead of a blank in the status column
-;; - tramp needs its files to be compiled in a certain order.
-;; how to handle this? fix tramp?
-;; - maybe we need separate .elc directories for various emacs
-;; versions. That way conditional compilation can work. But would
-;; this break anything?
-;; - William Xu suggests being able to open a package file without
-;; installing it
-;; - Interface with desktop.el so that restarting after an install
-;; works properly
-;; - Use hierarchical layout. PKG/etc PKG/lisp PKG/info
-;; ... except maybe lisp?
-;; - It may be nice to have a macro that expands to the package's
-;; private data dir, aka ".../etc". Or, maybe data-directory
-;; needs to be a list (though this would be less nice)
-;; a few packages want this, eg sokoban
-;; - Allow multiple versions on the server, so that if a user doesn't
-;; meet the requirements for the most recent version they can still
-;; install an older one.
-;; - Allow optional package dependencies
-;; then if we require 'bbdb', bbdb-specific lisp in lisp/bbdb
-;; and just don't compile to add to load path ...?
-;; - Our treatment of the info path is somewhat bogus
-
-;;; Code:
-
-(require 'cl-lib)
-(eval-when-compile (require 'subr-x))
-(eval-when-compile (require 'epg)) ;For setf accessors.
-(eval-when-compile (require 'inline)) ;For `define-inline'
-(require 'seq)
-
-(require 'tabulated-list)
-(require 'macroexp)
-(require 'url-handlers)
-(require 'browse-url)
-
-(defgroup package nil
- "Manager for Emacs Lisp packages."
- :group 'applications
- :version "24.1")
-
-\f
-;;; Customization options
-
-;;;###autoload
-(defcustom package-enable-at-startup t
- "Whether to make installed packages available when Emacs starts.
-If non-nil, packages are made available before reading the init
-file (but after reading the early init file). This means that if
-you wish to set this variable, you must do so in the early init
-file. Regardless of the value of this variable, packages are not
-made available if `user-init-file' is nil (e.g. Emacs was started
-with \"-q\").
-
-Even if the value is nil, you can type \\[package-initialize] to
-make installed packages available at any time, or you can
-call (package-activate-all) in your init-file.
-
-Note that this variable must be set to a non-default value in
-your early-init file, as the variable's value is used before
-loading the regular init file. Therefore, if you customize it
-via Customize, you should save your customized setting into
-your `early-init-file'."
- :type 'boolean
- :version "24.1")
-
-(defcustom package-load-list '(all)
- "List of packages for `package-activate-all' to make available.
-Each element in this list should be a list (NAME VERSION), or the
-symbol `all'. The symbol `all' says to make available the latest
-installed versions of all packages not specified by other
-elements.
-
-For an element (NAME VERSION), NAME is a package name (a symbol).
-VERSION should be t, a string, or nil.
-If VERSION is t, the most recent version is made available.
-If VERSION is a string, only that version is ever made available.
- Any other version, even if newer, is silently ignored.
- Hence, the package is \"held\" at that version.
-If VERSION is nil, the package is not made available (it is \"disabled\")."
- :type '(repeat (choice (const all)
- (list :tag "Specific package"
- (symbol :tag "Package name")
- (choice :tag "Version"
- (const :tag "disable" nil)
- (const :tag "most recent" t)
- (string :tag "specific version")))))
- :risky t
- :version "24.1")
-
-(defcustom package-archives `(("gnu" .
- ,(format "http%s://elpa.gnu.org/packages/"
- (if (gnutls-available-p) "s" "")))
- ("nongnu" .
- ,(format "http%s://elpa.nongnu.org/nongnu/"
- (if (gnutls-available-p) "s" ""))))
- "An alist of archives from which to fetch.
-The default value points to the GNU Emacs package repository.
-
-Each element has the form (ID . LOCATION).
- ID is an archive name, as a string.
- LOCATION specifies the base location for the archive.
- If it starts with \"http(s):\", it is treated as an HTTP(S) URL;
- otherwise it should be an absolute directory name.
- (Other types of URL are currently not supported.)
-
-Only add locations that you trust, since fetching and installing
-a package can run arbitrary code.
-
-HTTPS URLs should be used where possible, as they offer superior
-security."
- :type '(alist :key-type (string :tag "Archive name")
- :value-type (string :tag "URL or directory name"))
- :risky t
- :version "28.1")
-
-(defcustom package-menu-hide-low-priority 'archive
- "If non-nil, hide low priority packages from the packages menu.
-A package is considered low priority if there's another version
-of it available such that:
- (a) the archive of the other package is higher priority than
- this one, as per `package-archive-priorities';
- or
- (b) they both have the same archive priority but the other
- package has a higher version number.
-
-This variable has three possible values:
- nil: no packages are hidden;
- `archive': only criterion (a) is used;
- t: both criteria are used.
-
-This variable has no effect if `package-menu--hide-packages' is
-nil, so it can be toggled with \\<package-menu-mode-map>\\[package-menu-toggle-hiding]."
- :type '(choice (const :tag "Don't hide anything" nil)
- (const :tag "Hide per package-archive-priorities"
- archive)
- (const :tag "Hide per archive and version number" t))
- :version "25.1")
-
-(defcustom package-archive-priorities nil
- "An alist of priorities for packages.
-
-Each element has the form (ARCHIVE-ID . PRIORITY).
-
-When installing packages, the package with the highest version
-number from the archive with the highest priority is
-selected. When higher versions are available from archives with
-lower priorities, the user has to select those manually.
-
-Archives not in this list have the priority 0, as have packages
-that are already installed. If you use negative priorities for
-the archives, they will not be upgraded automatically.
-
-See also `package-menu-hide-low-priority'."
- :type '(alist :key-type (string :tag "Archive name")
- :value-type (integer :tag "Priority (default is 0)"))
- :risky t
- :version "25.1")
-
-(defcustom package-pinned-packages nil
- "An alist of packages that are pinned to specific archives.
-This can be useful if you have multiple package archives enabled,
-and want to control which archive a given package gets installed from.
-
-Each element of the alist has the form (PACKAGE . ARCHIVE), where:
- PACKAGE is a symbol representing a package
- ARCHIVE is a string representing an archive (it should be the car of
-an element in `package-archives', e.g. \"gnu\").
-
-Adding an entry to this variable means that only ARCHIVE will be
-considered as a source for PACKAGE. If other archives provide PACKAGE,
-they are ignored (for this package). If ARCHIVE does not contain PACKAGE,
-the package will be unavailable."
- :type '(alist :key-type (symbol :tag "Package")
- :value-type (string :tag "Archive name"))
- ;; This could prevent you from receiving updates for a package,
- ;; via an entry (PACKAGE . NON-EXISTING). Which could be an issue
- ;; if PACKAGE has a known vulnerability that is fixed in newer versions.
- :risky t
- :version "24.4")
-
-;;;###autoload
-(defcustom package-user-dir (locate-user-emacs-file "elpa")
- "Directory containing the user's Emacs Lisp packages.
-The directory name should be absolute.
-Apart from this directory, Emacs also looks for system-wide
-packages in `package-directory-list'."
- :type 'directory
- :initialize #'custom-initialize-delay
- :risky t
- :group 'applications
- :version "24.1")
-
-;;;###autoload
-(defcustom package-directory-list
- ;; Defaults are subdirs named "elpa" in the site-lisp dirs.
- (let (result)
- (dolist (f load-path)
- (and (stringp f)
- (equal (file-name-nondirectory f) "site-lisp")
- (push (expand-file-name "elpa" f) result)))
- (nreverse result))
- "List of additional directories containing Emacs Lisp packages.
-Each directory name should be absolute.
-
-These directories contain packages intended for system-wide; in
-contrast, `package-user-dir' contains packages for personal use."
- :type '(repeat directory)
- :initialize #'custom-initialize-delay
- :group 'applications
- :risky t
- :version "24.1")
-
-(declare-function epg-find-configuration "epg-config"
- (protocol &optional no-cache program-alist))
-
-(defcustom package-gnupghome-dir (expand-file-name "gnupg" package-user-dir)
- "Directory containing GnuPG keyring or nil.
-This variable specifies the GnuPG home directory used by package.
-That directory is passed via the option \"--homedir\" to GnuPG.
-If nil, do not use the option \"--homedir\", but stick with GnuPG's
-default directory."
- :type `(choice
- (const
- :tag "Default Emacs package management GnuPG home directory"
- ,(expand-file-name "gnupg" package-user-dir))
- (const
- :tag "Default GnuPG directory (GnuPG option --homedir not used)"
- nil)
- (directory :tag "A specific GnuPG --homedir"))
- :risky t
- :version "26.1")
-
-(defcustom package-check-signature 'allow-unsigned
- "Non-nil means to check package signatures when installing.
-
-This also applies to the \"archive-contents\" file that lists the
-contents of the archive.
-
-The value can be one of:
-
- t Accept a package only if it comes with at least
- one verified signature.
-
- `all' Same as t, but verify all signatures if there
- are more than one.
-
- `allow-unsigned' Install a package even if it is unsigned,
- but verify the signature if possible (that
- is, if it is signed, we have the key for it,
- and GnuPG is installed).
-
- nil Package signatures are ignored."
- :type '(choice (const :value nil :tag "Never")
- (const :value allow-unsigned :tag "Allow unsigned")
- (const :value t :tag "Check always")
- (const :value all :tag "Check always (all signatures)"))
- :risky t
- :version "27.1")
-
-(defun package-check-signature ()
- "Check whether we have a usable OpenPGP configuration.
-If so, and variable `package-check-signature' is
-`allow-unsigned', return `allow-unsigned', otherwise return the
-value of variable `package-check-signature'."
- (if (eq package-check-signature 'allow-unsigned)
- (and (epg-find-configuration 'OpenPGP)
- 'allow-unsigned)
- package-check-signature))
-
-(defcustom package-unsigned-archives nil
- "List of archives where we do not check for package signatures.
-This should be a list of strings matching the names of package
-archives in the variable `package-archives'."
- :type '(repeat (string :tag "Archive name"))
- :risky t
- :version "24.4")
-
-(defcustom package-selected-packages nil
- "Store here packages installed explicitly by user.
-This variable is fed automatically by Emacs when installing a new package.
-This variable is used by `package-autoremove' to decide
-which packages are no longer needed.
-You can use it to (re)install packages on other machines
-by running `package-install-selected-packages'.
-
-To check if a package is contained in this list here, use
-`package--user-selected-p', as it may populate the variable with
-a sane initial value."
- :version "25.1"
- :type '(repeat symbol))
-
-(defcustom package-native-compile nil
- "Non-nil means to natively compile packages as part of their installation.
-This controls ahead-of-time compilation of packages when they are
-installed. If this option is nil, packages will be natively
-compiled when they are loaded for the first time.
-
-This option does not have any effect if Emacs was not built with
-native compilation support."
- :type '(boolean)
- :risky t
- :version "28.1")
-
-(defcustom package-menu-async t
- "If non-nil, package-menu will use async operations when possible.
-Currently, only the refreshing of archive contents supports
-asynchronous operations. Package transactions are still done
-synchronously."
- :type 'boolean
- :version "25.1")
-
-(defcustom package-name-column-width 30
- "Column width for the Package name in the package menu."
- :type 'natnum
- :version "28.1")
-
-(defcustom package-version-column-width 14
- "Column width for the Package version in the package menu."
- :type 'natnum
- :version "28.1")
-
-(defcustom package-status-column-width 12
- "Column width for the Package status in the package menu."
- :type 'natnum
- :version "28.1")
-
-(defcustom package-archive-column-width 8
- "Column width for the Package archive in the package menu."
- :type 'natnum
- :version "28.1")
-
-\f
-;;; `package-desc' object definition
-;; This is the struct used internally to represent packages.
-;; Functions that deal with packages should generally take this object
-;; as an argument. In some situations (e.g. commands that query the
-;; user) it makes sense to take the package name as a symbol instead,
-;; but keep in mind there could be multiple `package-desc's with the
-;; same name.
-
-(defvar package--default-summary "No description available.")
-
-(define-inline package-vc-p (pkg-desc)
- "Return non-nil if PKG-DESC is a VC package."
- (inline-letevals (pkg-desc)
- (inline-quote (eq (package-desc-kind ,pkg-desc) 'vc))))
-
-(cl-defstruct (package-desc
- ;; Rename the default constructor from `make-package-desc'.
- (:constructor package-desc-create)
- ;; Has the same interface as the old `define-package',
- ;; which is still used in the "foo-pkg.el" files. Extra
- ;; options can be supported by adding additional keys.
- (:constructor
- package-desc-from-define
- (name-string version-string &optional summary requirements
- &rest rest-plist
- &aux
- (name (intern name-string))
- (version (if (eq (car-safe version-string) 'vc)
- (version-to-list (cdr version-string))
- (version-to-list version-string)))
- (reqs (mapcar (lambda (elt)
- (list (car elt)
- (version-to-list (cadr elt))))
- (if (eq 'quote (car requirements))
- (nth 1 requirements)
- requirements)))
- (kind (plist-get rest-plist :kind))
- (archive (plist-get rest-plist :archive))
- (extras (let (alist)
- (while rest-plist
- (unless (memq (car rest-plist) '(:kind :archive))
- (let ((value (cadr rest-plist)))
- (when value
- (push (cons (car rest-plist)
- (if (eq (car-safe value) 'quote)
- (cadr value)
- value))
- alist))))
- (setq rest-plist (cddr rest-plist)))
- alist)))))
- "Structure containing information about an individual package.
-Slots:
-
-`name' Name of the package, as a symbol.
-
-`version' Version of the package, as a version list.
-
-`summary' Short description of the package, typically taken from
- the first line of the file.
-
-`reqs' Requirements of the package. A list of (PACKAGE
- VERSION-LIST) naming the dependent package and the minimum
- required version.
-
-`kind' The distribution format of the package. Currently, it is
- either `single' or `tar'.
-
-`archive' The name of the archive (as a string) whence this
- package came.
-
-`dir' The directory where the package is installed (if installed),
- `builtin' if it is built-in, or nil otherwise.
-
-`extras' Optional alist of additional keyword-value pairs.
-
-`signed' Flag to indicate that the package is signed by provider."
- name
- version
- (summary package--default-summary)
- reqs
- kind
- archive
- dir
- extras
- signed)
-
-(defun package--from-builtin (bi-desc)
- "Create a `package-desc' object from BI-DESC.
-BI-DESC should be a `package--bi-desc' object."
- (package-desc-create :name (pop bi-desc)
- :version (package--bi-desc-version bi-desc)
- :summary (package--bi-desc-summary bi-desc)
- :dir 'builtin))
-
-;; Pseudo fields.
-(defun package-version-join (vlist)
- "Return the version string corresponding to the list VLIST.
-This is, approximately, the inverse of `version-to-list'.
-\(Actually, it returns only one of the possible inverses, since
-`version-to-list' is a many-to-one operation.)"
- (if (null vlist)
- ""
- (let ((str-list (list "." (int-to-string (car vlist)))))
- (dolist (num (cdr vlist))
- (cond
- ((>= num 0)
- (push (int-to-string num) str-list)
- (push "." str-list))
- ((< num -4)
- (error "Invalid version list `%s'" vlist))
- (t
- ;; pre, or beta, or alpha
- (cond ((equal "." (car str-list))
- (pop str-list))
- ((not (string-match "[0-9]+" (car str-list)))
- (error "Invalid version list `%s'" vlist)))
- (push (cond ((= num -1) "pre")
- ((= num -2) "beta")
- ((= num -3) "alpha")
- ((= num -4) "snapshot"))
- str-list))))
- (if (equal "." (car str-list))
- (pop str-list))
- (apply #'concat (nreverse str-list)))))
-
-(defun package-desc-full-name (pkg-desc)
- "Return full name of package-desc object PKG-DESC.
-This is the name of the package with its version appended."
- (if (package-vc-p pkg-desc)
- (symbol-name (package-desc-name pkg-desc))
- (format "%s-%s"
- (package-desc-name pkg-desc)
- (package-version-join (package-desc-version pkg-desc)))))
-
-(defun package-desc-suffix (pkg-desc)
- "Return file-name extension of package-desc object PKG-DESC.
-Depending on the `package-desc-kind' of PKG-DESC, this is one of:
-
- \\='single - \".el\"
- \\='tar - \".tar\"
- \\='dir - \"\"
-
-Signal an error if the kind is none of the above."
- (pcase (package-desc-kind pkg-desc)
- ('single ".el")
- ('tar ".tar")
- ('dir "")
- (kind (error "Unknown package kind: %s" kind))))
-
-(defun package-desc--keywords (pkg-desc)
- "Return keywords of package-desc object PKG-DESC.
-These keywords come from the foo-pkg.el file, and in general
-corresponds to the keywords in the \"Keywords\" header of the
-package."
- (let ((keywords (cdr (assoc :keywords (package-desc-extras pkg-desc)))))
- (if (eq (car-safe keywords) 'quote)
- (nth 1 keywords)
- keywords)))
-
-(defun package-desc-priority (pkg-desc)
- "Return the priority of the archive of package-desc object PKG-DESC."
- (package-archive-priority (package-desc-archive pkg-desc)))
-
-(defun package--parse-elpaignore (pkg-desc)
- "Return a list of regular expressions to match files ignored by PKG-DESC."
- (let* ((pkg-dir (file-name-as-directory (package-desc-dir pkg-desc)))
- (ignore (expand-file-name ".elpaignore" pkg-dir))
- files)
- (when (file-exists-p ignore)
- (with-temp-buffer
- (insert-file-contents ignore)
- (goto-char (point-min))
- (while (not (eobp))
- (push (wildcard-to-regexp
- (let ((line (buffer-substring
- (line-beginning-position)
- (line-end-position))))
- (file-name-concat pkg-dir (string-trim-left line "/"))))
- files)
- (forward-line)))
- files)))
-
-(cl-defstruct (package--bi-desc
- (:constructor package-make-builtin (version summary))
- (:type vector))
- "Package descriptor format used in finder-inf.el and package--builtins."
- version
- reqs
- summary)
-
-\f
-;;; Installed packages
-;; The following variables store information about packages present in
-;; the system. The most important of these is `package-alist'. The
-;; command `package-activate-all' is also closely related to this
-;; section.
-
-(defvar package--builtins nil
- "Alist of built-in packages.
-The actual value is initialized by loading the library
-`finder-inf'; this is not done until it is needed, e.g. by the
-function `package-built-in-p'.
-
-Each element has the form (PKG . PACKAGE-BI-DESC), where PKG is a package
-name (a symbol) and DESC is a `package--bi-desc' structure.")
-(put 'package--builtins 'risky-local-variable t)
-
-(defvar package-alist nil
- "Alist of all packages available for activation.
-Each element has the form (PKG . DESCS), where PKG is a package
-name (a symbol) and DESCS is a non-empty list of `package-desc'
-structures, sorted by decreasing versions.
-
-This variable is set automatically by `package-load-descriptor',
-called via `package-activate-all'. To change which packages are
-loaded and/or activated, customize `package-load-list'.")
-(put 'package-alist 'risky-local-variable t)
-
-;;;###autoload
-(defvar package-activated-list nil
- ;; FIXME: This should implicitly include all builtin packages.
- "List of the names of currently activated packages.")
-(put 'package-activated-list 'risky-local-variable t)
-
-;;;; Populating `package-alist'.
-
-;; The following functions are called on each installed package by
-;; `package-load-all-descriptors', which ultimately populates the
-;; `package-alist' variable.
-
-(declare-function package-vc-version "package-vc" (pkg))
-
-(defun package-process-define-package (exp)
- "Process define-package expression EXP and push it to `package-alist'.
-EXP should be a form read from a foo-pkg.el file.
-Convert EXP into a `package-desc' object using the
-`package-desc-from-define' constructor before pushing it to
-`package-alist'.
-
-If there already exists a package by the same name in
-`package-alist', insert this object there such that the packages
-are sorted with the highest version first."
- (when (eq (car-safe exp) 'define-package)
- (let* ((new-pkg-desc (apply #'package-desc-from-define (cdr exp)))
- (name (package-desc-name new-pkg-desc))
- (version (package-desc-version new-pkg-desc))
- (old-pkgs (assq name package-alist)))
- (if (null old-pkgs)
- ;; If there's no old package, just add this to `package-alist'.
- (push (list name new-pkg-desc) package-alist)
- ;; If there is, insert the new package at the right place in the list.
- (while
- (if (and (cdr old-pkgs)
- (version-list-< version
- (package-desc-version (cadr old-pkgs))))
- (setq old-pkgs (cdr old-pkgs))
- (push new-pkg-desc (cdr old-pkgs))
- nil)))
- new-pkg-desc)))
-
-(declare-function package-vc-commit "package-vc" (pkg))
-
-(defun package-load-descriptor (pkg-dir)
- "Load the package description file in directory PKG-DIR.
-Create a new `package-desc' object, add it to `package-alist' and
-return it."
- (let ((pkg-file (expand-file-name (package--description-file pkg-dir)
- pkg-dir))
- (signed-file (concat pkg-dir ".signed")))
- (when (file-exists-p pkg-file)
- (with-temp-buffer
- (insert-file-contents pkg-file)
- (goto-char (point-min))
- (let ((pkg-desc (or (package-process-define-package
- (read (current-buffer)))
- (error "Can't find define-package in %s" pkg-file))))
- (setf (package-desc-dir pkg-desc) pkg-dir)
- (if (file-exists-p signed-file)
- (setf (package-desc-signed pkg-desc) t))
- pkg-desc)))))
-
-(defun package-load-all-descriptors ()
- "Load descriptors for installed Emacs Lisp packages.
-This looks for package subdirectories in `package-user-dir' and
-`package-directory-list'. The variable `package-load-list'
-controls which package subdirectories may be loaded.
-
-In each valid package subdirectory, this function loads the
-description file containing a call to `define-package', which
-updates `package-alist'."
- (dolist (dir (cons package-user-dir package-directory-list))
- (when (file-directory-p dir)
- (dolist (pkg-dir (directory-files dir t "\\`[^.]"))
- (when (file-directory-p pkg-dir)
- (package-load-descriptor pkg-dir))))))
-
-(defun package--alist ()
- "Return `package-alist', after computing it if needed."
- (or package-alist
- (progn (package-load-all-descriptors)
- package-alist)))
-
-(defun define-package ( _name-string _version-string
- &optional _docstring _requirements
- &rest _extra-properties)
- "Define a new package.
-NAME-STRING is the name of the package, as a string.
-VERSION-STRING is the version of the package, as a string.
-DOCSTRING is a short description of the package, a string.
-REQUIREMENTS is a list of dependencies on other packages.
- Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION),
- where OTHER-VERSION is a string.
-
-EXTRA-PROPERTIES is currently unused."
- (declare (obsolete nil "29.1") (indent defun))
- (error "Don't call me!"))
-
-\f
-;;; Package activation
-;; Section for functions used by `package-activate', which see.
-
-(defun package-disabled-p (pkg-name version)
- "Return whether PKG-NAME at VERSION can be activated.
-The decision is made according to `package-load-list'.
-Return nil if the package can be activated.
-Return t if the package is completely disabled.
-Return the max version (as a string) if the package is held at a lower version."
- (let ((force (assq pkg-name package-load-list)))
- (cond ((null force) (not (memq 'all package-load-list)))
- ((null (setq force (cadr force))) t) ; disabled
- ((eq force t) nil)
- ((stringp force) ; held
- (unless (version-list-= version (version-to-list force))
- force))
- (t (error "Invalid element in `package-load-list'")))))
-
-(defun package-built-in-p (package &optional min-version)
- "Return non-nil if PACKAGE is built-in to Emacs.
-Optional arg MIN-VERSION, if non-nil, should be a version list
-specifying the minimum acceptable version."
- (if (package-desc-p package) ;; was built-in and then was converted
- (eq 'builtin (package-desc-dir package))
- (let ((bi (assq package package--builtin-versions)))
- (cond
- (bi (version-list-<= min-version (cdr bi)))
- ((remove 0 min-version) nil)
- (t
- (require 'finder-inf nil t) ; For `package--builtins'.
- (assq package package--builtins))))))
-
-(defun package--active-built-in-p (package)
- "Return non-nil if the built-in version of PACKAGE is used.
-If the built-in version of PACKAGE is used and PACKAGE is
-also available for installation from an archive, it is an
-indication that PACKAGE was never upgraded to any newer
-version from the archive."
- (and (not (assq (cond
- ((package-desc-p package)
- (package-desc-name package))
- ((stringp package) (intern package))
- ((symbolp package) package)
- ((error "Unknown package format: %S" package)))
- (package--alist)))
- (package-built-in-p package)))
-
-(defun package--autoloads-file-name (pkg-desc)
- "Return the absolute name of the autoloads file, sans extension.
-PKG-DESC is a `package-desc' object."
- (expand-file-name
- (format "%s-autoloads" (package-desc-name pkg-desc))
- (package-desc-dir pkg-desc)))
-
-(defvar Info-directory-list)
-(declare-function info-initialize "info" ())
-
-(defvar package--quickstart-pkgs t
- "If set to a list, we're computing the set of pkgs to activate.")
-
-(defsubst package--library-stem (file)
- (catch 'done
- (let (result)
- (dolist (suffix (get-load-suffixes) file)
- (setq result (string-trim file nil suffix))
- (unless (equal file result)
- (throw 'done result))))))
-
-(defun package--reload-previously-loaded (pkg-desc &optional warn)
- "Force reimportation of files in PKG-DESC already present in `load-history'.
-New editions of files contain macro definitions and
-redefinitions, the overlooking of which would cause
-byte-compilation of the new package to fail.
-If WARN is a string, display a warning (using WARN as a format string)
-before reloading the files. WARN must have two %-sequences
-corresponding to package name (a symbol) and a list of files loaded (as
-sexps)."
- (with-demoted-errors "Error in package--load-files-for-activation: %s"
- (let* (result
- (dir (package-desc-dir pkg-desc))
- ;; A previous implementation would skip `dir' itself.
- ;; However, in normal use reloading from the same directory
- ;; never happens anyway, while in certain cases external to
- ;; Emacs a package in the same directory not necessary
- ;; stays byte-identical, e.g. during development. Just
- ;; don't special-case `dir'.
- (effective-path (or (bound-and-true-p find-library-source-path)
- load-path))
- (files (directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))
- (history (mapcar #'file-truename
- (cl-remove-if-not #'stringp
- (mapcar #'car load-history)))))
- (dolist (file files)
- (when-let ((library (package--library-stem
- (file-relative-name file dir)))
- (canonical (locate-library library nil effective-path))
- (truename (file-truename canonical))
- ;; Normally, all files in a package are compiled by
- ;; now, but don't assume that. E.g. different
- ;; versions can add or remove `no-byte-compile'.
- (altname (if (string-suffix-p ".el" truename)
- (replace-regexp-in-string
- "\\.el\\'" ".elc" truename t)
- (replace-regexp-in-string
- "\\.elc\\'" ".el" truename t)))
- (found (or (member truename history)
- (and (not (string= altname truename))
- (member altname history))))
- (recent-index (length found)))
- (unless (equal (file-name-base library)
- (format "%s-autoloads" (package-desc-name pkg-desc)))
- (push (cons (expand-file-name library dir) recent-index) result))))
- (when (and result warn)
- (display-warning 'package
- (format warn (package-desc-name pkg-desc)
- (mapcar #'car result))))
- (mapc (lambda (c) (load (car c) nil t))
- (sort result (lambda (x y) (< (cdr x) (cdr y))))))))
-
-(defun package-activate-1 (pkg-desc &optional reload deps)
- "Activate package given by PKG-DESC, even if it was already active.
-If DEPS is non-nil, also activate its dependencies (unless they
-are already activated).
-If RELOAD is non-nil, also `load' any files inside the package which
-correspond to previously loaded files."
- (let* ((name (package-desc-name pkg-desc))
- (pkg-dir (package-desc-dir pkg-desc)))
- (unless pkg-dir
- (error "Internal error: unable to find directory for `%s'"
- (package-desc-full-name pkg-desc)))
- (catch 'exit
- ;; Activate its dependencies recursively.
- ;; FIXME: This doesn't check whether the activated version is the
- ;; required version.
- (when deps
- (dolist (req (package-desc-reqs pkg-desc))
- (unless (package-activate (car req))
- (message "Unable to activate package `%s'.\nRequired package `%s-%s' is unavailable"
- name (car req) (package-version-join (cadr req)))
- (throw 'exit nil))))
- (if (listp package--quickstart-pkgs)
- ;; We're only collecting the set of packages to activate!
- (push pkg-desc package--quickstart-pkgs)
- (when (or reload (assq name package--builtin-versions))
- (package--reload-previously-loaded
- pkg-desc (unless reload
- "Package %S is activated too late.
-The following files have already been loaded: %S")))
- (with-demoted-errors "Error loading autoloads: %s"
- (load (package--autoloads-file-name pkg-desc) nil t)))
- ;; Add info node.
- (when (file-exists-p (expand-file-name "dir" pkg-dir))
- ;; FIXME: not the friendliest, but simple.
- (require 'info)
- (info-initialize)
- (add-to-list 'Info-directory-list pkg-dir))
- (push name package-activated-list)
- ;; Don't return nil.
- t)))
-
-;;;; `package-activate'
-
-(defun package--get-activatable-pkg (pkg-name)
- ;; Is "activatable" a word?
- (let ((pkg-descs (cdr (assq pkg-name package-alist))))
- ;; Check if PACKAGE is available in `package-alist'.
- (while
- (when pkg-descs
- (let ((available-version (package-desc-version (car pkg-descs))))
- (or (package-disabled-p pkg-name available-version)
- ;; Prefer a builtin package.
- (package-built-in-p pkg-name available-version))))
- (setq pkg-descs (cdr pkg-descs)))
- (car pkg-descs)))
-
-;; This function activates a newer version of a package if an older
-;; one was already activated. It also loads a features of this
-;; package which were already loaded.
-(defun package-activate (package &optional force)
- "Activate the package named PACKAGE.
-If FORCE is true, (re-)activate it if it's already activated.
-Newer versions are always activated, regardless of FORCE."
- (let ((pkg-desc (package--get-activatable-pkg package)))
- (cond
- ;; If no such package is found, maybe it's built-in.
- ((null pkg-desc)
- (package-built-in-p package))
- ;; If the package is already activated, just return t.
- ((and (memq package package-activated-list) (not force))
- t)
- ;; Otherwise, proceed with activation.
- (t (package-activate-1 pkg-desc nil 'deps)))))
-
-\f
-;;; Installation -- Local operations
-;; This section contains a variety of features regarding installing a
-;; package to/from disk. This includes autoload generation,
-;; unpacking, compiling, as well as defining a package from the
-;; current buffer.
-
-;;;; Unpacking
-(defvar tar-parse-info)
-(declare-function tar-untar-buffer "tar-mode" ())
-(declare-function tar-header-name "tar-mode" (tar-header) t)
-(declare-function tar-header-link-type "tar-mode" (tar-header) t)
-
-(defun package-untar-buffer (dir)
- "Untar the current buffer.
-This uses `tar-untar-buffer' from Tar mode. All files should
-untar into a directory named DIR; otherwise, signal an error."
- (tar-mode)
- ;; Make sure everything extracts into DIR.
- (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/"))
- (case-fold-search (file-name-case-insensitive-p dir)))
- (dolist (tar-data tar-parse-info)
- (let ((name (expand-file-name (tar-header-name tar-data))))
- (or (string-match regexp name)
- ;; Tarballs created by some utilities don't list
- ;; directories with a trailing slash (Bug#13136).
- (and (string-equal (expand-file-name dir) name)
- (eq (tar-header-link-type tar-data) 5))
- (error "Package does not untar cleanly into directory %s/" dir)))))
- (tar-untar-buffer))
-
-(defun package--alist-to-plist-args (alist)
- (mapcar #'macroexp-quote
- (apply #'nconc
- (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist))))
-
-(defun package-unpack (pkg-desc)
- "Install the contents of the current buffer as a package."
- (let* ((name (package-desc-name pkg-desc))
- (dirname (package-desc-full-name pkg-desc))
- (pkg-dir (expand-file-name dirname package-user-dir)))
- (pcase (package-desc-kind pkg-desc)
- ('dir
- (make-directory pkg-dir t)
- (let ((file-list
- (directory-files
- default-directory 'full "\\`[^.].*\\.el\\'" 'nosort)))
- (dolist (source-file file-list)
- (let ((target-el-file
- (expand-file-name (file-name-nondirectory source-file) pkg-dir)))
- (copy-file source-file target-el-file t)))
- ;; Now that the files have been installed, this package is
- ;; indistinguishable from a `tar' or a `single'. Let's make
- ;; things simple by ensuring we're one of them.
- (setf (package-desc-kind pkg-desc)
- (if (length> file-list 1) 'tar 'single))))
- ('tar
- (make-directory package-user-dir t)
- (let* ((default-directory (file-name-as-directory package-user-dir)))
- (package-untar-buffer dirname)))
- ('single
- (let ((el-file (expand-file-name (format "%s.el" name) pkg-dir)))
- (make-directory pkg-dir t)
- (package--write-file-no-coding el-file)))
- (kind (error "Unknown package kind: %S" kind)))
- (package--make-autoloads-and-stuff pkg-desc pkg-dir)
- ;; Update package-alist.
- (let ((new-desc (package-load-descriptor pkg-dir)))
- (unless (equal (package-desc-full-name new-desc)
- (package-desc-full-name pkg-desc))
- (error "The retrieved package (`%s') doesn't match what the archive offered (`%s')"
- (package-desc-full-name new-desc) (package-desc-full-name pkg-desc)))
- ;; Activation has to be done before compilation, so that if we're
- ;; upgrading and macros have changed we load the new definitions
- ;; before compiling.
- (when (package-activate-1 new-desc :reload :deps)
- ;; FIXME: Compilation should be done as a separate, optional, step.
- ;; E.g. for multi-package installs, we should first install all packages
- ;; and then compile them.
- (package--compile new-desc)
- (when package-native-compile
- (package--native-compile-async new-desc))
- ;; After compilation, load again any files loaded by
- ;; `activate-1', so that we use the byte-compiled definitions.
- (package--reload-previously-loaded new-desc)))
- pkg-dir))
-
-(defun package-generate-description-file (pkg-desc pkg-file)
- "Create the foo-pkg.el file PKG-FILE for single-file package PKG-DESC."
- (let* ((name (package-desc-name pkg-desc)))
- (let ((print-level nil)
- (print-quoted t)
- (print-length nil))
- (write-region
- (concat
- ";;; Generated package description from "
- (replace-regexp-in-string "-pkg\\.el\\'" ".el"
- (file-name-nondirectory pkg-file))
- " -*- no-byte-compile: t -*-\n"
- (prin1-to-string
- (nconc
- (list 'define-package
- (symbol-name name)
- (package-version-join (package-desc-version pkg-desc))
- (package-desc-summary pkg-desc)
- (let ((requires (package-desc-reqs pkg-desc)))
- (list 'quote
- ;; Turn version lists into string form.
- (mapcar
- (lambda (elt)
- (list (car elt)
- (package-version-join (cadr elt))))
- requires))))
- (package--alist-to-plist-args
- (package-desc-extras pkg-desc))))
- "\n")
- nil pkg-file nil 'silent))))
-
-
-;;;; Autoload
-(declare-function autoload-rubric "autoload" (file &optional type feature))
-
-(defun package-autoload-ensure-default-file (file)
- "Make sure that the autoload file FILE exists and if not create it."
- (declare (obsolete nil "29.1"))
- (unless (file-exists-p file)
- (require 'autoload)
- (let ((coding-system-for-write 'utf-8-emacs-unix))
- (with-suppressed-warnings ((obsolete autoload-rubric))
- (write-region (autoload-rubric file "package" nil)
- nil file nil 'silent))))
- file)
-
-(defvar autoload-timestamps)
-(defvar version-control)
-
-(defun package-generate-autoloads (name pkg-dir)
- "Generate autoloads in PKG-DIR for package named NAME."
- (let* ((auto-name (format "%s-autoloads.el" name))
- ;;(ignore-name (concat name "-pkg.el"))
- (output-file (expand-file-name auto-name pkg-dir))
- ;; We don't need 'em, and this makes the output reproducible.
- (autoload-timestamps nil)
- (backup-inhibited t)
- (version-control 'never))
- (loaddefs-generate
- pkg-dir output-file nil
- (prin1-to-string
- '(add-to-list
- 'load-path
- ;; Add the directory that will contain the autoload file to
- ;; the load path. We don't hard-code `pkg-dir', to avoid
- ;; issues if the package directory is moved around.
- ;; `loaddefs-generate' has code to do this for us, but it's
- ;; not currently exposed. (Bug#63625)
- (or (and load-file-name
- (directory-file-name
- (file-name-directory load-file-name)))
- (car load-path)))))
- (let ((buf (find-buffer-visiting output-file)))
- (when buf (kill-buffer buf)))
- auto-name))
-
-(defun package--make-autoloads-and-stuff (pkg-desc pkg-dir)
- "Generate autoloads, description file, etc., for PKG-DESC installed at PKG-DIR."
- (package-generate-autoloads (package-desc-name pkg-desc) pkg-dir)
- (let ((desc-file (expand-file-name (package--description-file pkg-dir)
- pkg-dir)))
- (unless (file-exists-p desc-file)
- (package-generate-description-file pkg-desc desc-file)))
- ;; FIXME: Create foo.info and dir file from foo.texi?
- )
-
-;;;; Compilation
-(defvar warning-minimum-level)
-(defvar byte-compile-ignore-files)
-(defun package--compile (pkg-desc)
- "Byte-compile installed package PKG-DESC.
-This assumes that `pkg-desc' has already been activated with
-`package-activate-1'."
- (let ((byte-compile-ignore-files (package--parse-elpaignore pkg-desc))
- (warning-minimum-level :error)
- (load-path load-path))
- (byte-recompile-directory (package-desc-dir pkg-desc) 0 t)))
-
-(defun package--native-compile-async (pkg-desc)
- "Native compile installed package PKG-DESC asynchronously.
-This assumes that `pkg-desc' has already been activated with
-`package-activate-1'."
- (when (native-comp-available-p)
- (let ((warning-minimum-level :error))
- (native-compile-async (package-desc-dir pkg-desc) t))))
-
-;;;; Inferring package from current buffer
-(defun package-read-from-string (str)
- "Read a Lisp expression from STR.
-Signal an error if the entire string was not used."
- (pcase-let ((`(,expr . ,offset) (read-from-string str)))
- (condition-case ()
- ;; The call to `ignore' suppresses a compiler warning.
- (progn (ignore (read-from-string str offset))
- (error "Can't read whole string"))
- (end-of-file expr))))
-
-(declare-function lm-header "lisp-mnt" (header))
-(declare-function lm-package-requires "lisp-mnt" (&optional file))
-(declare-function lm-package-version "lisp-mnt" (&optional file))
-(declare-function lm-website "lisp-mnt" (&optional file))
-(declare-function lm-keywords-list "lisp-mnt" (&optional file))
-(declare-function lm-maintainers "lisp-mnt" (&optional file))
-(declare-function lm-authors "lisp-mnt" (&optional file))
-
-(defun package-buffer-info ()
- "Return a `package-desc' describing the package in the current buffer.
-
-If the buffer does not contain a conforming package, signal an
-error. If there is a package, narrow the buffer to the file's
-boundaries."
- (goto-char (point-min))
- (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t)
- (error "Package lacks a file header"))
- (let ((file-name (match-string-no-properties 1))
- (desc (match-string-no-properties 2)))
- (require 'lisp-mnt)
- (let* ((version-info (lm-package-version))
- (pkg-version (package-strip-rcs-id version-info))
- (keywords (lm-keywords-list))
- (website (lm-website)))
- (unless pkg-version
- (if version-info
- (error "Unrecognized package version: %s" version-info)
- (error "Package lacks a \"Version\" or \"Package-Version\" header")))
- (package-desc-from-define
- file-name pkg-version desc
- (lm-package-requires)
- :kind 'single
- :url website
- :keywords keywords
- :maintainer
- ;; For backward compatibility, use a single cons-cell if
- ;; there's only one maintainer (the most common case).
- (let ((maints (lm-maintainers))) (if (cdr maints) maints (car maints)))
- :authors (lm-authors)))))
-
-(defun package--read-pkg-desc (kind)
- "Read a `define-package' form in current buffer.
-Return the pkg-desc, with desc-kind set to KIND."
- (goto-char (point-min))
- (let* ((pkg-def-parsed (read (current-buffer)))
- (pkg-desc
- (when (eq (car pkg-def-parsed) 'define-package)
- (apply #'package-desc-from-define
- (append (cdr pkg-def-parsed))))))
- (when pkg-desc
- (setf (package-desc-kind pkg-desc) kind)
- pkg-desc)))
-
-(declare-function tar-get-file-descriptor "tar-mode" (file))
-(declare-function tar--extract "tar-mode" (descriptor))
-
-(defun package-tar-file-info ()
- "Find package information for a tar file.
-The return result is a `package-desc'."
- (cl-assert (derived-mode-p 'tar-mode))
- (let* ((dir-name (named-let loop
- ((filename (tar-header-name (car tar-parse-info))))
- (let ((dirname (file-name-directory filename)))
- ;; The first file can be in a subdir: look for the top.
- (if dirname (loop (directory-file-name dirname))
- (file-name-as-directory filename)))))
- (desc-file (package--description-file dir-name))
- (tar-desc (tar-get-file-descriptor (concat dir-name desc-file))))
- (unless tar-desc
- (error "No package descriptor file found"))
- (with-current-buffer (tar--extract tar-desc)
- (unwind-protect
- (or (package--read-pkg-desc 'tar)
- (error "Can't find define-package in %s"
- (tar-header-name tar-desc)))
- (kill-buffer (current-buffer))))))
-
-(defun package-dir-info ()
- "Find package information for a directory.
-The return result is a `package-desc'."
- (cl-assert (derived-mode-p 'dired-mode))
- (let* ((desc-file (package--description-file default-directory)))
- (if (file-readable-p desc-file)
- (with-temp-buffer
- (insert-file-contents desc-file)
- (package--read-pkg-desc 'dir))
- (let ((files (directory-files default-directory t "\\.el\\'" t))
- info)
- (while files
- (with-temp-buffer
- (let ((file (pop files)))
- ;; The file may be a link to a nonexistent file; e.g., a
- ;; lock file.
- (when (file-exists-p file)
- (insert-file-contents file)
- ;; When we find the file with the data,
- (when (setq info (ignore-errors (package-buffer-info)))
- ;; stop looping,
- (setq files nil)
- ;; set the 'dir kind,
- (setf (package-desc-kind info) 'dir))))))
- (unless info
- (error "No .el files with package headers in `%s'" default-directory))
- ;; and return the info.
- info))))
-
-\f
-;;; Communicating with Archives
-;; Set of low-level functions for communicating with archives and
-;; signature checking.
-
-(defun package--write-file-no-coding (file-name)
- "Write file FILE-NAME without encoding using coding system."
- (let ((buffer-file-coding-system 'no-conversion))
- (write-region (point-min) (point-max) file-name nil 'silent)))
-
-(declare-function url-http-file-exists-p "url-http" (url))
-
-(defun package--archive-file-exists-p (location file)
- "Return t if FILE exists in remote LOCATION."
- (let ((http (string-match "\\`https?:" location)))
- (if http
- (progn
- (require 'url-http)
- (url-http-file-exists-p (concat location file)))
- (file-exists-p (expand-file-name file location)))))
-
-(declare-function epg-make-context "epg"
- (&optional protocol armor textmode include-certs
- cipher-algorithm
- digest-algorithm
- compress-algorithm))
-(declare-function epg-verify-string "epg" ( context signature
- &optional signed-text))
-(declare-function epg-context-result-for "epg" (context name))
-(declare-function epg-signature-status "epg" (signature) t)
-(declare-function epg-signature-to-string "epg" (signature))
-
-(defun package--display-verify-error (context sig-file)
- "Show error details with CONTEXT for failed verification of SIG-FILE.
-The details are shown in a new buffer called \"*Error\"."
- (unless (equal (epg-context-error-output context) "")
- (with-output-to-temp-buffer "*Error*"
- (with-current-buffer standard-output
- (if (epg-context-result-for context 'verify)
- (insert (format "Failed to verify signature %s:\n" sig-file)
- (mapconcat #'epg-signature-to-string
- (epg-context-result-for context 'verify)
- "\n"))
- (insert (format "Error while verifying signature %s:\n" sig-file)))
- (insert "\nCommand output:\n" (epg-context-error-output context))))))
-
-(defmacro package--with-work-buffer (location file &rest body)
- "Run BODY in a buffer containing the contents of FILE at LOCATION.
-LOCATION is the base location of a package archive, and should be
-one of the URLs (or file names) specified in `package-archives'.
-FILE is the name of a file relative to that base location.
-
-This macro retrieves FILE from LOCATION into a temporary buffer,
-and evaluates BODY while that buffer is current. This work
-buffer is killed afterwards. Return the last value in BODY."
- (declare (indent 2) (debug t)
- (obsolete package--with-response-buffer "25.1"))
- `(with-temp-buffer
- (if (string-match-p "\\`https?:" ,location)
- (url-insert-file-contents (concat ,location ,file))
- (unless (file-name-absolute-p ,location)
- (error "Archive location %s is not an absolute file name"
- ,location))
- (insert-file-contents (expand-file-name ,file ,location)))
- ,@body))
-
-(cl-defmacro package--with-response-buffer (url &rest body &key async file error-form noerror &allow-other-keys)
- "Access URL and run BODY in a buffer containing the response.
-Point is after the headers when BODY runs.
-FILE, if provided, is added to URL.
-URL can be a local file name, which must be absolute.
-ASYNC, if non-nil, runs the request asynchronously.
-ERROR-FORM is run only if a connection error occurs. If NOERROR
-is non-nil, don't propagate connection errors (does not apply to
-errors signaled by ERROR-FORM or by BODY).
-
-\(fn URL &key ASYNC FILE ERROR-FORM NOERROR &rest BODY)"
- (declare (indent defun) (debug (sexp body)))
- (while (keywordp (car body))
- (setq body (cdr (cdr body))))
- `(package--with-response-buffer-1 ,url (lambda () ,@body)
- :file ,file
- :async ,async
- :error-function (lambda () ,error-form)
- :noerror ,noerror))
-
-(defmacro package--unless-error (body &rest before-body)
- (declare (debug t) (indent 1))
- (let ((err (make-symbol "err")))
- `(with-temp-buffer
- (set-buffer-multibyte nil)
- (when (condition-case ,err
- (progn ,@before-body t)
- (error (funcall error-function)
- (unless noerror
- (signal (car ,err) (cdr ,err)))))
- (funcall ,body)))))
-
-(cl-defun package--with-response-buffer-1 (url body &key async file error-function noerror &allow-other-keys)
- (if (string-match-p "\\`https?:" url)
- (let ((url (url-expand-file-name file url)))
- (if async
- (package--unless-error #'ignore
- (url-retrieve
- url
- (lambda (status)
- (let ((b (current-buffer)))
- (require 'url-handlers)
- (package--unless-error body
- (when-let* ((er (plist-get status :error)))
- (error "Error retrieving: %s %S" url er))
- (with-current-buffer b
- (goto-char (point-min))
- (unless (search-forward-regexp "^\r?\n\r?" nil t)
- (error "Error retrieving: %s %S"
- url "incomprehensible buffer")))
- (url-insert b)
- (kill-buffer b)
- (goto-char (point-min)))))
- nil
- 'silent))
- (package--unless-error body
- ;; Copy&pasted from url-insert-file-contents,
- ;; except it calls `url-insert' because we want the contents
- ;; literally (but there's no url-insert-file-contents-literally).
- (let ((buffer (url-retrieve-synchronously url)))
- (unless buffer (signal 'file-error (list url "No Data")))
- (when (fboundp 'url-http--insert-file-helper)
- ;; XXX: This is HTTP/S specific and should be moved
- ;; to url-http instead. See bug#17549.
- (url-http--insert-file-helper buffer url))
- (url-insert buffer)
- (kill-buffer buffer)
- (goto-char (point-min))))))
- (package--unless-error body
- (unless (file-name-absolute-p url)
- (error "Location %s is not a url nor an absolute file name" url))
- (insert-file-contents-literally (expand-file-name file url)))))
-
-(define-error 'bad-signature "Failed to verify signature")
-
-(defun package--check-signature-content (content string &optional sig-file)
- "Check signature CONTENT against STRING.
-SIG-FILE is the name of the signature file, used when signaling
-errors."
- (let ((context (epg-make-context 'OpenPGP)))
- (when package-gnupghome-dir
- (setf (epg-context-home-directory context) package-gnupghome-dir))
- (condition-case error
- (epg-verify-string context content string)
- (error (package--display-verify-error context sig-file)
- (signal 'bad-signature error)))
- (let (good-signatures had-fatal-error)
- ;; The .sig file may contain multiple signatures. Success if one
- ;; of the signatures is good.
- (dolist (sig (epg-context-result-for context 'verify))
- (if (eq (epg-signature-status sig) 'good)
- (push sig good-signatures)
- ;; If `package-check-signature' is allow-unsigned, don't
- ;; signal error when we can't verify signature because of
- ;; missing public key. Other errors are still treated as
- ;; fatal (bug#17625).
- (unless (and (eq (package-check-signature) 'allow-unsigned)
- (eq (epg-signature-status sig) 'no-pubkey))
- (setq had-fatal-error t))))
- (when (or (null good-signatures)
- (and (eq (package-check-signature) 'all)
- had-fatal-error))
- (package--display-verify-error context sig-file)
- (signal 'bad-signature (list sig-file)))
- good-signatures)))
-
-(defun package--check-signature (location file &optional string async callback unwind)
- "Check signature of the current buffer.
-Download the signature file from LOCATION by appending \".sig\"
-to FILE.
-GnuPG keyring location depends on `package-gnupghome-dir'.
-STRING is the string to verify, it defaults to `buffer-string'.
-If ASYNC is non-nil, the download of the signature file is
-done asynchronously.
-
-If the signature does not verify, signal an error.
-If the signature is verified and CALLBACK was provided, `funcall'
-CALLBACK with the list of good signatures as argument (the list
-can be empty).
-If no signatures file is found, and `package-check-signature' is
-`allow-unsigned', call CALLBACK with a nil argument.
-Otherwise, an error is signaled.
-
-UNWIND, if provided, is a function to be called after everything
-else, even if an error is signaled."
- (let ((sig-file (concat file ".sig"))
- (string (or string (buffer-string))))
- (package--with-response-buffer location :file sig-file
- :async async :noerror t
- ;; Connection error is assumed to mean "no sig-file".
- :error-form (let ((allow-unsigned
- (eq (package-check-signature) 'allow-unsigned)))
- (when (and callback allow-unsigned)
- (funcall callback nil))
- (when unwind (funcall unwind))
- (unless allow-unsigned
- (error "Unsigned file `%s' at %s" file location)))
- ;; OTOH, an error here means "bad signature", which we never
- ;; suppress. (Bug#22089)
- (unwind-protect
- (let ((sig (package--check-signature-content
- (buffer-substring (point) (point-max))
- string sig-file)))
- (when callback (funcall callback sig))
- sig)
- (when unwind (funcall unwind))))))
-\f
-;;; Packages on Archives
-;; The following variables store information about packages available
-;; from archives. The most important of these is
-;; `package-archive-contents' which is initially populated by the
-;; function `package-read-all-archive-contents' from a cache on disk.
-;; The `package-initialize' command is also closely related to this
-;; section, but it has its own section.
-
-(defconst package-archive-version 1
- "Version number of the package archive understood by package.el.
-Lower version numbers than this will probably be understood as well.")
-
-;; We don't prime the cache since it tends to get out of date.
-(defvar package-archive-contents nil
- "Cache of the contents of all archives in `package-archives'.
-This is an alist mapping package names (symbols) to
-non-empty lists of `package-desc' structures.")
-(put 'package-archive-contents 'risky-local-variable t)
-
-(defvar package--compatibility-table nil
- "Hash table connecting package names to their compatibility.
-Each key is a symbol, the name of a package.
-
-The value is either nil, representing an incompatible package, or
-a version list, representing the highest compatible version of
-that package which is available.
-
-A package is considered incompatible if it requires an Emacs
-version higher than the one being used. To check for package
-\(in)compatibility, don't read this table directly, use
-`package--incompatible-p' which also checks dependencies.")
-
-(defun package--build-compatibility-table ()
- "Build `package--compatibility-table' with `package--mapc'."
- ;; Initialize the list of built-ins.
- (require 'finder-inf nil t)
- ;; Build compat table.
- (setq package--compatibility-table (make-hash-table :test 'eq))
- (package--mapc #'package--add-to-compatibility-table))
-
-(defun package--add-to-compatibility-table (pkg)
- "If PKG is compatible (without dependencies), add to the compatibility table.
-PKG is a package-desc object.
-Only adds if its version is higher than what's already stored in
-the table."
- (unless (package--incompatible-p pkg 'shallow)
- (let* ((name (package-desc-name pkg))
- (version (or (package-desc-version pkg) '(0)))
- (table-version (gethash name package--compatibility-table)))
- (when (or (not table-version)
- (version-list-< table-version version))
- (puthash name version package--compatibility-table)))))
-
-;; Package descriptor objects used inside the "archive-contents" file.
-;; Changing this defstruct implies changing the format of the
-;; "archive-contents" files.
-(cl-defstruct (package--ac-desc
- (:constructor package-make-ac-desc (version reqs summary kind extras))
- (:copier nil)
- (:type vector))
- version reqs summary kind extras)
-
-(defun package--append-to-alist (pkg-desc alist)
- "Append an entry for PKG-DESC to the start of ALIST and return it.
-This entry takes the form (`package-desc-name' PKG-DESC).
-
-If ALIST already has an entry with this name, destructively add
-PKG-DESC to the cdr of this entry instead, sorted by version
-number."
- (let* ((name (package-desc-name pkg-desc))
- (priority-version (package-desc-priority-version pkg-desc))
- (existing-packages (assq name alist)))
- (if (not existing-packages)
- (cons (list name pkg-desc)
- alist)
- (while (if (and (cdr existing-packages)
- (version-list-< priority-version
- (package-desc-priority-version
- (cadr existing-packages))))
- (setq existing-packages (cdr existing-packages))
- (push pkg-desc (cdr existing-packages))
- nil))
- alist)))
-
-(defun package--add-to-archive-contents (package archive)
- "Add the PACKAGE from the given ARCHIVE if necessary.
-PACKAGE should have the form (NAME . PACKAGE--AC-DESC).
-Also, add the originating archive to the `package-desc' structure."
- (let* ((name (car package))
- (version (package--ac-desc-version (cdr package)))
- (pkg-desc
- (package-desc-create
- :name name
- :version version
- :reqs (package--ac-desc-reqs (cdr package))
- :summary (package--ac-desc-summary (cdr package))
- :kind (package--ac-desc-kind (cdr package))
- :archive archive
- :extras (and (> (length (cdr package)) 4)
- ;; Older archive-contents files have only 4
- ;; elements here.
- (package--ac-desc-extras (cdr package)))))
- (pinned-to-archive (assoc name package-pinned-packages)))
- ;; Skip entirely if pinned to another archive.
- (when (not (and pinned-to-archive
- (not (equal (cdr pinned-to-archive) archive))))
- (setq package-archive-contents
- (package--append-to-alist pkg-desc package-archive-contents)))))
-
-(defun package--read-archive-file (file)
- "Read cached archive FILE data, if it exists.
-Return the data from the file, or nil if the file does not exist.
-If the archive version is too new, signal an error."
- (let ((filename (expand-file-name file package-user-dir)))
- (when (file-exists-p filename)
- (with-temp-buffer
- (let ((coding-system-for-read 'utf-8))
- (insert-file-contents filename))
- (let ((contents (read (current-buffer))))
- (if (> (car contents) package-archive-version)
- (error "Package archive version %d is higher than %d"
- (car contents) package-archive-version))
- (cdr contents))))))
-
-(defun package-read-archive-contents (archive)
- "Read cached archive file for ARCHIVE.
-If successful, set or update the variable `package-archive-contents'.
-ARCHIVE should be a string matching the name of a package archive
-in the variable `package-archives'.
-If the archive version is too new, signal an error."
- ;; Version 1 of 'archive-contents' is identical to our internal
- ;; representation.
- (let* ((contents-file (format "archives/%s/archive-contents" archive))
- (contents (package--read-archive-file contents-file)))
- (when contents
- (dolist (package contents)
- (if package
- (package--add-to-archive-contents package archive)
- (lwarn '(package refresh) :warning
- "Ignoring nil package on `%s' package archive" archive))))))
-
-(defvar package--old-archive-priorities nil
- "Store currently used `package-archive-priorities'.
-This is the value of `package-archive-priorities' last time
-`package-read-all-archive-contents' was called. It can be used
-by arbitrary functions to decide whether it is necessary to call
-it again.")
-
-(defvar package-read-archive-hook (list #'package-read-archive-contents)
- "List of functions to call to read the archive contents.
-Each function must take an optional argument, a symbol indicating
-what archive to read in. The symbol ought to be a key in
-`package-archives'.")
-
-(defun package-read-all-archive-contents ()
- "Read cached archive file for all archives in `package-archives'.
-If successful, set or update `package-archive-contents'."
- (setq package-archive-contents nil)
- (setq package--old-archive-priorities package-archive-priorities)
- (dolist (archive package-archives)
- (run-hook-with-args 'package-read-archive-hook (car archive))))
-
-\f
-;;;; Package Initialize
-;; A bit of a milestone. This brings together some of the above
-;; sections and populates all relevant lists of packages from contents
-;; available on disk.
-
-(defvar package--initialized nil
- "Non-nil if `package-initialize' has been run.")
-
-;;;###autoload
-(defvar package--activated nil
- "Non-nil if `package-activate-all' has been run.")
-
-;;;###autoload
-(defun package-initialize (&optional no-activate)
- "Load Emacs Lisp packages, and activate them.
-The variable `package-load-list' controls which packages to load.
-If optional arg NO-ACTIVATE is non-nil, don't activate packages.
-
-It is not necessary to adjust `load-path' or `require' the
-individual packages after calling `package-initialize' -- this is
-taken care of by `package-initialize'.
-
-If `package-initialize' is called twice during Emacs startup,
-signal a warning, since this is a bad idea except in highly
-advanced use cases. To suppress the warning, remove the
-superfluous call to `package-initialize' from your init-file. If
-you have code which must run before `package-initialize', put
-that code in the early init-file."
- (interactive)
- (when (and package--initialized (not after-init-time))
- (lwarn '(package reinitialization) :warning
- "Unnecessary call to `package-initialize' in init file"))
- (setq package-alist nil)
- (package-load-all-descriptors)
- (package-read-all-archive-contents)
- (setq package--initialized t)
- (unless no-activate
- (package-activate-all))
- ;; This uses `package--mapc' so it must be called after
- ;; `package--initialized' is t.
- (package--build-compatibility-table))
-
-;;;###autoload
-(progn ;; Make the function usable without loading `package.el'.
-(defun package-activate-all ()
- "Activate all installed packages.
-The variable `package-load-list' controls which packages to load."
- (setq package--activated t)
- (let* ((elc (concat package-quickstart-file "c"))
- (qs (if (file-readable-p elc) elc
- (if (file-readable-p package-quickstart-file)
- package-quickstart-file))))
- ;; The quickstart file presumes that it has a blank slate,
- ;; so don't use it if we already activated some packages.
- (or (and qs (not (bound-and-true-p package-activated-list))
- ;; Skip `load-source-file-function' which would slow us down by
- ;; a factor 2 when loading the .el file (this assumes we were
- ;; careful to save this file so it doesn't need any decoding).
- (with-demoted-errors "Error during quickstart: %S"
- (let ((load-source-file-function nil))
- (unless (boundp 'package-activated-list)
- (setq package-activated-list nil))
- (load qs nil 'nomessage)
- t)))
- (progn
- (require 'package)
- ;; Silence the "unknown function" warning when this is compiled
- ;; inside `loaddefs.el'.
- ;; FIXME: We use `with-no-warnings' because the effect of
- ;; `declare-function' is currently not scoped, so if we use
- ;; it here, we end up with a redefinition warning instead :-)
- (with-no-warnings
- (package--activate-all)))))))
-
-(defun package--activate-all ()
- (dolist (elt (package--alist))
- (condition-case err
- (package-activate (car elt))
- ;; Don't let failure of activation of a package arbitrarily stop
- ;; activation of further packages.
- (error (message "%s" (error-message-string err))))))
-\f
-;;;; Populating `package-archive-contents' from archives
-;; This subsection populates the variables listed above from the
-;; actual archives, instead of from a local cache.
-
-(defvar package--downloads-in-progress nil
- "List of in-progress asynchronous downloads.")
-
-(declare-function epg-import-keys-from-file "epg" (context keys))
-
-;;;###autoload
-(defun package-import-keyring (&optional file)
- "Import keys from FILE."
- (interactive "fFile: ")
- (setq file (expand-file-name file))
- (let ((context (epg-make-context 'OpenPGP)))
- (when package-gnupghome-dir
- (with-file-modes #o700
- (make-directory package-gnupghome-dir t))
- (setf (epg-context-home-directory context) package-gnupghome-dir))
- (message "Importing %s..." (file-name-nondirectory file))
- (epg-import-keys-from-file context file)
- (message "Importing %s...done" (file-name-nondirectory file))))
-
-(defvar package--post-download-archives-hook nil
- "Hook run after the archive contents are downloaded.
-Don't run this hook directly. It is meant to be run as part of
-`package--update-downloads-in-progress'.")
-(put 'package--post-download-archives-hook 'risky-local-variable t)
-
-(defun package--update-downloads-in-progress (entry)
- "Remove ENTRY from `package--downloads-in-progress'.
-Once it's empty, run `package--post-download-archives-hook'."
- ;; Keep track of the downloading progress.
- (setq package--downloads-in-progress
- (remove entry package--downloads-in-progress))
- ;; If this was the last download, run the hook.
- (unless package--downloads-in-progress
- (package-read-all-archive-contents)
- (package--build-compatibility-table)
- ;; We message before running the hook, so the hook can give
- ;; messages as well.
- (message "Package refresh done")
- (run-hooks 'package--post-download-archives-hook)))
-
-(defun package--download-one-archive (archive file &optional async)
- "Retrieve an archive file FILE from ARCHIVE, and cache it.
-ARCHIVE should be a cons cell of the form (NAME . LOCATION),
-similar to an entry in `package-alist'. Save the cached copy to
-\"archives/NAME/FILE\" in `package-user-dir'."
- ;; The downloaded archive contents will be read as part of
- ;; `package--update-downloads-in-progress'.
- (when async
- (cl-pushnew (cons archive file) package--downloads-in-progress
- :test #'equal))
- (package--with-response-buffer (cdr archive) :file file
- :async async
- :error-form (package--update-downloads-in-progress (cons archive file))
- (let* ((location (cdr archive))
- (name (car archive))
- (content (buffer-string))
- (dir (expand-file-name (concat "archives/" name) package-user-dir))
- (local-file (expand-file-name file dir)))
- (when (listp (read content))
- (make-directory dir t)
- (if (or (not (package-check-signature))
- (member name package-unsigned-archives))
- ;; If we don't care about the signature, save the file and
- ;; we're done.
- (progn
- (cl-assert (not enable-multibyte-characters))
- (let ((coding-system-for-write 'binary))
- (write-region content nil local-file nil 'silent))
- (package--update-downloads-in-progress (cons archive file)))
- ;; If we care, check it (perhaps async) and *then* write the file.
- (package--check-signature
- location file content async
- ;; This function will be called after signature checking.
- (lambda (&optional good-sigs)
- (cl-assert (not enable-multibyte-characters))
- (let ((coding-system-for-write 'binary))
- (write-region content nil local-file nil 'silent))
- ;; Write out good signatures into archive-contents.signed file.
- (when good-sigs
- (write-region (mapconcat #'epg-signature-to-string good-sigs "\n")
- nil (concat local-file ".signed") nil 'silent)))
- (lambda () (package--update-downloads-in-progress (cons archive file)))))))))
-
-(defun package--download-and-read-archives (&optional async)
- "Download descriptions of all `package-archives' and read them.
-Populate `package-archive-contents' with the result.
-
-If optional argument ASYNC is non-nil, perform the downloads
-asynchronously."
- (dolist (archive package-archives)
- (condition-case-unless-debug err
- (package--download-one-archive archive "archive-contents" async)
- (error (message "Failed to download `%s' archive: %s"
- (car archive)
- (error-message-string err))))))
-
-(defvar package-refresh-contents-hook (list #'package--download-and-read-archives)
- "List of functions to call to refresh the package archive.
-Each function may take an optional argument indicating that the
-operation ought to be executed asynchronously.")
-
-;;;###autoload
-(defun package-refresh-contents (&optional async)
- "Download descriptions of all configured ELPA packages.
-For each archive configured in the variable `package-archives',
-inform Emacs about the latest versions of all packages it offers,
-and make them available for download.
-Optional argument ASYNC specifies whether to perform the
-downloads in the background. This is always the case when the command
-is invoked interactively."
- (interactive (list t))
- (when async
- (message "Refreshing package contents..."))
- (unless (file-exists-p package-user-dir)
- (make-directory package-user-dir t))
- (let ((default-keyring (expand-file-name "package-keyring.gpg"
- data-directory))
- (inhibit-message (or inhibit-message async)))
- (when (and (package-check-signature) (file-exists-p default-keyring))
- (condition-case-unless-debug error
- (package-import-keyring default-keyring)
- (error (message "Cannot import default keyring: %s"
- (error-message-string error))))))
- (run-hook-with-args 'package-refresh-contents-hook async))
-
-\f
-;;; Dependency Management
-;; Calculating the full transaction necessary for an installation,
-;; keeping track of which packages were installed strictly as
-;; dependencies, and determining which packages cannot be removed
-;; because they are dependencies.
-
-(defun package-compute-transaction (packages requirements &optional seen)
- "Return a list of packages to be installed, including PACKAGES.
-PACKAGES should be a list of `package-desc'.
-
-REQUIREMENTS should be a list of additional requirements; each
-element in this list should have the form (PACKAGE VERSION-LIST),
-where PACKAGE is a package name and VERSION-LIST is the required
-version of that package.
-
-This function recursively computes the requirements of the
-packages in REQUIREMENTS, and returns a list of all the packages
-that must be installed. Packages that are already installed are
-not included in this list.
-
-SEEN is used internally to detect infinite recursion."
- ;; FIXME: We really should use backtracking to explore the whole
- ;; search space (e.g. if foo require bar-1.3, and bar-1.4 requires toto-1.1
- ;; whereas bar-1.3 requires toto-1.0 and the user has put a hold on toto-1.0:
- ;; the current code might fail to see that it could install foo by using the
- ;; older bar-1.3).
- (dolist (elt requirements)
- (let* ((next-pkg (car elt))
- (next-version (cadr elt))
- (already ()))
- (dolist (pkg packages)
- (if (eq next-pkg (package-desc-name pkg))
- (setq already pkg)))
- (when already
- (if (version-list-<= next-version (package-desc-version already))
- ;; `next-pkg' is already in `packages', but its position there
- ;; means it might be installed too late: remove it from there, so
- ;; we re-add it (along with its dependencies) at an earlier place
- ;; below (bug#16994).
- (if (memq already seen) ;Avoid inf-loop on dependency cycles.
- (message "Dependency cycle going through %S"
- (package-desc-full-name already))
- (setq packages (delq already packages))
- (setq already nil))
- (error "Need package `%s-%s', but only %s is being installed"
- next-pkg (package-version-join next-version)
- (package-version-join (package-desc-version already)))))
- (cond
- (already nil)
- ((package-installed-p next-pkg next-version) nil)
-
- (t
- ;; A package is required, but not installed. It might also be
- ;; blocked via `package-load-list'.
- (let ((pkg-descs (cdr (assq next-pkg package-archive-contents)))
- (found nil)
- (found-something nil)
- (problem nil))
- (while (and pkg-descs (not found))
- (let* ((pkg-desc (pop pkg-descs))
- (version (package-desc-version pkg-desc))
- (disabled (package-disabled-p next-pkg version)))
- (cond
- ((version-list-< version next-version)
- ;; pkg-descs is sorted by priority, not version, so
- ;; don't error just yet.
- (unless found-something
- (setq found-something (package-version-join version))))
- (disabled
- (unless problem
- (setq problem
- (if (stringp disabled)
- (format-message
- "Package `%s' held at version %s, but version %s required"
- next-pkg disabled
- (package-version-join next-version))
- (format-message "Required package `%s' is disabled"
- next-pkg)))))
- (t (setq found pkg-desc)))))
- (unless found
- (cond
- (problem (error "%s" problem))
- (found-something
- (error "Need package `%s-%s', but only %s is available"
- next-pkg (package-version-join next-version)
- found-something))
- (t
- (if (eq next-pkg 'emacs)
- (error "This package requires Emacs version %s"
- (package-version-join next-version))
- (error (if (not next-version)
- (format "Package `%s' is unavailable" next-pkg)
- (format "Package `%s' (version %s) is unavailable"
- next-pkg (package-version-join next-version))))))))
- (setq packages
- (package-compute-transaction (cons found packages)
- (package-desc-reqs found)
- (cons found seen))))))))
- packages)
-
-(defun package--find-non-dependencies ()
- "Return a list of installed packages which are not dependencies.
-Finds all packages in `package-alist' which are not dependencies
-of any other packages.
-Used to populate `package-selected-packages'."
- (let ((dep-list
- (delete-dups
- (apply #'append
- (mapcar (lambda (p) (mapcar #'car (package-desc-reqs (cadr p))))
- package-alist)))))
- (cl-loop for p in package-alist
- for name = (car p)
- unless (memq name dep-list)
- collect name)))
-
-(defun package--save-selected-packages (&optional value)
- "Set and save `package-selected-packages' to VALUE."
- (when (or value after-init-time)
- ;; It is valid to set it to nil, for example when the last package
- ;; is uninstalled. But it shouldn't be done at init time, to
- ;; avoid overwriting configurations that haven't yet been loaded.
- (setq package-selected-packages (sort value #'string<)))
- (if after-init-time
- (customize-save-variable 'package-selected-packages package-selected-packages)
- (add-hook 'after-init-hook #'package--save-selected-packages)))
-
-(defun package--user-selected-p (pkg)
- "Return non-nil if PKG is a package was installed by the user.
-PKG is a package name.
-This looks into `package-selected-packages', populating it first
-if it is still empty."
- (unless (consp package-selected-packages)
- (package--save-selected-packages (package--find-non-dependencies)))
- (memq pkg package-selected-packages))
-
-(defun package--get-deps (pkgs)
- (let ((seen '()))
- (while pkgs
- (let ((pkg (pop pkgs)))
- (if (memq pkg seen)
- nil ;; Done already!
- (let ((pkg-desc (cadr (assq pkg package-alist))))
- (when pkg-desc
- (push pkg seen)
- (setq pkgs (append (mapcar #'car (package-desc-reqs pkg-desc))
- pkgs)))))))
- seen))
-
-(defun package--user-installed-p (package)
- "Return non-nil if PACKAGE is a user-installed package.
-PACKAGE is the package name, a symbol. Check whether the package
-was installed into `package-user-dir' where we assume to have
-control over."
- (let* ((pkg-desc (cadr (assq package package-alist)))
- (dir (package-desc-dir pkg-desc)))
- (file-in-directory-p dir package-user-dir)))
-
-(defun package--removable-packages ()
- "Return a list of names of packages no longer needed.
-These are packages which are neither contained in
-`package-selected-packages' nor a dependency of one that is."
- (let ((needed (package--get-deps package-selected-packages)))
- (cl-loop for p in (mapcar #'car package-alist)
- unless (or (memq p needed)
- ;; Do not auto-remove external packages.
- (not (package--user-installed-p p)))
- collect p)))
-
-(defun package--used-elsewhere-p (pkg-desc &optional pkg-list all)
- "Non-nil if PKG-DESC is a dependency of a package in PKG-LIST.
-Return the first package found in PKG-LIST of which PKG is a
-dependency. If ALL is non-nil, return all such packages instead.
-
-When not specified, PKG-LIST defaults to `package-alist'
-with PKG-DESC entry removed."
- (unless (string= (package-desc-status pkg-desc) "obsolete")
- (let* ((pkg (package-desc-name pkg-desc))
- (alist (or pkg-list
- (remove (assq pkg package-alist)
- package-alist))))
- (if all
- (cl-loop for p in alist
- if (assq pkg (package-desc-reqs (cadr p)))
- collect (cadr p))
- (cl-loop for p in alist thereis
- (and (assq pkg (package-desc-reqs (cadr p)))
- (cadr p)))))))
-
-(defun package--sort-deps-in-alist (package only)
- "Return a list of dependencies for PACKAGE sorted by dependency.
-PACKAGE is included as the first element of the returned list.
-ONLY is an alist associating package names to package objects.
-Only these packages will be in the return value and their cdrs are
-destructively set to nil in ONLY."
- (let ((out))
- (dolist (dep (package-desc-reqs package))
- (when-let* ((cell (assq (car dep) only))
- (dep-package (cdr-safe cell)))
- (setcdr cell nil)
- (setq out (append (package--sort-deps-in-alist dep-package only)
- out))))
- (cons package out)))
-
-(defun package--sort-by-dependence (package-list)
- "Return PACKAGE-LIST sorted by dependence.
-That is, any element of the returned list is guaranteed to not
-directly depend on any elements that come before it.
-
-PACKAGE-LIST is a list of `package-desc' objects.
-Indirect dependencies are guaranteed to be returned in order only
-if all the in-between dependencies are also in PACKAGE-LIST."
- (let ((alist (mapcar (lambda (p) (cons (package-desc-name p) p)) package-list))
- out-list)
- (dolist (cell alist out-list)
- ;; `package--sort-deps-in-alist' destructively changes alist, so
- ;; some cells might already be empty. We check this here.
- (when-let* ((pkg-desc (cdr cell)))
- (setcdr cell nil)
- (setq out-list
- (append (package--sort-deps-in-alist pkg-desc alist)
- out-list))))))
-
-\f
-;;; Installation Functions
-;; As opposed to the previous section (which listed some underlying
-;; functions necessary for installation), this one contains the actual
-;; functions that install packages. The package itself can be
-;; installed in a variety of ways (archives, buffer, file), but
-;; requirements (dependencies) are always satisfied by looking in
-;; `package-archive-contents'.
-
-(defun package-archive-base (desc)
- "Return the package described by DESC."
- (cdr (assoc (package-desc-archive desc) package-archives)))
-
-(defun package-install-from-archive (pkg-desc)
- "Download and install a package defined by PKG-DESC."
- ;; This won't happen, unless the archive is doing something wrong.
- (when (eq (package-desc-kind pkg-desc) 'dir)
- (error "Can't install directory package from archive"))
- (let* ((location (package-archive-base pkg-desc))
- (file (concat (package-desc-full-name pkg-desc)
- (package-desc-suffix pkg-desc))))
- (package--with-response-buffer location :file file
- (if (or (not (package-check-signature))
- (member (package-desc-archive pkg-desc)
- package-unsigned-archives))
- ;; If we don't care about the signature, unpack and we're
- ;; done.
- (let ((save-silently t))
- (package-unpack pkg-desc))
- ;; If we care, check it and *then* write the file.
- (let ((content (buffer-string)))
- (package--check-signature
- location file content nil
- ;; This function will be called after signature checking.
- (lambda (&optional good-sigs)
- ;; Signature checked, unpack now.
- (with-temp-buffer ;FIXME: Just use the previous current-buffer.
- (set-buffer-multibyte nil)
- (cl-assert (not (multibyte-string-p content)))
- (insert content)
- (let ((save-silently t))
- (package-unpack pkg-desc)))
- ;; Here the package has been installed successfully, mark it as
- ;; signed if appropriate.
- (when good-sigs
- ;; Write out good signatures into NAME-VERSION.signed file.
- (write-region (mapconcat #'epg-signature-to-string good-sigs "\n")
- nil
- (expand-file-name
- (concat (package-desc-full-name pkg-desc) ".signed")
- package-user-dir)
- nil 'silent)
- ;; Update the old pkg-desc which will be shown on the description buffer.
- (setf (package-desc-signed pkg-desc) t)
- ;; Update the new (activated) pkg-desc as well.
- (when-let* ((pkg-descs (cdr (assq (package-desc-name pkg-desc)
- package-alist))))
- (setf (package-desc-signed (car pkg-descs)) t))))))))))
-
-;;;###autoload
-(defun package-installed-p (package &optional min-version)
- "Return non-nil if PACKAGE, of MIN-VERSION or newer, is installed.
-If PACKAGE is a symbol, it is the package name and MIN-VERSION
-should be a version list.
-
-If PACKAGE is a `package-desc' object, MIN-VERSION is ignored."
- (cond
- ((package-desc-p package)
- (let ((dir (package-desc-dir package)))
- (and (stringp dir)
- (file-exists-p dir))))
- ((and (not package--initialized)
- (null min-version)
- package-activated-list)
- ;; We used the quickstart: make it possible to use package-installed-p
- ;; even before package is fully initialized.
- (or
- (memq package package-activated-list)
- ;; Also check built-in packages.
- (package-built-in-p package min-version)))
- (t
- (or
- (let ((pkg-descs (cdr (assq package (package--alist)))))
- (and pkg-descs
- (version-list-<= min-version
- (package-desc-version (car pkg-descs)))))
- ;; Also check built-in packages.
- (package-built-in-p package min-version)))))
-
-(defun package-download-transaction (packages)
- "Download and install all the packages in PACKAGES.
-PACKAGES should be a list of `package-desc'.
-This function assumes that all package requirements in
-PACKAGES are satisfied, i.e. that PACKAGES is computed
-using `package-compute-transaction'."
- (mapc #'package-install-from-archive packages))
-
-(defun package--archives-initialize ()
- "Make sure the list of installed and remote packages are initialized."
- (unless package--initialized
- (package-initialize t))
- (unless package-archive-contents
- (package-refresh-contents)))
-
-(defcustom package-install-upgrade-built-in nil
- "Non-nil means that built-in packages can be upgraded via a package archive.
-If disabled, then `package-install' will not suggest to replace a
-built-in package with a (possibly newer) version from a package archive."
- :type 'boolean
- :version "29.1")
-
-;;;###autoload
-(defun package-install (pkg &optional dont-select)
- "Install the package PKG.
-PKG can be a `package-desc' or a symbol naming one of the
-available packages in an archive in `package-archives'.
-
-Mark the installed package as selected by adding it to
-`package-selected-packages'.
-
-When called from Lisp and optional argument DONT-SELECT is
-non-nil, install the package but do not add it to
-`package-selected-packages'.
-
-If PKG is a `package-desc' and it is already installed, don't try
-to install it but still mark it as selected.
-
-If the command is invoked with a prefix argument, it will allow
-upgrading of built-in packages, as if `package-install-upgrade-built-in'
-had been enabled."
- (interactive
- (progn
- ;; Initialize the package system to get the list of package
- ;; symbols for completion.
- (package--archives-initialize)
- (list (intern (completing-read
- "Install package: "
- (mapcan
- (lambda (elt)
- (and (or (and (or current-prefix-arg
- package-install-upgrade-built-in)
- (package--active-built-in-p (car elt)))
- (not (package-installed-p (car elt))))
- (list (symbol-name (car elt)))))
- package-archive-contents)
- nil t))
- nil)))
- (package--archives-initialize)
- (add-hook 'post-command-hook #'package-menu--post-refresh)
- (let ((name (if (package-desc-p pkg)
- (package-desc-name pkg)
- pkg)))
- (unless (or dont-select (package--user-selected-p name))
- (package--save-selected-packages
- (cons name package-selected-packages)))
- (when (and (or current-prefix-arg package-install-upgrade-built-in)
- (package--active-built-in-p pkg))
- (setq pkg (or (cadr (assq name package-archive-contents)) pkg)))
- (if-let* ((transaction
- (if (package-desc-p pkg)
- (unless (package-installed-p pkg)
- (package-compute-transaction (list pkg)
- (package-desc-reqs pkg)))
- (package-compute-transaction () (list (list pkg))))))
- (progn
- (package-download-transaction transaction)
- (package--quickstart-maybe-refresh)
- (message "Package `%s' installed." name))
- (message "`%s' is already installed" name))))
-
-(declare-function package-vc-upgrade "package-vc" (pkg))
-
-;;;###autoload
-(defun package-upgrade (name)
- "Upgrade package NAME if a newer version exists."
- (interactive
- (list (completing-read
- "Upgrade package: " (package--upgradeable-packages t) nil t)))
- (let* ((package (if (symbolp name)
- name
- (intern name)))
- (pkg-desc (cadr (assq package package-alist)))
- (package-install-upgrade-built-in (not pkg-desc)))
- ;; `pkg-desc' will be nil when the package is an "active built-in".
- (if (and pkg-desc (package-vc-p pkg-desc))
- (package-vc-upgrade pkg-desc)
- (when pkg-desc
- (package-delete pkg-desc 'force 'dont-unselect))
- (package-install package
- ;; An active built-in has never been "selected"
- ;; before. Mark it as installed explicitly.
- (and pkg-desc 'dont-select)))))
-
-(defun package--upgradeable-packages (&optional include-builtins)
- ;; Initialize the package system to get the list of package
- ;; symbols for completion.
- (package--archives-initialize)
- (mapcar
- #'car
- (seq-filter
- (lambda (elt)
- (or (let ((available
- (assq (car elt) package-archive-contents)))
- (and available
- (or (and
- include-builtins
- (not (package-desc-version (cadr elt))))
- (version-list-<
- (package-desc-version (cadr elt))
- (package-desc-version (cadr available))))))
- (package-vc-p (cadr elt))))
- (if include-builtins
- (append package-alist
- (mapcan
- (lambda (elt)
- (when (not (assq (car elt) package-alist))
- (list (list (car elt) (package--from-builtin elt)))))
- package--builtins))
- package-alist))))
-
-;;;###autoload
-(defun package-upgrade-all (&optional query)
- "Refresh package list and upgrade all packages.
-If QUERY, ask the user before upgrading packages. When called
-interactively, QUERY is always true.
-
-Currently, packages which are part of the Emacs distribution are
-not upgraded by this command. To enable upgrading such a package
-using this command, first upgrade the package to a newer version
-from ELPA by either using `\\[package-upgrade]' or
-`\\<package-menu-mode-map>\\[package-menu-mark-install]' after `\\[list-packages]'."
- (interactive (list (not noninteractive)))
- (package-refresh-contents)
- (let ((upgradeable (package--upgradeable-packages)))
- (if (not upgradeable)
- (message "No packages to upgrade")
- (when (and query
- (not (yes-or-no-p
- (if (length= upgradeable 1)
- "One package to upgrade. Do it? "
- (format "%s packages to upgrade. Do it?"
- (length upgradeable))))))
- (user-error "Upgrade aborted"))
- (mapc #'package-upgrade upgradeable))))
-
-(defun package--dependencies (pkg)
- "Return a list of all transitive dependencies of PKG.
-If PKG is a package descriptor, the return value is a list of
-package descriptors. If PKG is a symbol designating a package,
-the return value is a list of symbols designating packages."
- (when-let* ((desc (if (package-desc-p pkg) pkg
- (cadr (assq pkg package-archive-contents)))))
- ;; Can we have circular dependencies? Assume "nope".
- (let ((all (named-let more ((pkg-desc desc))
- (let (deps)
- (dolist (req (package-desc-reqs pkg-desc))
- (setq deps (nconc
- (catch 'found
- (dolist (p (apply #'append (mapcar #'cdr (package--alist))))
- (when (and (string= (car req) (package-desc-name p))
- (version-list-<= (cadr req) (package-desc-version p)))
- (throw 'found (more p)))))
- deps)))
- (delete-dups (cons pkg-desc deps))))))
- (remq pkg (mapcar (if (package-desc-p pkg) #'identity #'package-desc-name) all)))))
-
-(defun package-strip-rcs-id (str)
- "Strip RCS version ID from the version string STR.
-If the result looks like a dotted numeric version, return it.
-Otherwise return nil."
- (when str
- (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
- (setq str (substring str (match-end 0))))
- (let ((l (version-to-list str)))
- ;; Don't return `str' but (package-version-join (version-to-list str))
- ;; to make sure we use a "canonical name"!
- (if l (package-version-join l)))))
-
-(declare-function lm-website "lisp-mnt" (&optional file))
-
-;;;###autoload
-(defun package-install-from-buffer ()
- "Install a package from the current buffer.
-The current buffer is assumed to be a single .el or .tar file or
-a directory. These must follow the packaging guidelines (see
-info node `(elisp)Packaging').
-
-Specially, if current buffer is a directory, the -pkg.el
-description file is not mandatory, in which case the information
-is derived from the main .el file in the directory.
-
-Downloads and installs required packages as needed."
- (interactive)
- (let* ((pkg-desc
- (cond
- ((derived-mode-p 'dired-mode)
- ;; This is the only way a package-desc object with a `dir'
- ;; desc-kind can be created. Such packages can't be
- ;; uploaded or installed from archives, they can only be
- ;; installed from local buffers or directories.
- (package-dir-info))
- ((derived-mode-p 'tar-mode)
- (package-tar-file-info))
- (t
- ;; Package headers should be parsed from decoded text
- ;; (see Bug#48137) where possible.
- (if (and (eq buffer-file-coding-system 'no-conversion)
- buffer-file-name)
- (let* ((package-buffer (current-buffer))
- (decoding-system
- (car (find-operation-coding-system
- 'insert-file-contents
- (cons buffer-file-name
- package-buffer)))))
- (with-temp-buffer
- (insert-buffer-substring package-buffer)
- (decode-coding-region (point-min) (point-max)
- decoding-system)
- (package-buffer-info)))
-
- (save-excursion
- (package-buffer-info))))))
- (name (package-desc-name pkg-desc)))
- ;; Download and install the dependencies.
- (let* ((requires (package-desc-reqs pkg-desc))
- (transaction (package-compute-transaction nil requires)))
- (package-download-transaction transaction))
- ;; Install the package itself.
- (package-unpack pkg-desc)
- (unless (package--user-selected-p name)
- (package--save-selected-packages
- (cons name package-selected-packages)))
- (package--quickstart-maybe-refresh)
- pkg-desc))
-
-;;;###autoload
-(defun package-install-file (file)
- "Install a package from FILE.
-The file can either be a tar file, an Emacs Lisp file, or a
-directory."
- (interactive "fPackage file name: ")
- (with-temp-buffer
- (if (file-directory-p file)
- (progn
- (setq default-directory file)
- (dired-mode))
- (insert-file-contents-literally file)
- (set-visited-file-name file)
- (set-buffer-modified-p nil)
- (when (string-match "\\.tar\\'" file) (tar-mode)))
- (package-install-from-buffer)))
-
-;;;###autoload
-(defun package-install-selected-packages (&optional noconfirm)
- "Ensure packages in `package-selected-packages' are installed.
-If some packages are not installed, propose to install them.
-
-If optional argument NOCONFIRM is non-nil, or when invoked with a prefix
-argument, don't ask for confirmation to install packages."
- (interactive "P")
- (package--archives-initialize)
- ;; We don't need to populate `package-selected-packages' before
- ;; using here, because the outcome is the same either way (nothing
- ;; gets installed).
- (if (not package-selected-packages)
- (message "`package-selected-packages' is empty, nothing to install")
- (let* ((not-installed (seq-remove #'package-installed-p package-selected-packages))
- (available (seq-filter (lambda (p) (assq p package-archive-contents)) not-installed))
- (difference (- (length not-installed) (length available))))
- (cond
- (available
- (when (or noconfirm
- (y-or-n-p
- (format "Packages to install: %d (%s), proceed? "
- (length available)
- (mapconcat #'symbol-name available " "))))
- (mapc (lambda (p) (package-install p 'dont-select)) available)))
- ((> difference 0)
- (message (substitute-command-keys
- "Packages that are not available: %d (the rest is already \
-installed), maybe you need to \\[package-refresh-contents]")
- difference))
- (t
- (message "All your packages are already installed"))))))
-
-\f
-;;; Package Deletion
-
-(defun package--newest-p (pkg)
- "Return non-nil if PKG is the newest package with its name."
- (equal (cadr (assq (package-desc-name pkg) package-alist))
- pkg))
-
-(declare-function comp-el-to-eln-filename "comp.c")
-(defvar package-vc-repository-store)
-(defun package--delete-directory (dir)
- "Delete PKG-DESC directory DIR recursively.
-Clean-up the corresponding .eln files if Emacs is native
-compiled."
- (when (featurep 'native-compile)
- (cl-loop
- for file in (directory-files-recursively dir
- ;; Exclude lockfiles
- (rx bos (or (and "." (not "#")) (not ".")) (* nonl) ".el" eos))
- do (comp-clean-up-stale-eln (comp-el-to-eln-filename file))))
- (if (file-symlink-p (directory-file-name dir))
- (delete-file (directory-file-name dir))
- (delete-directory dir t)))
-
-
-(defun package-delete (pkg-desc &optional force nosave)
- "Delete package PKG-DESC.
-
-Argument PKG-DESC is the full description of the package, for example as
-obtained by `package-get-descriptor'. Interactively, prompt the user
-for the package name and version.
-
-When package is used elsewhere as dependency of another package,
-refuse deleting it and return an error.
-If prefix argument FORCE is non-nil, package will be deleted even
-if it is used elsewhere.
-If NOSAVE is non-nil, the package is not removed from
-`package-selected-packages'."
- (interactive
- (progn
- (let* ((package-table
- (mapcar
- (lambda (p) (cons (package-desc-full-name p) p))
- (delq nil
- (mapcar (lambda (p) (unless (package-built-in-p p) p))
- (apply #'append (mapcar #'cdr (package--alist)))))))
- (package-name (completing-read "Delete package: "
- (mapcar #'car package-table)
- nil t)))
- (list (cdr (assoc package-name package-table))
- current-prefix-arg nil))))
- (let* ((dir (package-desc-dir pkg-desc))
- (name (package-desc-name pkg-desc))
- (new-package-alist (let ((pkgs (assq name package-alist)))
- (if (null (remove pkg-desc (cdr pkgs)))
- (remq pkgs package-alist)
- package-alist)))
- pkg-used-elsewhere-by)
- ;; If the user is trying to delete this package, they definitely
- ;; don't want it marked as selected, so we remove it from
- ;; `package-selected-packages' even if it can't be deleted.
- (when (and (null nosave)
- (package--user-selected-p name)
- ;; Don't deselect if this is an older version of an
- ;; upgraded package.
- (package--newest-p pkg-desc))
- (package--save-selected-packages (remove name package-selected-packages)))
- (cond ((not (string-prefix-p (file-name-as-directory
- (expand-file-name package-user-dir))
- (expand-file-name dir)))
- ;; Don't delete "system" packages.
- (error "Package `%s' is a system package, not deleting"
- (package-desc-full-name pkg-desc)))
- ((and (null force)
- (setq pkg-used-elsewhere-by
- (let ((package-alist new-package-alist))
- (package--used-elsewhere-p pkg-desc)))) ;See bug#65475
- ;; Don't delete packages used as dependency elsewhere.
- (error "Package `%s' is used by `%s' as dependency, not deleting"
- (package-desc-full-name pkg-desc)
- (package-desc-name pkg-used-elsewhere-by)))
- (t
- (add-hook 'post-command-hook #'package-menu--post-refresh)
- (package--delete-directory dir)
- ;; Remove NAME-VERSION.signed and NAME-readme.txt files.
- ;;
- ;; NAME-readme.txt files are no longer created, but they
- ;; may be left around from an earlier install.
- (dolist (suffix '(".signed" "readme.txt"))
- (let* ((version (package-version-join (package-desc-version pkg-desc)))
- (file (concat (if (string= suffix ".signed")
- dir
- (substring dir 0 (- (length version))))
- suffix)))
- (when (file-exists-p file)
- (delete-file file))))
- ;; Update package-alist.
- (setq package-alist new-package-alist)
- (package--quickstart-maybe-refresh)
- (message "Package `%s' deleted."
- (package-desc-full-name pkg-desc))))))
-
-;;;###autoload
-(defun package-reinstall (pkg)
- "Reinstall package PKG.
-PKG should be either a symbol, the package name, or a `package-desc'
-object."
- (interactive
- (progn
- (package--archives-initialize)
- (list (intern (completing-read
- "Reinstall package: "
- (mapcar #'symbol-name
- (mapcar #'car package-alist)))))))
- (package--archives-initialize)
- (package-delete
- (if (package-desc-p pkg) pkg (cadr (assq pkg package-alist)))
- 'force 'nosave)
- (package-install pkg 'dont-select))
-
-;;;###autoload
-(defun package-recompile (pkg)
- "Byte-compile package PKG again.
-PKG should be either a symbol, the package name, or a `package-desc'
-object."
- (interactive (list (intern (completing-read
- "Recompile package: "
- (mapcar #'symbol-name
- (mapcar #'car package-alist))))))
- (let ((pkg-desc (if (package-desc-p pkg)
- pkg
- (cadr (assq pkg package-alist)))))
- ;; Delete the old .elc files to ensure that we don't inadvertently
- ;; load them (in case they contain byte code/macros that are now
- ;; invalid).
- (dolist (elc (directory-files-recursively
- (package-desc-dir pkg-desc) "\\.elc\\'"))
- (delete-file elc))
- (package--compile pkg-desc)))
-
-;;;###autoload
-(defun package-recompile-all ()
- "Byte-compile all installed packages.
-This is meant to be used only in the case the byte-compiled files
-are invalid due to changed byte-code, macros or the like."
- (interactive)
- (pcase-dolist (`(_ ,pkg-desc) package-alist)
- (with-demoted-errors "Error while recompiling: %S"
- (package-recompile pkg-desc))))
-
-;;;###autoload
-(defun package-autoremove (&optional noconfirm)
- "Remove packages that are no longer needed.
-
-Packages that are no more needed by other packages in
-`package-selected-packages' and their dependencies
-will be deleted.
-
-If optional argument NOCONFIRM is non-nil, or when invoked with a prefix
-argument, don't ask for confirmation to install packages."
- (interactive "P")
- ;; If `package-selected-packages' is nil, it would make no sense to
- ;; try to populate it here, because then `package-autoremove' will
- ;; do absolutely nothing.
- (when (or noconfirm
- package-selected-packages
- (yes-or-no-p
- (format-message
- "`package-selected-packages' is empty! Really remove ALL packages? ")))
- (let ((removable (package--removable-packages)))
- (if removable
- (when (or noconfirm
- (y-or-n-p
- (format "Packages to delete: %d (%s), proceed? "
- (length removable)
- (mapconcat #'symbol-name removable " "))))
- (mapc (lambda (p)
- (package-delete (cadr (assq p package-alist)) t))
- removable))
- (message "Nothing to autoremove")))))
-
-(defun package-isolate (packages &optional temp-init)
- "Start an uncustomized Emacs and only load a set of PACKAGES.
-Interactively, prompt for PACKAGES to load, which should be specified
-separated by commas.
-If called from Lisp, PACKAGES should be a list of packages to load.
-If TEMP-INIT is non-nil, or when invoked with a prefix argument,
-the Emacs user directory is set to a temporary directory.
-This command is intended for testing Emacs and/or the packages
-in a clean environment."
- (interactive
- (cl-loop for p in (cl-loop for p in (package--alist) append (cdr p))
- unless (package-built-in-p p)
- collect (cons (package-desc-full-name p) p) into table
- finally return
- (list
- (cl-loop for c in
- (completing-read-multiple
- "Packages to isolate, as comma-separated list: " table
- nil t)
- collect (alist-get c table nil nil #'string=))
- current-prefix-arg)))
- (let* ((name (concat "package-isolate-"
- (mapconcat #'package-desc-full-name packages ",")))
- (all-packages (delete-consecutive-dups
- (sort (append packages (mapcan #'package--dependencies packages))
- (lambda (p0 p1)
- (string< (package-desc-name p0) (package-desc-name p1))))))
- initial-scratch-message package-load-list)
- (with-temp-buffer
- (insert ";; This is an isolated testing environment, with these packages enabled:\n\n")
- (dolist (package all-packages)
- (push (list (package-desc-name package)
- (package-version-join (package-desc-version package)))
- package-load-list)
- (insert ";; - " (package-desc-full-name package))
- (unless (memq package packages)
- (insert " (dependency)"))
- (insert "\n"))
- (insert "\n")
- (setq initial-scratch-message (buffer-string)))
- (apply #'start-process (concat "*" name "*") nil
- (list (expand-file-name invocation-name invocation-directory)
- "--quick" "--debug-init"
- "--init-directory" (if temp-init
- (make-temp-file name t)
- user-emacs-directory)
- (format "--eval=%S"
- `(progn
- (setq initial-scratch-message ,initial-scratch-message)
-
- (require 'package)
- ,@(mapcar
- (lambda (dir)
- `(add-to-list 'package-directory-list ,dir))
- (cons package-user-dir package-directory-list))
- (setq package-load-list ',package-load-list)
- (package-activate-all)))))))
-
-\f
-;;;; Package description buffer.
-
-;;;###autoload
-(defun describe-package (package)
- "Display the full documentation of PACKAGE (a symbol)."
- (interactive
- (let* ((guess (or (function-called-at-point)
- (symbol-at-point))))
- (require 'finder-inf nil t)
- ;; Load the package list if necessary (but don't activate them).
- (unless package--initialized
- (package-initialize t))
- (let ((packages (append (mapcar #'car package-alist)
- (mapcar #'car package-archive-contents)
- (mapcar #'car package--builtins))))
- (unless (memq guess packages)
- (setq guess nil))
- (setq packages (mapcar #'symbol-name packages))
- (let ((val
- (completing-read (format-prompt "Describe package" guess)
- packages nil t nil nil (when guess
- (symbol-name guess)))))
- (list (and (> (length val) 0) (intern val)))))))
- (setq package (if (stringp package) (intern package) package))
- (if (not (or (package-desc-p package) (and package (symbolp package))))
- (message "No package specified")
- (help-setup-xref (list #'describe-package package)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (with-current-buffer standard-output
- (describe-package-1 package)))))
-
-(put 'describe-package 'minibuffer-action "describe")
-
-(defface package-help-section-name
- '((t :inherit (bold font-lock-function-name-face)))
- "Face used on section names in package description buffers."
- :version "25.1")
-
-(defun package--print-help-section (name &rest strings)
- "Print \"NAME: \", right aligned to the 13th column.
-If more STRINGS are provided, insert them followed by a newline.
-Otherwise no newline is inserted."
- (declare (indent 1))
- (insert (make-string (max 0 (- 11 (string-width name))) ?\s)
- (propertize (concat name ": ") 'font-lock-face 'package-help-section-name))
- (when strings
- (apply #'insert strings)
- (insert "\n")))
-
-(declare-function lm-commentary "lisp-mnt" (&optional file))
-
-(defun package--get-description (desc)
- "Return a string containing the long description of the package DESC.
-The description is read from the installed package files."
- ;; Installed packages have nil for kind, so we look for README
- ;; first, then fall back to the Commentary header.
-
- ;; We don’t include README.md here, because that is often the home
- ;; page on a site like github, and not suitable as the package long
- ;; description.
- (let ((files '("README-elpa" "README-elpa.md" "README" "README.rst" "README.org"))
- file
- (srcdir (package-desc-dir desc))
- result)
- (while (and files
- (not result))
- (setq file (pop files))
- (when (file-readable-p (expand-file-name file srcdir))
- ;; Found a README.
- (with-temp-buffer
- (insert-file-contents (expand-file-name file srcdir))
- (setq result (buffer-string)))))
-
- (or
- result
-
- ;; Look for Commentary header.
- (lm-commentary (expand-file-name
- (format "%s.el" (package-desc-name desc)) srcdir))
- "")))
-
-(defun package--describe-add-library-links ()
- "Add links to library names in package description."
- (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t)
- (if (locate-library (match-string 1))
- (make-text-button (match-beginning 1) (match-end 1)
- 'xref (match-string-no-properties 1)
- 'help-echo "Read this file's commentary"
- :type 'package--finder-xref))))
-
-(defun describe-package-1 (pkg)
- "Insert the package description for PKG.
-Helper function for `describe-package'."
- (require 'lisp-mnt)
- (let* ((desc (or
- (if (package-desc-p pkg) pkg)
- (cadr (assq pkg package-alist))
- (let ((built-in (assq pkg package--builtins)))
- (if built-in
- (package--from-builtin built-in)
- (cadr (assq pkg package-archive-contents))))))
- (name (if desc (package-desc-name desc) pkg))
- (pkg-dir (if desc (package-desc-dir desc)))
- (reqs (if desc (package-desc-reqs desc)))
- (required-by (if desc (package--used-elsewhere-p desc nil 'all)))
- (version (if desc (package-desc-version desc)))
- (archive (if desc (package-desc-archive desc)))
- (extras (and desc (package-desc-extras desc)))
- (website (cdr (assoc :url extras)))
- (commit (cdr (assoc :commit extras)))
- (keywords (if desc (package-desc--keywords desc)))
- (built-in (eq pkg-dir 'builtin))
- (installable (and archive (not built-in)))
- (status (if desc (package-desc-status desc) "orphan"))
- (incompatible-reason (package--incompatible-p desc))
- (signed (if desc (package-desc-signed desc)))
- (maintainers (cdr (assoc :maintainer extras)))
- (authors (cdr (assoc :authors extras)))
- (news (and-let* (pkg-dir
- ((not built-in))
- (file (expand-file-name "news" pkg-dir))
- ((file-regular-p file))
- ((file-readable-p file)))
- file)))
- (when (string= status "avail-obso")
- (setq status "available obsolete"))
- (when incompatible-reason
- (setq status "incompatible"))
- (princ (format "Package %S is %s.\n\n" name status))
-
- ;; TODO: Remove the string decorations and reformat the strings
- ;; for future l10n.
- (package--print-help-section "Status")
- (cond (built-in
- (insert (propertize (capitalize status)
- 'font-lock-face 'package-status-built-in)
- "."))
- (pkg-dir
- (insert (propertize (if (member status '("unsigned" "dependency"))
- "Installed"
- (capitalize status))
- 'font-lock-face 'package-status-built-in))
- (insert (substitute-command-keys " in `"))
- (let ((dir (abbreviate-file-name
- (file-name-as-directory
- (if (file-in-directory-p pkg-dir package-user-dir)
- (file-relative-name pkg-dir package-user-dir)
- pkg-dir)))))
- (help-insert-xref-button dir 'help-package-def pkg-dir))
- (if (and (package-built-in-p name)
- (not (package-built-in-p name version)))
- (insert (substitute-command-keys
- "',\n shadowing a ")
- (propertize "built-in package"
- 'font-lock-face 'package-status-built-in))
- (insert (substitute-quotes "'")))
- (if signed
- (insert ".")
- (insert " (unsigned)."))
- (when (and (package-desc-p desc)
- (not required-by)
- (member status '("unsigned" "installed")))
- (insert " ")
- (package-make-button "Delete"
- 'action #'package-delete-button-action
- 'package-desc desc)))
- (incompatible-reason
- (insert (propertize "Incompatible" 'font-lock-face 'font-lock-warning-face)
- " because it depends on ")
- (if (stringp incompatible-reason)
- (insert "Emacs " incompatible-reason ".")
- (insert "uninstallable packages.")))
- (installable
- (insert (capitalize status))
- (insert " from " (format "%s" archive))
- (insert " -- ")
- (package-make-button
- "Install"
- 'action 'package-install-button-action
- 'package-desc desc))
- (t (insert (capitalize status) ".")))
- (insert "\n")
- (unless (and pkg-dir (not archive)) ; Installed pkgs don't have archive.
- (package--print-help-section "Archive"
- (or archive "n/a")))
- (and version
- (package--print-help-section "Version"
- (package-version-join version)))
- (when commit
- (package--print-help-section "Commit" commit))
- (when desc
- (package--print-help-section "Summary"
- (package-desc-summary desc)))
-
- (setq reqs (if desc (package-desc-reqs desc)))
- (when reqs
- (package--print-help-section "Requires")
- (let ((first t))
- (dolist (req reqs)
- (let* ((name (car req))
- (vers (cadr req))
- (text (format "%s-%s" (symbol-name name)
- (package-version-join vers)))
- (reason (if (and (listp incompatible-reason)
- (assq name incompatible-reason))
- " (not available)" "")))
- (cond (first (setq first nil))
- ((>= (+ 2 (current-column) (length text) (length reason))
- (window-width))
- (insert ",\n "))
- (t (insert ", ")))
- (help-insert-xref-button text 'help-package name)
- (insert reason)))
- (insert "\n")))
- (when required-by
- (package--print-help-section "Required by")
- (let ((first t))
- (dolist (pkg required-by)
- (let ((text (package-desc-full-name pkg)))
- (cond (first (setq first nil))
- ((>= (+ 2 (current-column) (length text))
- (window-width))
- (insert ",\n "))
- (t (insert ", ")))
- (help-insert-xref-button text 'help-package
- (package-desc-name pkg))))
- (insert "\n")))
- (when website
- ;; Prefer https for the website of packages on common domains.
- (when (string-match-p (rx bol "http://" (or "elpa." "www." "git." "")
- (or "nongnu.org" "gnu.org" "sr.ht"
- "emacswiki.org" "gitlab.com" "github.com")
- "/")
- website)
- ;; But only if the user has "https" in `package-archives'.
- (let ((gnu (cdr (assoc "gnu" package-archives))))
- (and gnu (string-match-p "^https" gnu)
- (setq website
- (replace-regexp-in-string "^http" "https" website)))))
- (package--print-help-section "Website")
- (help-insert-xref-button website 'help-url website)
- (insert "\n"))
- (when keywords
- (package--print-help-section "Keywords")
- (dolist (k keywords)
- (package-make-button
- k
- 'package-keyword k
- 'action 'package-keyword-button-action)
- (insert " "))
- (insert "\n"))
- (when maintainers
- (unless (and (listp (car maintainers)) (listp (cdr maintainers)))
- (setq maintainers (list maintainers)))
- (package--print-help-section
- (if (cdr maintainers) "Maintainers" "Maintainer"))
- (dolist (maintainer maintainers)
- (when (bolp)
- (insert (make-string 13 ?\s)))
- (package--print-email-button maintainer)))
- (when authors
- (package--print-help-section (if (cdr authors) "Authors" "Author"))
- (dolist (author authors)
- (when (bolp)
- (insert (make-string 13 ?\s)))
- (package--print-email-button author)))
- (let* ((all-pkgs (append (cdr (assq name package-alist))
- (cdr (assq name package-archive-contents))
- (let ((bi (assq name package--builtins)))
- (if bi (list (package--from-builtin bi))))))
- (other-pkgs (delete desc all-pkgs)))
- (when other-pkgs
- (package--print-help-section "Other versions"
- (mapconcat (lambda (opkg)
- (let* ((ov (package-desc-version opkg))
- (dir (package-desc-dir opkg))
- (from (or (package-desc-archive opkg)
- (if (stringp dir) "installed" dir))))
- (if (not ov) (format "%s" from)
- (format "%s (%s)"
- (make-text-button (package-version-join ov) nil
- 'font-lock-face 'link
- 'follow-link t
- 'action
- (lambda (_button)
- (describe-package opkg)))
- from))))
- other-pkgs ", ")
- ".")))
-
- (insert "\n")
-
- (let ((start-of-description (point)))
- (if built-in
- ;; For built-in packages, get the description from the
- ;; Commentary header.
- (insert (or (lm-commentary (locate-file (format "%s.el" name)
- load-path
- load-file-rep-suffixes))
- ""))
-
- (if (package-installed-p desc)
- ;; For installed packages, get the description from the
- ;; installed files.
- (insert (package--get-description desc))
-
- ;; For non-built-in, non-installed packages, get description from
- ;; the archive.
- (let* ((basename (format "%s-readme.txt" name))
- readme-string)
-
- (package--with-response-buffer (package-archive-base desc)
- :file basename :noerror t
- (save-excursion
- (goto-char (point-max))
- (unless (bolp)
- (insert ?\n)))
- (cl-assert (not enable-multibyte-characters))
- (setq readme-string
- ;; The readme.txt files are defined to contain utf-8 text.
- (decode-coding-region (point-min) (point-max) 'utf-8 t))
- t)
- (insert (or readme-string
- "This package does not provide a description.")))))
-
- ;; Insert news if available.
- (when news
- (insert "\n" (make-separator-line) "\n"
- (propertize "* News" 'face 'package-help-section-name)
- "\n\n")
- (insert-file-contents news))
-
- ;; Make library descriptions into links.
- (goto-char start-of-description)
- (package--describe-add-library-links)
- ;; Make URLs in the description into links.
- (goto-char start-of-description)
- (browse-url-add-buttons))))
-
-(defun package-install-button-action (button)
- "Run `package-install' on the package BUTTON points to.
-Used for the `action' property of buttons in the buffer created by
-`describe-package'."
- (let ((pkg-desc (button-get button 'package-desc)))
- (when (y-or-n-p (format-message "Install package `%s'? "
- (package-desc-full-name pkg-desc)))
- (package-install pkg-desc nil)
- (describe-package (package-desc-name pkg-desc)))))
-
-(defun package-delete-button-action (button)
- "Run `package-delete' on the package BUTTON points to.
-Used for the `action' property of buttons in the buffer created by
-`describe-package'."
- (let ((pkg-desc (button-get button 'package-desc)))
- (when (y-or-n-p (format-message "Delete package `%s'? "
- (package-desc-full-name pkg-desc)))
- (package-delete pkg-desc)
- (describe-package (package-desc-name pkg-desc)))))
-
-(defun package-keyword-button-action (button)
- "Show filtered \"*Packages*\" buffer for BUTTON.
-The buffer is filtered by the `package-keyword' property of BUTTON.
-Used for the `action' property of buttons in the buffer created by
-`describe-package'."
- (let ((pkg-keyword (button-get button 'package-keyword)))
- (package-show-package-list t (list pkg-keyword))))
-
-(defun package-make-button (text &rest properties)
- "Insert button labeled TEXT with button PROPERTIES at point.
-PROPERTIES are passed to `insert-text-button', for which this
-function is a convenience wrapper used by `describe-package-1'."
- (let ((button-text (if (display-graphic-p) text (concat "[" text "]")))
- (button-face (if (display-graphic-p)
- (progn
- (require 'cus-edit) ; for the custom-button face
- 'custom-button)
- 'link)))
- (apply #'insert-text-button button-text 'face button-face 'follow-link t
- properties)))
-
-(defun package--finder-goto-xref (button)
- "Jump to a Lisp file for the BUTTON at point."
- (let* ((file (button-get button 'xref))
- (lib (locate-library file)))
- (if lib (finder-commentary lib)
- (message "Unable to locate `%s'" file))))
-
-(define-button-type 'package--finder-xref 'action #'package--finder-goto-xref)
-
-(defun package--print-email-button (recipient)
- "Insert a button whose action will send an email to RECIPIENT.
-NAME should have the form (FULLNAME . EMAIL) where FULLNAME is
-either a full name or nil, and EMAIL is a valid email address."
- (when (car recipient)
- (insert (car recipient)))
- (when (and (car recipient) (cdr recipient))
- (insert " "))
- (when (cdr recipient)
- (insert "<")
- (insert-text-button (cdr recipient)
- 'follow-link t
- 'action (lambda (_)
- (compose-mail
- (format "%s <%s>" (car recipient) (cdr recipient)))))
- (insert ">"))
- (insert "\n"))
-
-\f
-;;;; Package menu mode.
-
-(defvar-keymap package-menu-mode-map
- :doc "Local keymap for `package-menu-mode' buffers."
- :parent tabulated-list-mode-map
- "C-m" #'package-menu-describe-package
- "u" #'package-menu-mark-unmark
- "DEL" #'package-menu-backup-unmark
- "d" #'package-menu-mark-delete
- "i" #'package-menu-mark-install
- "U" #'package-menu-mark-upgrades
- "r" #'revert-buffer
- "~" #'package-menu-mark-obsolete-for-deletion
- "w" #'package-browse-url
- "b" #'package-report-bug
- "x" #'package-menu-execute
- "h" #'package-menu-quick-help
- "H" #'package-menu-hide-package
- "?" #'package-menu-describe-package
- "(" #'package-menu-toggle-hiding
- "/ /" #'package-menu-clear-filter
- "/ a" #'package-menu-filter-by-archive
- "/ d" #'package-menu-filter-by-description
- "/ k" #'package-menu-filter-by-keyword
- "/ N" #'package-menu-filter-by-name-or-description
- "/ n" #'package-menu-filter-by-name
- "/ s" #'package-menu-filter-by-status
- "/ v" #'package-menu-filter-by-version
- "/ m" #'package-menu-filter-marked
- "/ u" #'package-menu-filter-upgradable)
-
-(easy-menu-define package-menu-mode-menu package-menu-mode-map
- "Menu for `package-menu-mode'."
- '("Package"
- ["Describe Package" package-menu-describe-package :help "Display information about this package"]
- ["Open Package Website" package-browse-url
- :help "Open the website of this package"]
- ["Help" package-menu-quick-help :help "Show short key binding help for package-menu-mode"]
- "--"
- ["Refresh Package List" revert-buffer
- :help "Redownload the package archive(s)"
- :active (not package--downloads-in-progress)]
- ["Execute Marked Actions" package-menu-execute :help "Perform all the marked actions"]
-
- "--"
- ["Mark All Available Upgrades" package-menu-mark-upgrades
- :help "Mark packages that have a newer version for upgrading"
- :active (not package--downloads-in-progress)]
- ["Mark All Obsolete for Deletion" package-menu-mark-obsolete-for-deletion :help "Mark all obsolete packages for deletion"]
- ["Mark for Install" package-menu-mark-install :help "Mark a package for installation and move to the next line"]
- ["Mark for Deletion" package-menu-mark-delete :help "Mark a package for deletion and move to the next line"]
- ["Unmark" package-menu-mark-unmark :help "Clear any marks on a package and move to the next line"]
-
- "--"
- ("Filter Packages"
- ["Filter by Archive" package-menu-filter-by-archive
- :help
- "Prompt for archive(s), display only packages from those archives"]
- ["Filter by Description" package-menu-filter-by-description
- :help
- "Prompt for regexp, display only packages with matching description"]
- ["Filter by Keyword" package-menu-filter-by-keyword
- :help
- "Prompt for keyword(s), display only packages with matching keywords"]
- ["Filter by Name" package-menu-filter-by-name
- :help
- "Prompt for regexp, display only packages whose names match the regexp"]
- ["Filter by Name or Description" package-menu-filter-by-name-or-description
- :help
- "Prompt for regexp, display only packages whose name or description matches"]
- ["Filter by Status" package-menu-filter-by-status
- :help
- "Prompt for status(es), display only packages with those statuses"]
- ["Filter by Upgrades available" package-menu-filter-upgradable
- :help "Display only installed packages for which upgrades are available"]
- ["Filter by Version" package-menu-filter-by-version
- :help
- "Prompt for version and comparison operator, display only packages of matching versions"]
- ["Filter Marked" package-menu-filter-marked
- :help "Display only packages marked for installation or deletion"]
- ["Clear Filter" package-menu-clear-filter
- :help "Clear package list filtering, display the entire list again"])
-
- ["Hide by Regexp" package-menu-hide-package
- :help "Toggle visibility of obsolete and unwanted packages"]
- ["Display Older Versions" package-menu-toggle-hiding
- :style toggle :selected (not package-menu--hide-packages)
- :help "Display package even if a newer version is already installed"]
-
- "--"
- ["Quit" quit-window :help "Quit package selection"]
- ["Customize" (customize-group 'package)]))
-
-(defvar package-menu--new-package-list nil
- "List of newly-available packages since `list-packages' was last called.")
-
-(defvar package-menu--transaction-status nil
- "Mode-line status of ongoing package transaction.")
-
-(define-derived-mode package-menu-mode tabulated-list-mode "Package Menu"
- "Major mode for browsing a list of packages.
-The most useful commands here are:
-
- `x': Install the package under point if it isn't already installed,
- and delete it if it's already installed,
- `i': mark a package for installation, and
- `d': mark a package for deletion. Use the `x' command to perform the
- actions on the marked files.
-\\<package-menu-mode-map>
-\\{package-menu-mode-map}"
- :interactive nil
- (setq mode-line-process '((package--downloads-in-progress ":Loading")
- (package-menu--transaction-status
- package-menu--transaction-status)))
- (setq tabulated-list-format
- `[("Package" ,package-name-column-width package-menu--name-predicate)
- ("Version" ,package-version-column-width package-menu--version-predicate)
- ("Status" ,package-status-column-width package-menu--status-predicate)
- ("Archive" ,package-archive-column-width package-menu--archive-predicate)
- ("Description" 0 package-menu--description-predicate)])
- (setq tabulated-list-padding 2)
- (setq tabulated-list-sort-key (cons "Status" nil))
- (add-hook 'tabulated-list-revert-hook #'package-menu--refresh nil t)
- (tabulated-list-init-header)
- (setq revert-buffer-function 'package-menu--refresh-contents)
- (setf imenu-prev-index-position-function
- #'package--imenu-prev-index-position-function)
- (setf imenu-extract-index-name-function
- #'package--imenu-extract-index-name-function))
-
-(defmacro package--push (pkg-desc status listname)
- "Convenience macro for `package-menu--generate'.
-If the alist stored in the symbol LISTNAME lacks an entry for a
-package PKG-DESC, add one. The alist is keyed with PKG-DESC."
- (declare (obsolete nil "27.1"))
- `(unless (assoc ,pkg-desc ,listname)
- ;; FIXME: Should we move status into pkg-desc?
- (push (cons ,pkg-desc ,status) ,listname)))
-
-(defvar package-list-unversioned nil
- "If non-nil, include packages that don't have a version in `list-packages'.")
-
-(defvar package-list-unsigned nil
- "If non-nil, mention in the list which packages were installed without signature.")
-
-(defvar package--emacs-version-list (version-to-list emacs-version)
- "The value of variable `emacs-version' as a list.")
-
-(defun package--ensure-package-menu-mode ()
- "Signal a user-error if major mode is not `package-menu-mode'."
- (unless (derived-mode-p 'package-menu-mode)
- (user-error "The current buffer is not a Package Menu")))
-
-(defun package--incompatible-p (pkg &optional shallow)
- "Return non-nil if PKG has no chance of being installable.
-PKG is a `package-desc' object.
-
-If SHALLOW is non-nil, this only checks if PKG depends on a
-higher `emacs-version' than the one being used. Otherwise, also
-checks the viability of dependencies, according to
-`package--compatibility-table'.
-
-If PKG requires an incompatible Emacs version, the return value
-is this version (as a string).
-If PKG requires incompatible packages, the return value is a list
-of these dependencies, similar to the list returned by
-`package-desc-reqs'."
- (let* ((reqs (package-desc-reqs pkg))
- (version (cadr (assq 'emacs reqs))))
- (if (and version (version-list-< package--emacs-version-list version))
- (package-version-join version)
- (unless shallow
- (let (out)
- (dolist (dep (package-desc-reqs pkg) out)
- (let ((dep-name (car dep)))
- (unless (eq 'emacs dep-name)
- (let ((cv (gethash dep-name package--compatibility-table)))
- (when (version-list-< (or cv '(0)) (or (cadr dep) '(0)))
- (push dep out)))))))))))
-
-(defun package-desc-status (pkg-desc)
- "Return the status of `package-desc' object PKG-DESC."
- (let* ((name (package-desc-name pkg-desc))
- (dir (package-desc-dir pkg-desc))
- (lle (assq name package-load-list))
- (held (cadr lle))
- (version (package-desc-version pkg-desc))
- (signed (or (not package-list-unsigned)
- (package-desc-signed pkg-desc))))
- (cond
- ((package-vc-p pkg-desc) "source")
- ((eq dir 'builtin) "built-in")
- ((and lle (null held)) "disabled")
- ((stringp held)
- (let ((hv (if (stringp held) (version-to-list held))))
- (cond
- ((version-list-= version hv) "held")
- ((version-list-< version hv) "obsolete")
- (t "disabled"))))
- (dir ;One of the installed packages.
- (cond
- ((not (file-exists-p dir)) "deleted")
- ;; Not inside `package-user-dir'.
- ((not (file-in-directory-p dir package-user-dir)) "external")
- ((eq pkg-desc (cadr (assq name package-alist)))
- (if (not signed) "unsigned"
- (if (package--user-selected-p name)
- "installed" "dependency")))
- (t "obsolete")))
- ((package--incompatible-p pkg-desc) "incompat")
- (t
- (let* ((ins (cadr (assq name package-alist)))
- (ins-v (if ins (package-desc-version ins))))
- (cond
- ;; Installed obsolete packages are handled in the `dir'
- ;; clause above. Here we handle available obsolete, which
- ;; are displayed depending on `package-menu--hide-packages'.
- ((and ins (version-list-<= version ins-v)) "avail-obso")
- (t
- (if (memq name package-menu--new-package-list)
- "new" "available"))))))))
-
-(defvar package-menu--hide-packages t
- "Whether available obsolete packages should be hidden.
-Can be toggled with \\<package-menu-mode-map> \\[package-menu-toggle-hiding].
-Installed obsolete packages are always displayed.")
-
-(defun package-menu-toggle-hiding ()
- "In Package Menu, toggle visibility of obsolete available packages.
-
-Also hide packages whose name matches a regexp in user option
-`package-hidden-regexps' (a list). To add regexps to this list,
-use `package-menu-hide-package'."
- (interactive nil package-menu-mode)
- (package--ensure-package-menu-mode)
- (setq package-menu--hide-packages
- (not package-menu--hide-packages))
- (if package-menu--hide-packages
- (message "Hiding obsolete or unwanted packages")
- (message "Displaying all packages"))
- (revert-buffer nil 'no-confirm))
-
-(defun package--remove-hidden (pkg-list)
- "Filter PKG-LIST according to `package-archive-priorities'.
-PKG-LIST must be a list of `package-desc' objects, all with the
-same name, sorted by decreasing `package-desc-priority-version'.
-Return a list of packages tied for the highest priority according
-to their archives."
- (when pkg-list
- ;; Variable toggled with `package-menu-toggle-hiding'.
- (if (not package-menu--hide-packages)
- pkg-list
- (let ((installed (cadr (assq (package-desc-name (car pkg-list))
- package-alist))))
- (when installed
- (setq pkg-list
- (let ((ins-version (package-desc-version installed)))
- (cl-remove-if (lambda (p) (version-list-< (package-desc-version p)
- ins-version))
- pkg-list))))
- (let ((filtered-by-priority
- (cond
- ((not package-menu-hide-low-priority)
- pkg-list)
- ((eq package-menu-hide-low-priority 'archive)
- (let (max-priority out)
- (while pkg-list
- (let ((p (pop pkg-list)))
- (let ((priority (package-desc-priority p)))
- (if (and max-priority (< priority max-priority))
- (setq pkg-list nil)
- (push p out)
- (setq max-priority priority)))))
- (nreverse out)))
- (pkg-list
- (list (car pkg-list))))))
- (if (not installed)
- filtered-by-priority
- (let ((ins-version (package-desc-version installed)))
- (cl-remove-if (lambda (p) (or (version-list-= (package-desc-version p)
- ins-version)
- (package-vc-p installed)))
- filtered-by-priority))))))))
-
-(defcustom package-hidden-regexps nil
- "List of regexps matching the name of packages to hide.
-If the name of a package matches any of these regexps it is
-omitted from the package menu. To toggle this, type \\[package-menu-toggle-hiding].
-
-Values can be interactively added to this list by typing
-\\[package-menu-hide-package] on a package."
- :version "25.1"
- :type '(repeat (regexp :tag "Hide packages with name matching")))
-
-(defcustom package-menu-use-current-if-no-marks t
- "Whether \\<package-menu-mode-map>\\[package-menu-execute] in package menu operates on current package if none are marked.
-
-If non-nil, and no packages are marked for installation or
-deletion, \\<package-menu-mode-map>\\[package-menu-execute] will operate on the current package at point,
-see `package-menu-execute' for details.
-The default is t. Set to nil to get back the original behavior
-of having `package-menu-execute' signal an error when no packages
-are marked for installation or deletion."
- :version "29.1"
- :type 'boolean)
-
-(defun package-menu--refresh (&optional packages keywords)
- "Re-populate the `tabulated-list-entries'.
-PACKAGES should be nil or t, which means to display all known packages.
-KEYWORDS should be nil or a list of keywords."
- ;; Construct list of (PKG-DESC . STATUS).
- (unless packages (setq packages t))
- (let ((hidden-names (mapconcat #'identity package-hidden-regexps "\\|"))
- info-list)
- ;; Installed packages:
- (dolist (elt package-alist)
- (let ((name (car elt)))
- (when (or (eq packages t) (memq name packages))
- (dolist (pkg (cdr elt))
- (when (package--has-keyword-p pkg keywords)
- (push pkg info-list))))))
-
- ;; Built-in packages:
- (dolist (elt package--builtins)
- (let ((pkg (package--from-builtin elt))
- (name (car elt)))
- (when (not (eq name 'emacs)) ; Hide the `emacs' package.
- (when (and (package--has-keyword-p pkg keywords)
- (or package-list-unversioned
- (package--bi-desc-version (cdr elt)))
- (or (eq packages t) (memq name packages)))
- (push pkg info-list)))))
-
- ;; Available and disabled packages:
- (unless (equal package--old-archive-priorities package-archive-priorities)
- (package-read-all-archive-contents))
- (dolist (elt package-archive-contents)
- (let ((name (car elt)))
- ;; To be displayed it must be in PACKAGES;
- (when (and (or (eq packages t) (memq name packages))
- ;; and we must either not be hiding anything,
- (or (not package-menu--hide-packages)
- (not package-hidden-regexps)
- ;; or just not hiding this specific package.
- (not (string-match hidden-names (symbol-name name)))))
- ;; Hide available-obsolete or low-priority packages.
- (dolist (pkg (package--remove-hidden (cdr elt)))
- (when (package--has-keyword-p pkg keywords)
- (push pkg info-list))))))
-
- ;; Print the result.
- (tabulated-list-init-header)
- (setq tabulated-list-entries
- (mapcar #'package-menu--print-info-simple info-list))))
-
-(defun package-all-keywords ()
- "Collect all package keywords."
- (let ((key-list))
- (package--mapc (lambda (desc)
- (setq key-list (append (package-desc--keywords desc)
- key-list))))
- key-list))
-
-(defun package--mapc (function &optional packages)
- "Call FUNCTION for all known PACKAGES.
-PACKAGES can be nil or t, which means to display all known
-packages, or a list of packages.
-
-Built-in packages are converted with `package--from-builtin'."
- (unless packages (setq packages t))
- (let (name)
- ;; Installed packages:
- (dolist (elt package-alist)
- (setq name (car elt))
- (when (or (eq packages t) (memq name packages))
- (mapc function (cdr elt))))
-
- ;; Built-in packages:
- (dolist (elt package--builtins)
- (setq name (car elt))
- (when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
- (or package-list-unversioned
- (package--bi-desc-version (cdr elt)))
- (or (eq packages t) (memq name packages)))
- (funcall function (package--from-builtin elt))))
-
- ;; Available and disabled packages:
- (dolist (elt package-archive-contents)
- (setq name (car elt))
- (when (or (eq packages t) (memq name packages))
- (dolist (pkg (cdr elt))
- ;; Hide obsolete packages.
- (unless (package-installed-p (package-desc-name pkg)
- (package-desc-version pkg))
- (funcall function pkg)))))))
-
-(defun package--has-keyword-p (desc &optional keywords)
- "Test if package DESC has any of the given KEYWORDS.
-When none are given, the package matches."
- (if keywords
- (let ((desc-keywords (and desc (package-desc--keywords desc)))
- found)
- (while (and (not found) keywords)
- (let ((k (pop keywords)))
- (setq found
- (or (string= k (concat "arc:" (package-desc-archive desc)))
- (string= k (concat "status:" (package-desc-status desc)))
- (member k desc-keywords)))))
- found)
- t))
-
-(defun package-menu--display (remember-pos suffix)
- "Display the Package Menu.
-If REMEMBER-POS is non-nil, keep point on the same entry.
-
-If SUFFIX is non-nil, append that to \"Package\" for the first
-column in the header line."
- (setf (car (aref tabulated-list-format 0))
- (if suffix
- (concat "Package[" suffix "]")
- "Package"))
- (tabulated-list-init-header)
- (tabulated-list-print remember-pos))
-
-(defun package-menu--generate (remember-pos &optional packages keywords)
- "Populate and display the Package Menu.
-If REMEMBER-POS is non-nil, keep point on the same entry.
-PACKAGES should be t, which means to display all known packages,
-or a list of package names (symbols) to display.
-
-With KEYWORDS given, only packages with those keywords are
-shown."
- (package-menu--refresh packages keywords)
- (package-menu--display remember-pos
- (when keywords
- (let ((filters (mapconcat #'identity keywords ",")))
- (concat "Package[" filters "]")))))
-
-(defun package-menu--print-info (pkg)
- "Return a package entry suitable for `tabulated-list-entries'.
-PKG has the form (PKG-DESC . STATUS).
-Return (PKG-DESC [NAME VERSION STATUS DOC])."
- (package-menu--print-info-simple (car pkg)))
-(make-obsolete 'package-menu--print-info
- 'package-menu--print-info-simple "25.1")
-
-\f
-;;; Package menu faces
-
-(defface package-name
- '((t :inherit link))
- "Face used on package names in the package menu."
- :version "25.1")
-
-(defface package-description
- '((t :inherit default))
- "Face used on package description summaries in the package menu."
- :version "25.1")
-
-;; Shame this hyphenates "built-in", when "font-lock-builtin-face" doesn't.
-(defface package-status-built-in
- '((t :inherit font-lock-builtin-face))
- "Face used on the status and version of built-in packages."
- :version "25.1")
-
-(defface package-status-external
- '((t :inherit package-status-built-in))
- "Face used on the status and version of external packages."
- :version "25.1")
-
-(defface package-status-available
- '((t :inherit default))
- "Face used on the status and version of available packages."
- :version "25.1")
-
-(defface package-status-new
- '((t :inherit (bold package-status-available)))
- "Face used on the status and version of new packages."
- :version "25.1")
-
-(defface package-status-held
- '((t :inherit font-lock-constant-face))
- "Face used on the status and version of held packages."
- :version "25.1")
-
-(defface package-status-disabled
- '((t :inherit font-lock-warning-face))
- "Face used on the status and version of disabled packages."
- :version "25.1")
-
-(defface package-status-installed
- '((t :inherit font-lock-comment-face))
- "Face used on the status and version of installed packages."
- :version "25.1")
-
-(defface package-status-from-source
- '((t :inherit font-lock-negation-char-face))
- "Face used on the status and version of installed packages."
- :version "29.1")
-
-(defface package-status-dependency
- '((t :inherit package-status-installed))
- "Face used on the status and version of dependency packages."
- :version "25.1")
-
-(defface package-status-unsigned
- '((t :inherit font-lock-warning-face))
- "Face used on the status and version of unsigned packages."
- :version "25.1")
-
-(defface package-status-incompat
- '((t :inherit error))
- "Face used on the status and version of incompat packages."
- :version "25.1")
-
-(defface package-status-avail-obso
- '((t :inherit package-status-incompat))
- "Face used on the status and version of avail-obso packages."
- :version "25.1")
-
-\f
-;;; Package menu printing
-
-(defun package-menu--print-info-simple (pkg)
- "Return a package entry suitable for `tabulated-list-entries'.
-PKG is a `package-desc' object.
-Return (PKG-DESC [NAME VERSION STATUS DOC])."
- (let* ((status (package-desc-status pkg))
- (face (pcase status
- ("built-in" 'package-status-built-in)
- ("external" 'package-status-external)
- ("available" 'package-status-available)
- ("avail-obso" 'package-status-avail-obso)
- ("new" 'package-status-new)
- ("held" 'package-status-held)
- ("disabled" 'package-status-disabled)
- ("installed" 'package-status-installed)
- ("source" 'package-status-from-source)
- ("dependency" 'package-status-dependency)
- ("unsigned" 'package-status-unsigned)
- ("incompat" 'package-status-incompat)
- (_ 'font-lock-warning-face)))) ; obsolete.
- (list pkg
- `[(,(symbol-name (package-desc-name pkg))
- face package-name
- font-lock-face package-name
- follow-link t
- package-desc ,pkg
- action package-menu-describe-package)
- ,(propertize
- (if (package-vc-p pkg)
- (progn
- (require 'package-vc)
- (package-vc-commit pkg))
- (package-version-join
- (package-desc-version pkg)))
- 'font-lock-face face)
- ,(propertize status 'font-lock-face face)
- ,(propertize (or (package-desc-archive pkg) "")
- 'font-lock-face face)
- ,(propertize (package-desc-summary pkg)
- 'font-lock-face 'package-description)])))
-
-(defvar package-menu--old-archive-contents nil
- "`package-archive-contents' before the latest refresh.")
-
-(defun package-menu--refresh-contents (&optional _arg _noconfirm)
- "In Package Menu, download the Emacs Lisp package archive.
-Fetch the contents of each archive specified in
-`package-archives', and then refresh the package menu.
-
-`package-menu-mode' sets `revert-buffer-function' to this
-function. The args ARG and NOCONFIRM, passed from
-`revert-buffer', are ignored."
- (package--ensure-package-menu-mode)
- (setq package-menu--old-archive-contents package-archive-contents)
- (setq package-menu--new-package-list nil)
- (package-refresh-contents package-menu-async))
-(define-obsolete-function-alias 'package-menu-refresh 'revert-buffer "27.1")
-
-(defun package-menu-hide-package ()
- "Hide in Package Menu packages that match a regexp.
-Prompt for the regexp to match against package names.
-The default regexp will hide only the package whose name is at point.
-
-The regexp is added to the list in the user option
-`package-hidden-regexps' and saved for future sessions.
-
-To unhide a package, type
-`\\[customize-variable] RET package-hidden-regexps', and then modify
-the regexp such that it no longer matches the package's name.
-
-Type \\[package-menu-toggle-hiding] to toggle package hiding."
- (declare (interactive-only "change `package-hidden-regexps' instead."))
- (interactive nil package-menu-mode)
- (package--ensure-package-menu-mode)
- (let* ((name (when (derived-mode-p 'package-menu-mode)
- (concat "\\`" (regexp-quote (symbol-name (package-desc-name
- (tabulated-list-get-id))))
- "\\'")))
- (re (read-string "Hide packages matching regexp: " name)))
- ;; Test if it is valid.
- (string-match re "")
- (push re package-hidden-regexps)
- (customize-save-variable 'package-hidden-regexps package-hidden-regexps)
- (package-menu--post-refresh)
- (let ((hidden
- (cl-remove-if-not (lambda (e) (string-match re (symbol-name (car e))))
- package-archive-contents)))
- (message "Packages to hide: %d. Type `%s' to toggle or `%s' to customize"
- (length hidden)
- (substitute-command-keys "\\[package-menu-toggle-hiding]")
- (substitute-command-keys "\\[customize-variable] RET package-hidden-regexps")))))
-
-
-(defun package-menu-describe-package (&optional button)
- "Describe the current package.
-The current package is the package at point.
-If optional arg BUTTON is non-nil, describe its associated
-package(s); this is always nil in interactive invocations."
- (interactive nil package-menu-mode)
- (let ((pkg-desc (if button (button-get button 'package-desc)
- (tabulated-list-get-id))))
- (if pkg-desc
- (describe-package pkg-desc)
- (user-error "No package here"))))
-
-;; fixme numeric argument
-(defun package-menu-mark-delete (&optional _num)
- "Mark the current package for deletion and move to the next line.
-The current package is the package at point."
- (interactive "p" package-menu-mode)
- (package--ensure-package-menu-mode)
- (if (member (package-menu-get-status)
- '("installed" "source" "dependency" "obsolete" "unsigned"))
- (tabulated-list-put-tag "D" t)
- (forward-line)))
-
-(defun package-menu-mark-install (&optional _num)
- "Mark the current package for installation and move to the next line.
-The current package is the package at point."
- (interactive "p" package-menu-mode)
- (package--ensure-package-menu-mode)
- (if (member (package-menu-get-status) '("available" "avail-obso" "new" "dependency"))
- (tabulated-list-put-tag "I" t)
- (forward-line)))
-
-(defun package-menu-mark-unmark (&optional _num)
- "Clear any marks on the current package and move to the next line.
-The current package is the package at point."
- (interactive "p" package-menu-mode)
- (package--ensure-package-menu-mode)
- (tabulated-list-put-tag " " t))
-
-(defun package-menu-backup-unmark ()
- "Back up one line and clear any marks on that line's package."
- (interactive nil package-menu-mode)
- (package--ensure-package-menu-mode)
- (forward-line -1)
- (tabulated-list-put-tag " "))
-
-(defun package-menu-mark-obsolete-for-deletion ()
- "Mark all obsolete packages for deletion."
- (interactive nil package-menu-mode)
- (package--ensure-package-menu-mode)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (if (equal (package-menu-get-status) "obsolete")
- (tabulated-list-put-tag "D" t)
- (forward-line 1)))))
-
-(defvar package--quick-help-keys
- '((("mark for installation," . 9)
- ("mark for deletion," . 9) "unmark," ("execute marked actions" . 1))
- ("next," "previous")
- ("Hide-package," "(-toggle-hidden")
- ("g-refresh-contents," "/-filter," "help")))
-
-(defun package--prettify-quick-help-key (desc)
- "Prettify DESC to be displayed as a help menu."
- (if (listp desc)
- (if (listp (cdr desc))
- (mapconcat #'package--prettify-quick-help-key desc " ")
- (let ((place (cdr desc))
- (out (copy-sequence (car desc))))
- (add-text-properties place (1+ place)
- '(face help-key-binding)
- out)
- out))
- (package--prettify-quick-help-key (cons desc 0))))
-
-(defun package-menu-quick-help ()
- "Show short help for key bindings in `package-menu-mode'.
-You can view the full list of keys with \\[describe-mode]."
- (interactive nil package-menu-mode)
- (package--ensure-package-menu-mode)
- (message (mapconcat #'package--prettify-quick-help-key
- package--quick-help-keys "\n")))
-
-(defun package-menu-get-status ()
- "Return status description of package at point in Package Menu."
- (package--ensure-package-menu-mode)
- (let* ((id (tabulated-list-get-id))
- (entry (and id (assoc id tabulated-list-entries))))
- (if entry
- (aref (cadr entry) 2)
- "")))
-
-(defun package-archive-priority (archive)
- "Return the priority of ARCHIVE.
-
-The archive priorities are specified in
-`package-archive-priorities'. If not given there, the priority
-defaults to 0."
- (or (cdr (assoc archive package-archive-priorities))
- 0))
-
-(defun package-desc-priority-version (pkg-desc)
- "Return the version PKG-DESC with the archive priority prepended.
-
-This allows for easy comparison of package versions from
-different archives if archive priorities are meant to be taken in
-consideration."
- (cons (package-desc-priority pkg-desc)
- (package-desc-version pkg-desc)))
-
-(defun package-menu--find-upgrades ()
- "In Package Menu, return an alist of packages that can be upgraded.
-The alist has the same form as `package-alist', namely a list
-of elements of the form (PKG . DESCS), but where DESCS is the `package-desc'
-object corresponding to the newer version."
- (let (installed available upgrades)
- ;; Build list of installed/available packages in this buffer.
- (dolist (entry tabulated-list-entries)
- ;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC])
- (let ((pkg-desc (car entry))
- (status (aref (cadr entry) 2)))
- (cond ((member status '("installed" "dependency" "unsigned" "external" "built-in"))
- (push pkg-desc installed))
- ((member status '("available" "new"))
- (setq available (package--append-to-alist pkg-desc available))))))
- ;; Loop through list of installed packages, finding upgrades.
- (dolist (pkg-desc installed)
- (let* ((name (package-desc-name pkg-desc))
- (avail-pkg (cadr (assq name available))))
- (and avail-pkg
- (version-list-< (package-desc-priority-version pkg-desc)
- (package-desc-priority-version avail-pkg))
- (or (not (package--active-built-in-p pkg-desc))
- package-install-upgrade-built-in)
- (push (cons name avail-pkg) upgrades))))
- upgrades))
-
-(defvar package-menu--mark-upgrades-pending nil
- "Whether mark-upgrades is waiting for a refresh to finish.")
-
-(defun package-menu--mark-upgrades-1 ()
- "Mark all upgradable packages in the Package Menu.
-Implementation of `package-menu-mark-upgrades'."
- (setq package-menu--mark-upgrades-pending nil)
- (let ((upgrades (package-menu--find-upgrades)))
- (if (null upgrades)
- (message "No packages to upgrade")
- (widen)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (let* ((pkg-desc (tabulated-list-get-id))
- (upgrade (cdr (assq (package-desc-name pkg-desc) upgrades))))
- (cond ((null upgrade)
- (forward-line 1))
- ((equal pkg-desc upgrade)
- (package-menu-mark-install))
- (t
- (package-menu-mark-delete))))))
- (message "Packages marked for upgrading: %d"
- (length upgrades)))))
-
-
-(defun package-menu-mark-upgrades ()
- "Mark all upgradable packages in the Package Menu.
-For each installed package for which a newer version is available,
-place an (I)nstall flag on the available version and a (D)elete flag
-on the installed version. A subsequent \\[package-menu-execute] command will upgrade
-the marked packages.
-
-If there's an async refresh operation in progress, the flags will
-be placed as part of `package-menu--post-refresh' instead of
-immediately."
- (interactive nil package-menu-mode)
- (package--ensure-package-menu-mode)
- (if (not package--downloads-in-progress)
- (package-menu--mark-upgrades-1)
- (setq package-menu--mark-upgrades-pending t)
- (message "Waiting for refresh to finish...")))
-
-(defun package-menu--list-to-prompt (packages &optional include-dependencies)
- "Return a string listing PACKAGES that's usable in a prompt.
-PACKAGES is a list of `package-desc' objects.
-Formats the returned string to be usable in a minibuffer
-prompt (see `package-menu--prompt-transaction-p').
-
-If INCLUDE-DEPENDENCIES, also include the number of uninstalled
-dependencies."
- ;; The case where `package' is empty is handled in
- ;; `package-menu--prompt-transaction-p' below.
- (format "%d (%s)%s"
- (length packages)
- (mapconcat #'package-desc-full-name packages " ")
- (let ((deps
- (seq-remove
- #'package-installed-p
- (delete-dups
- (apply
- #'nconc
- (mapcar (lambda (package)
- (package--dependencies
- (package-desc-name package)))
- packages))))))
- (if (and include-dependencies deps)
- (if (length= deps 1)
- (format " plus 1 dependency")
- (format " plus %d dependencies" (length deps)))
- ""))))
-
-(defun package-menu--prompt-transaction-p (delete install upgrade)
- "Prompt the user about DELETE, INSTALL, and UPGRADE.
-DELETE, INSTALL, and UPGRADE are lists of `package-desc' objects.
-Either may be nil, but not all."
- (y-or-n-p
- (concat
- (when delete
- (format "Packages to delete: %s. "
- (package-menu--list-to-prompt delete)))
- (when install
- (format "Packages to install: %s. "
- (package-menu--list-to-prompt install t)))
- (when upgrade
- (format "Packages to upgrade: %s. "
- (package-menu--list-to-prompt upgrade)))
- "Proceed? ")))
-
-
-(defun package-menu--partition-transaction (install delete)
- "Return an alist describing an INSTALL DELETE transaction.
-Alist contains three entries, upgrade, delete, and install, each
-with a list of package names.
-
-The upgrade entry contains any `package-desc' objects in INSTALL
-whose name coincides with an object in DELETE. The delete and
-the install entries are the same as DELETE and INSTALL with such
-objects removed."
- (let* ((upg (cl-intersection install delete :key #'package-desc-name))
- (ins (cl-set-difference install upg :key #'package-desc-name))
- (del (cl-set-difference delete upg :key #'package-desc-name)))
- `((delete . ,del) (install . ,ins) (upgrade . ,upg))))
-
-(defun package-menu--perform-transaction (install-list delete-list)
- "Install packages in INSTALL-LIST and delete DELETE-LIST.
-Return nil if there were no errors; non-nil otherwise."
- (let ((errors nil))
- (if install-list
- (let ((status-format (format ":Installing %%d/%d"
- (length install-list)))
- (i 0)
- (package-menu--transaction-status))
- (dolist (pkg install-list)
- (setq package-menu--transaction-status
- (format status-format (cl-incf i)))
- (force-mode-line-update)
- (redisplay 'force)
- ;; Don't mark as selected, `package-menu-execute' already
- ;; does that.
- (package-install pkg 'dont-select))))
- (let ((package-menu--transaction-status ":Deleting"))
- (force-mode-line-update)
- (redisplay 'force)
- (dolist (elt (package--sort-by-dependence delete-list))
- (condition-case-unless-debug err
- (let ((inhibit-message (or inhibit-message package-menu-async)))
- (package-delete elt nil 'nosave))
- (error
- (push (package-desc-full-name elt) errors)
- (message "Error trying to delete `%s': %s"
- (package-desc-full-name elt)
- (error-message-string err))))))
- errors))
-
-(defun package--update-selected-packages (add remove)
- "Update the `package-selected-packages' list according to ADD and REMOVE.
-ADD and REMOVE must be disjoint lists of package names (or
-`package-desc' objects) to be added and removed to the selected
-packages list, respectively."
- (dolist (p add)
- (cl-pushnew (if (package-desc-p p) (package-desc-name p) p)
- package-selected-packages))
- (dolist (p remove)
- (setq package-selected-packages
- (remove (if (package-desc-p p) (package-desc-name p) p)
- package-selected-packages)))
- (when (or add remove)
- (package--save-selected-packages package-selected-packages)))
-
-(defun package-menu-execute (&optional noquery)
- "Perform Package Menu actions on marked packages.
-Packages marked for installation are downloaded and installed,
-packages marked for deletion are removed, and packages marked for
-upgrading are downloaded and upgraded.
-
-If no packages are marked, the action taken depends on the state
-of the current package, the one at point. If it's not already
-installed, this command will install the package; if it's installed,
-the command will delete the package.
-
-Optional argument NOQUERY non-nil means do not ask the user to
-confirm the installations/deletions; this is always nil in interactive
-invocations."
- (interactive nil package-menu-mode)
- (package--ensure-package-menu-mode)
- (let (install-list delete-list cmd pkg-desc)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (setq cmd (char-after))
- (unless (eq cmd ?\s)
- ;; This is the key PKG-DESC.
- (setq pkg-desc (tabulated-list-get-id))
- (cond ((eq cmd ?D)
- (push pkg-desc delete-list))
- ((eq cmd ?I)
- (push pkg-desc install-list))))
- (forward-line)))
- ;; Nothing marked.
- (unless (or delete-list install-list)
- ;; Not on a package line.
- (unless (and (tabulated-list-get-id)
- package-menu-use-current-if-no-marks)
- (user-error "No operations specified"))
- (let* ((id (tabulated-list-get-id))
- (status (package-menu-get-status)))
- (cond
- ((member status '("installed"))
- (push id delete-list))
- ((member status '("available" "avail-obso" "new" "dependency"))
- (push id install-list))
- (t (user-error "No default action available for status: %s"
- status)))))
- (let-alist (package-menu--partition-transaction install-list delete-list)
- (when (or noquery
- (package-menu--prompt-transaction-p .delete .install .upgrade))
- (let ((message-template
- (concat "[ "
- (when .delete
- (format "Delete %d " (length .delete)))
- (when .install
- (format "Install %d " (length .install)))
- (when .upgrade
- (format "Upgrade %d " (length .upgrade)))
- "]")))
- (message "Operation %s started" message-template)
- ;; Packages being upgraded are not marked as selected.
- (package--update-selected-packages .install .delete)
- (unless (package-menu--perform-transaction install-list delete-list)
- ;; If there weren't errors, output data.
- (if-let* ((removable (package--removable-packages)))
- (message "Operation finished. Packages that are no longer needed: %d. Type `%s' to remove them"
- (length removable)
- (substitute-command-keys "\\[package-autoremove]"))
- (message "Operation %s finished" message-template))))))))
-
-(defun package-menu--version-predicate (A B)
- "Predicate to sort \"*Packages*\" buffer by the version column.
-This is used for `tabulated-list-format' in `package-menu-mode'."
- (let ((vA (or (ignore-error error (version-to-list (aref (cadr A) 1))) '(0)))
- (vB (or (ignore-error error (version-to-list (aref (cadr B) 1))) '(0))))
- (if (version-list-= vA vB)
- (package-menu--name-predicate A B)
- (version-list-< vA vB))))
-
-(defun package-menu--status-predicate (A B)
- "Predicate to sort \"*Packages*\" buffer by the status column.
-This is used for `tabulated-list-format' in `package-menu-mode'."
- (let ((sA (aref (cadr A) 2))
- (sB (aref (cadr B) 2)))
- (cond ((string= sA sB)
- (package-menu--name-predicate A B))
- ((string= sA "new") t)
- ((string= sB "new") nil)
- ((string-prefix-p "avail" sA)
- (if (string-prefix-p "avail" sB)
- (package-menu--name-predicate A B)
- t))
- ((string-prefix-p "avail" sB) nil)
- ((string= sA "installed") t)
- ((string= sB "installed") nil)
- ((string= sA "dependency") t)
- ((string= sB "dependency") nil)
- ((string= sA "source") t)
- ((string= sB "source") nil)
- ((string= sA "unsigned") t)
- ((string= sB "unsigned") nil)
- ((string= sA "held") t)
- ((string= sB "held") nil)
- ((string= sA "external") t)
- ((string= sB "external") nil)
- ((string= sA "built-in") t)
- ((string= sB "built-in") nil)
- ((string= sA "obsolete") t)
- ((string= sB "obsolete") nil)
- ((string= sA "incompat") t)
- ((string= sB "incompat") nil)
- (t (string< sA sB)))))
-
-(defun package-menu--description-predicate (A B)
- "Predicate to sort \"*Packages*\" buffer by the description column.
-This is used for `tabulated-list-format' in `package-menu-mode'."
- (let ((dA (aref (cadr A) (if (cdr package-archives) 4 3)))
- (dB (aref (cadr B) (if (cdr package-archives) 4 3))))
- (if (string= dA dB)
- (package-menu--name-predicate A B)
- (string< dA dB))))
-
-(defun package-menu--name-predicate (A B)
- "Predicate to sort \"*Packages*\" buffer by the name column.
-This is used for `tabulated-list-format' in `package-menu-mode'."
- (string< (symbol-name (package-desc-name (car A)))
- (symbol-name (package-desc-name (car B)))))
-
-(defun package-menu--archive-predicate (A B)
- "Predicate to sort \"*Packages*\" buffer by the archive column.
-This is used for `tabulated-list-format' in `package-menu-mode'."
- (let ((a (or (package-desc-archive (car A)) ""))
- (b (or (package-desc-archive (car B)) "")))
- (if (string= a b)
- (package-menu--name-predicate A B)
- (string< a b))))
-
-(defun package-menu--populate-new-package-list ()
- "Decide which packages are new in `package-archive-contents'.
-Store this list in `package-menu--new-package-list'."
- ;; Find which packages are new.
- (when package-menu--old-archive-contents
- (dolist (elt package-archive-contents)
- (unless (assq (car elt) package-menu--old-archive-contents)
- (push (car elt) package-menu--new-package-list)))
- (setq package-menu--old-archive-contents nil)))
-
-(defun package-menu--find-and-notify-upgrades ()
- "Notify the user of upgradable packages."
- (when-let* ((upgrades (package-menu--find-upgrades)))
- (message "Packages that can be upgraded: %d; type `%s' to mark for upgrading."
- (length upgrades)
- (substitute-command-keys "\\[package-menu-mark-upgrades]"))))
-
-
-(defun package-menu--post-refresh ()
- "Revert \"*Packages*\" buffer and check for new packages and upgrades.
-Do nothing if there's no *Packages* buffer.
-
-This function is called after `package-refresh-contents' and it
-is added to `post-command-hook' by any function which alters the
-package database (`package-install' and `package-delete'). When
-run, it removes itself from `post-command-hook'."
- (remove-hook 'post-command-hook #'package-menu--post-refresh)
- (let ((buf (get-buffer "*Packages*")))
- (when (buffer-live-p buf)
- (with-current-buffer buf
- (package-menu--populate-new-package-list)
- (run-hooks 'tabulated-list-revert-hook)
- (tabulated-list-print 'remember 'update)))))
-
-(defun package-menu--mark-or-notify-upgrades ()
- "If there's a *Packages* buffer, check for upgrades and possibly mark them.
-Do nothing if there's no *Packages* buffer. If there are
-upgrades, mark them if `package-menu--mark-upgrades-pending' is
-non-nil, otherwise just notify the user that there are upgrades.
-This function is called after `package-refresh-contents'."
- (let ((buf (get-buffer "*Packages*")))
- (when (buffer-live-p buf)
- (with-current-buffer buf
- (if package-menu--mark-upgrades-pending
- (package-menu--mark-upgrades-1)
- (package-menu--find-and-notify-upgrades))))))
-
-;;;###autoload
-(defun list-packages (&optional no-fetch)
- "Display a list of packages.
-This first fetches the updated list of packages before
-displaying, unless a prefix argument NO-FETCH is specified.
-The list is displayed in a buffer named `*Packages*', and
-includes the package's version, availability status, and a
-short description."
- (interactive "P")
- (require 'finder-inf nil t)
- ;; Initialize the package system if necessary.
- (unless package--initialized
- (package-initialize t))
- ;; Integrate the package-menu with updating the archives.
- (add-hook 'package--post-download-archives-hook
- #'package-menu--post-refresh)
- (add-hook 'package--post-download-archives-hook
- #'package-menu--mark-or-notify-upgrades 'append)
-
- ;; Generate the Package Menu.
- (let ((buf (get-buffer-create "*Packages*")))
- (with-current-buffer buf
- ;; Since some packages have their descriptions include non-ASCII
- ;; characters...
- (setq buffer-file-coding-system 'utf-8)
- (package-menu-mode)
-
- ;; Fetch the remote list of packages.
- (unless no-fetch (package-menu--refresh-contents))
-
- ;; If we're not async, this would be redundant.
- (when package-menu-async
- (package-menu--generate nil t)))
- ;; The package menu buffer has keybindings. If the user types
- ;; `M-x list-packages', that suggests it should become current.
- (pop-to-buffer-same-window buf)))
-
-;;;###autoload
-(defalias 'package-list-packages 'list-packages)
-
-;; Used in finder.el
-(defun package-show-package-list (&optional packages keywords)
- "Display PACKAGES in a *Packages* buffer.
-This is similar to `list-packages', but it does not fetch the
-updated list of packages, and it only displays packages with
-names in PACKAGES (which should be a list of symbols).
-
-When KEYWORDS are given, only packages with those KEYWORDS are
-shown."
- (interactive)
- (require 'finder-inf nil t)
- (let* ((buf (get-buffer-create "*Packages*"))
- (win (get-buffer-window buf)))
- (with-current-buffer buf
- (package-menu-mode)
- (package-menu--generate nil packages keywords))
- (if win
- (select-window win)
- (switch-to-buffer buf))))
-
-(defun package-menu--filter-by (predicate suffix)
- "Filter \"*Packages*\" buffer by PREDICATE and add SUFFIX to header.
-PREDICATE is a function which will be called with one argument, a
-`package-desc' object, and returns t if that object should be
-listed in the Package Menu.
-
-SUFFIX is passed on to `package-menu--display' and is added to
-the header line of the first column."
- ;; Update `tabulated-list-entries' so that it contains all
- ;; packages before searching.
- (package-menu--refresh t nil)
- (let (found-entries)
- (dolist (entry tabulated-list-entries)
- (when (funcall predicate (car entry))
- (push entry found-entries)))
- (if found-entries
- (progn
- (setq tabulated-list-entries found-entries)
- (package-menu--display t suffix))
- (user-error "No packages found"))))
-
-(defun package-menu-filter-by-archive (archive)
- "Filter the \"*Packages*\" buffer by ARCHIVE.
-Display only packages from package archive ARCHIVE.
-ARCHIVE can be the name of a single archive (a string), or
-a list of archive names. If ARCHIVE is nil or an empty
-string, show all packages.
-
-When called interactively, prompt for ARCHIVE. To specify
-several archives, type their names separated by commas."
- (interactive (list (completing-read-multiple
- "Filter by archive (comma separated): "
- (mapcar #'car package-archives)))
- package-menu-mode)
- (package--ensure-package-menu-mode)
- (let ((archives (ensure-list archive)))
- (package-menu--filter-by
- (lambda (pkg-desc)
- (let ((pkg-archive (package-desc-archive pkg-desc)))
- (or (null archives)
- (and pkg-archive
- (member pkg-archive archives)))))
- (concat "archive:" (string-join archives ",")))))
-
-(defun package-menu-filter-by-description (description)
- "Filter the \"*Packages*\" buffer by the regexp DESCRIPTION.
-Display only packages whose description matches the regexp
-given as DESCRIPTION.
-
-When called interactively, prompt for DESCRIPTION.
-
-If DESCRIPTION is nil or the empty string, show all packages."
- (interactive (list (read-regexp "Filter by description (regexp)"))
- package-menu-mode)
- (package--ensure-package-menu-mode)
- (if (or (not description) (string-empty-p description))
- (package-menu--generate t t)
- (package-menu--filter-by (lambda (pkg-desc)
- (string-match description
- (package-desc-summary pkg-desc)))
- (format "desc:%s" description))))
-
-(defun package-menu-filter-by-keyword (keyword)
- "Filter the \"*Packages*\" buffer by KEYWORD.
-Display only packages whose keywords match the specified KEYWORD.
-KEYWORD can be a string or a list of strings. If KEYWORD is nil
-or the empty string, show all packages.
-
-In addition to package keywords, KEYWORD can include the name(s)
-of archive(s) and the package status, such as \"available\"
-or \"built-in\" or \"obsolete\".
-
-When called interactively, prompt for KEYWORD. To specify several
-keywords, type them separated by commas."
- (interactive (list (completing-read-multiple
- "Keywords (comma separated): "
- (package-all-keywords)))
- package-menu-mode)
- (package--ensure-package-menu-mode)
- (when (stringp keyword)
- (setq keyword (list keyword)))
- (if (not keyword)
- (package-menu--generate t t)
- (package-menu--filter-by (lambda (pkg-desc)
- (package--has-keyword-p pkg-desc keyword))
- (concat "keyword:" (string-join keyword ",")))))
-
-(define-obsolete-function-alias
- 'package-menu-filter #'package-menu-filter-by-keyword "27.1")
-
-(defun package-menu-filter-by-name-or-description (name-or-description)
- "Filter the \"*Packages*\" buffer by the regexp NAME-OR-DESCRIPTION.
-Display only packages whose name or description matches the regexp
-NAME-OR-DESCRIPTION.
-
-When called interactively, prompt for NAME-OR-DESCRIPTION.
-
-If NAME-OR-DESCRIPTION is nil or the empty string, show all
-packages."
- (interactive (list (read-regexp "Filter by name or description (regexp)"))
- package-menu-mode)
- (package--ensure-package-menu-mode)
- (if (or (not name-or-description) (string-empty-p name-or-description))
- (package-menu--generate t t)
- (package-menu--filter-by (lambda (pkg-desc)
- (or (string-match name-or-description
- (package-desc-summary pkg-desc))
- (string-match name-or-description
- (symbol-name
- (package-desc-name pkg-desc)))))
- (format "name-or-desc:%s" name-or-description))))
-
-(defun package-menu-filter-by-name (name)
- "Filter the \"*Packages*\" buffer by the regexp NAME.
-Display only packages whose name matches the regexp NAME.
-
-When called interactively, prompt for NAME.
-
-If NAME is nil or the empty string, show all packages."
- (interactive (list (read-regexp "Filter by name (regexp)"))
- package-menu-mode)
- (package--ensure-package-menu-mode)
- (if (or (not name) (string-empty-p name))
- (package-menu--generate t t)
- (package-menu--filter-by (lambda (pkg-desc)
- (string-match-p name (symbol-name
- (package-desc-name pkg-desc))))
- (format "name:%s" name))))
-
-(defun package-menu-filter-by-status (status)
- "Filter the \"*Packages*\" buffer by STATUS.
-Display only packages with specified STATUS.
-STATUS can be a single status, a string, or a list of strings.
-If STATUS is nil or the empty string, show all packages.
-
-When called interactively, prompt for STATUS. To specify
-several possible status values, type them separated by commas."
- (interactive (list (completing-read "Filter by status: "
- '("avail-obso"
- "available"
- "built-in"
- "dependency"
- "disabled"
- "external"
- "held"
- "incompat"
- "installed"
- "source"
- "new"
- "unsigned")))
- package-menu-mode)
- (package--ensure-package-menu-mode)
- (if (or (not status) (string-empty-p status))
- (package-menu--generate t t)
- (let ((status-list
- (if (listp status)
- status
- (split-string status ","))))
- (package-menu--filter-by
- (lambda (pkg-desc)
- (member (package-desc-status pkg-desc) status-list))
- (format "status:%s" (string-join status-list ","))))))
-
-(defun package-menu-filter-by-version (version predicate)
- "Filter the \"*Packages*\" buffer by VERSION and PREDICATE.
-Display only packages whose version satisfies the condition
-defined by VERSION and PREDICATE.
-
-When called interactively, prompt for one of the comparison operators
-`<', `>' or `=', and for a version. Show only packages whose version
-is lower (`<'), equal (`=') or higher (`>') than the specified VERSION.
-
-When called from Lisp, VERSION should be a version string and
-PREDICATE should be the symbol `=', `<' or `>'.
-
-If VERSION is nil or the empty string, show all packages."
- (interactive (let ((choice (intern
- (char-to-string
- (read-char-choice
- "Filter by version? [Type =, <, > or q] "
- '(?< ?> ?= ?q))))))
- (if (eq choice 'q)
- '(quit nil)
- (list (read-from-minibuffer
- (concat "Filter by version ("
- (pcase choice
- ('= "= equal to")
- ('< "< less than")
- ('> "> greater than"))
- "): "))
- choice)))
- package-menu-mode)
- (package--ensure-package-menu-mode)
- (unless (equal predicate 'quit)
- (if (or (not version) (string-empty-p version))
- (package-menu--generate t t)
- (package-menu--filter-by
- (let ((fun (pcase predicate
- ('= #'version-list-=)
- ('< #'version-list-<)
- ('> (lambda (a b) (not (version-list-<= a b))))
- (_ (error "Unknown predicate: %s" predicate))))
- (ver (version-to-list version)))
- (lambda (pkg-desc)
- (funcall fun (package-desc-version pkg-desc) ver)))
- (format "versions:%s%s" predicate version)))))
-
-(defun package-menu-filter-marked ()
- "Filter \"*Packages*\" buffer by non-empty mark.
-Show only the packages that have been marked for installation or deletion.
-Unlike other filters, this leaves the marks intact."
- (interactive nil package-menu-mode)
- (package--ensure-package-menu-mode)
- (widen)
- (let (found-entries mark pkg-id entry marks)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (setq mark (char-after))
- (unless (eq mark ?\s)
- (setq pkg-id (tabulated-list-get-id))
- (setq entry (package-menu--print-info-simple pkg-id))
- (push entry found-entries)
- ;; remember the mark
- (push (cons pkg-id mark) marks))
- (forward-line))
- (if found-entries
- (progn
- (setq tabulated-list-entries found-entries)
- (package-menu--display t nil)
- ;; redo the marks, but we must remember the marks!!
- (goto-char (point-min))
- (while (not (eobp))
- (setq mark (cdr (assq (tabulated-list-get-id) marks)))
- (tabulated-list-put-tag (char-to-string mark) t)))
- (user-error "No packages found")))))
-
-(defun package-menu-filter-upgradable ()
- "Filter \"*Packages*\" buffer to show only upgradable packages."
- (interactive nil package-menu-mode)
- (let ((pkgs (mapcar #'car (package-menu--find-upgrades))))
- (package-menu--filter-by
- (lambda (pkg)
- (memql (package-desc-name pkg) pkgs))
- "upgradable")))
-
-(defun package-menu-clear-filter ()
- "Clear any filter currently applied to the \"*Packages*\" buffer."
- (interactive nil package-menu-mode)
- (package--ensure-package-menu-mode)
- (package-menu--generate t t))
-
-(defun package-list-packages-no-fetch ()
- "Display a list of packages.
-Does not fetch the updated list of packages before displaying.
-The list is displayed in a buffer named `*Packages*'."
- (interactive)
- (list-packages t))
-
-;;;###autoload
-(defun package-get-version ()
- "Return the version number of the package in which this is used.
-Assumes it is used from an Elisp file placed inside the top-level directory
-of an installed ELPA package.
-The return value is a string (or nil in case we can't find it).
-It works in more cases if the call is in the file which contains
-the `Version:' header."
- ;; In a sense, this is a lie, but it does just what we want: precompute
- ;; the version at compile time and hardcodes it into the .elc file!
- (declare (pure t))
- ;; Hack alert!
- (let ((file (or (macroexp-file-name) buffer-file-name)))
- (cond
- ((null file) nil)
- ;; Packages are normally installed into directories named "<pkg>-<vers>",
- ;; so get the version number from there.
- ((string-match "/[^/]+-\\([0-9]\\(?:[0-9.]\\|pre\\|beta\\|alpha\\|snapshot\\)+\\)/[^/]+\\'" file)
- (match-string 1 file))
- ;; For packages run straight from the an elpa.git clone, there's no
- ;; "-<vers>" in the directory name, so we have to fetch the version
- ;; the hard way.
- (t
- (let* ((pkgdir (file-name-directory file))
- (pkgname (file-name-nondirectory (directory-file-name pkgdir)))
- (mainfile (expand-file-name (concat pkgname ".el") pkgdir)))
- (unless (file-readable-p mainfile) (setq mainfile file))
- (when (file-readable-p mainfile)
- (require 'lisp-mnt)
- (lm-package-version mainfile)))))))
-
-\f
-;;;; Quickstart: precompute activation actions for faster start up.
-
-;; Activating packages via `package-initialize' is costly: for N installed
-;; packages, it needs to read all N <pkg>-pkg.el files first to decide
-;; which packages to activate, and then again N <pkg>-autoloads.el files.
-;; To speed this up, we precompute a mega-autoloads file which is the
-;; concatenation of all those <pkg>-autoloads.el, so we can activate
-;; all packages by loading this one file (and hence without initializing
-;; package.el).
-
-;; Other than speeding things up, this also offers a bootstrap feature:
-;; it lets us activate packages according to `package-load-list' and
-;; `package-user-dir' even before those vars are set.
-
-(defcustom package-quickstart nil
- "Precompute activation actions to speed up startup.
-This requires the use of `package-quickstart-refresh' every time the
-activations need to be changed, such as when `package-load-list' is modified."
- :type 'boolean
- :version "27.1")
-
-;;;###autoload
-(defcustom package-quickstart-file
- (locate-user-emacs-file "package-quickstart.el")
- "Location of the file used to speed up activation of packages at startup."
- :type 'file
- :group 'applications
- :initialize #'custom-initialize-delay
- :version "27.1")
-
-(defun package--quickstart-maybe-refresh ()
- (if package-quickstart
- ;; FIXME: Delay refresh in case we're installing/deleting
- ;; several packages!
- (package-quickstart-refresh)
- (delete-file (concat package-quickstart-file "c"))
- (delete-file package-quickstart-file)))
-
-(defun package-quickstart-refresh ()
- "(Re)Generate the `package-quickstart-file'."
- (interactive)
- (package-initialize 'no-activate)
- (require 'info)
- (let ((package--quickstart-pkgs ())
- ;; Pretend we haven't activated anything yet!
- (package-activated-list ())
- ;; Make sure we can load this file without load-source-file-function.
- (coding-system-for-write 'emacs-internal)
- ;; Ensure that `pp' and `prin1-to-string' calls further down
- ;; aren't truncated.
- (print-length nil)
- (print-level nil)
- (Info-directory-list '("")))
- (dolist (elt package-alist)
- (condition-case err
- (package-activate (car elt))
- ;; Don't let failure of activation of a package arbitrarily stop
- ;; activation of further packages.
- (error (message "%s" (error-message-string err)))))
- (setq package--quickstart-pkgs (nreverse package--quickstart-pkgs))
- (with-temp-file package-quickstart-file
- (emacs-lisp-mode) ;For `syntax-ppss'.
- (insert ";;; Quickstart file to activate all packages at startup -*- lexical-binding:t -*-\n")
- (insert ";; ¡¡ This file is autogenerated by `package-quickstart-refresh', DO NOT EDIT !!\n\n")
- (dolist (pkg package--quickstart-pkgs)
- (let* ((file
- ;; Prefer uncompiled files (and don't accept .so files).
- (let ((load-suffixes '(".el" ".elc")))
- (locate-library (package--autoloads-file-name pkg))))
- (pfile (prin1-to-string file)))
- (insert "(let* ((load-file-name " pfile ")\
-\(load-true-file-name load-file-name))\n")
- (insert-file-contents file)
- ;; Fixup the special #$ reader form and throw away comments.
- (while (re-search-forward "#\\$\\|^;\\(.*\n\\)" nil 'move)
- (unless (ppss-string-terminator (save-match-data (syntax-ppss)))
- (replace-match (if (match-end 1) "" pfile) t t)))
- (unless (bolp) (insert "\n"))
- (insert ")\n")))
- (pp `(defvar package-activated-list) (current-buffer))
- (pp `(setq package-activated-list
- (delete-dups
- (append ',(mapcar #'package-desc-name package--quickstart-pkgs)
- package-activated-list)))
- (current-buffer))
- (let ((info-dirs (butlast Info-directory-list)))
- (when info-dirs
- (pp `(progn (require 'info)
- (info-initialize)
- (setq Info-directory-list
- (append ',info-dirs Info-directory-list)))
- (current-buffer))))
- ;; Use `\s' instead of a space character, so this code chunk is not
- ;; mistaken for an actual file-local section of package.el.
- (insert "\f
-;; Local\sVariables:
-;; version-control: never
-;; no-update-autoloads: t
-;; byte-compile-warnings: (not make-local)
-;; End:
-"))
- ;; FIXME: Do it asynchronously in an Emacs subprocess, and
- ;; don't show the byte-compiler warnings.
- (byte-compile-file package-quickstart-file)))
-
-(defun package--imenu-prev-index-position-function ()
- "Move point to previous line in package-menu buffer.
-This function is used as a value for
-`imenu-prev-index-position-function'."
- (unless (bobp)
- (forward-line -1)))
-
-(defun package--imenu-extract-index-name-function ()
- "Return imenu name for line at point.
-This function is used as a value for
-`imenu-extract-index-name-function'. Point should be at the
-beginning of the line."
- (let ((package-desc (tabulated-list-get-id)))
- (format "%s (%s): %s"
- (package-desc-name package-desc)
- (package-version-join (package-desc-version package-desc))
- (package-desc-summary package-desc))))
-
-(defun package--query-desc (&optional alist)
- "Query the user for a package or return the package at point.
-The optional argument ALIST must consist of elements with the
-form (PKG-NAME PKG-DESC). If not specified, it will default to
-`package-alist'."
- (or (tabulated-list-get-id)
- (let ((alist (or alist package-alist)))
- (cadr (assoc (completing-read "Package: " alist nil t)
- alist #'string=)))))
-
-(defun package-browse-url (desc &optional secondary)
- "Open the website of the package under point in a browser.
-`browse-url' is used to determine the browser to be used. If
-SECONDARY (interactively, the prefix), use the secondary browser.
-DESC must be a `package-desc' object."
- (interactive (list (package--query-desc)
- current-prefix-arg)
- package-menu-mode)
- (unless desc
- (user-error "No package here"))
- (let ((url (cdr (assoc :url (package-desc-extras desc)))))
- (unless url
- (user-error "No website for %s" (package-desc-name desc)))
- (if secondary
- (funcall browse-url-secondary-browser-function url)
- (browse-url url))))
-
-(declare-function ietf-drums-parse-address "ietf-drums"
- (string &optional decode))
-
-(defun package-maintainers (pkg-desc &optional no-error)
- "Return an email address for the maintainers of PKG-DESC.
-The email address may contain commas, if there are multiple
-maintainers. If no maintainers are found, an error will be
-signaled. If the optional argument NO-ERROR is non-nil no error
-will be signaled in that case."
- (unless (package-desc-p pkg-desc)
- (error "Invalid package description: %S" pkg-desc))
- (let* ((name (package-desc-name pkg-desc))
- (extras (package-desc-extras pkg-desc))
- (maint (alist-get :maintainer extras)))
- (unless (listp (cdr maint))
- (setq maint (list maint)))
- (cond
- ((and (null maint) (null no-error))
- (user-error "Package `%s' has no explicit maintainer" name))
- ((and (not (progn
- (require 'ietf-drums)
- (ietf-drums-parse-address (cdar maint))))
- (null no-error))
- (user-error "Package `%s' has no maintainer address" name))
- (t
- (with-temp-buffer
- (mapc #'package--print-email-button maint)
- (replace-regexp-in-string
- "\n" ", " (string-trim
- (buffer-substring-no-properties
- (point-min) (point-max)))))))))
-
-;;;###autoload
-(defun package-report-bug (desc)
- "Prepare a message to send to the maintainers of a package.
-DESC must be a `package-desc' object."
- (interactive (list (package--query-desc package-alist))
- package-menu-mode)
- (let ((maint (package-maintainers desc))
- (name (symbol-name (package-desc-name desc)))
- (pkgdir (package-desc-dir desc))
- vars)
- (when pkgdir
- (dolist-with-progress-reporter (group custom-current-group-alist)
- "Scanning for modified user options..."
- (when (and (car group)
- (file-in-directory-p (car group) pkgdir))
- (dolist (ent (get (cdr group) 'custom-group))
- (when (and (custom-variable-p (car ent))
- (boundp (car ent))
- (not (eq (custom--standard-value (car ent))
- (default-toplevel-value (car ent)))))
- (push (car ent) vars))))))
- (dlet ((reporter-prompt-for-summary-p t))
- (reporter-submit-bug-report maint name vars))))
-
-;;;; Introspection
-
-(defun package-get-descriptor (pkg-name)
- "Return the `package-desc' of PKG-NAME."
- (unless package--initialized (package-initialize 'no-activate))
- (or (package--get-activatable-pkg pkg-name)
- (cadr (assq pkg-name package-alist))
- (cadr (assq pkg-name package-archive-contents))))
-
-(provide 'package)
-
-;;; package.el ends here
+++ /dev/null
-;;; finder.el --- topic & keyword-based code finder -*- lexical-binding: t -*-
-
-;; Copyright (C) 1992-2025 Free Software Foundation, Inc.
-
-;; Author: Eric S. Raymond <esr@thyrsus.com>
-;; Created: 16 Jun 1992
-;; Keywords: help
-
-;; 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 mode uses the Keywords library header to provide code-finding
-;; services by keyword.
-
-;;; Code:
-
-(require 'package)
-(require 'lisp-mnt)
-(require 'find-func) ;for find-library(-suffixes)
-(require 'finder-inf nil t)
-
-;; These are supposed to correspond to top-level customization groups,
-;; says rms.
-(defvar finder-known-keywords
- '((abbrev . "abbreviation handling, typing shortcuts, and macros")
- (bib . "bibliography processors")
- (c . "C and related programming languages")
- (calendar . "calendar and time management tools")
- (comm . "communications, networking, and remote file access")
- (convenience . "convenience features for faster editing")
- (data . "editing data (non-text) files")
- (docs . "Emacs documentation facilities")
- (emulations . "emulations of other editors")
- (extensions . "Emacs Lisp language extensions")
- (faces . "fonts and colors for text")
- (files . "file editing and manipulation")
- (frames . "Emacs frames and window systems")
- (games . "games, jokes and amusements")
- (hardware . "interfacing with system hardware")
- (help . "Emacs help systems")
- (hypermedia . "links between text or other media types")
- (i18n . "internationalization and character-set support")
- (internal . "code for Emacs internals, build process, defaults")
- (languages . "specialized modes for editing programming languages")
- (lisp . "Lisp support, including Emacs Lisp")
- (local . "code local to your site")
- (maint . "Emacs development tools and aids")
- (mail . "email reading and posting")
- (matching . "searching, matching, and sorting")
- (mouse . "mouse support")
- (multimedia . "images and sound")
- (news . "USENET news reading and posting")
- (outlines . "hierarchical outlining and note taking")
- (processes . "processes, subshells, and compilation")
- (terminals . "text terminals (ttys)")
- (tex . "the TeX document formatter")
- (text . "editing text files")
- (tools . "programming tools")
- (unix . "UNIX feature interfaces and emulators")
- (vc . "version control"))
- "Association list of the standard \"Keywords:\" headers.
-Each element has the form (KEYWORD . DESCRIPTION).")
-
-(defvar-keymap finder-mode-map
- :doc "Keymap used in `finder-mode'."
- :parent special-mode-map
- "SPC" #'finder-select
- "f" #'finder-select
- "<follow-link>" 'mouse-face
- "<mouse-2>" #'finder-mouse-select
- "C-m" #'finder-select
- "?" #'finder-summary
- "n" #'next-line
- "p" #'previous-line
- "q" #'finder-exit
- "d" #'finder-list-keywords)
-
-(easy-menu-define finder-mode-menu finder-mode-map
- "Menu for `finder-mode'."
- '("Finder"
- ["Select" finder-select
- :help "Select item on current line in a finder buffer"]
- ["List keywords" finder-list-keywords
- :help "Display descriptions of the keywords in the Finder buffer"]
- ["Summary" finder-summary
- :help "Summary item on current line in a finder buffer"]
- ["Quit" finder-exit
- :help "Exit Finder mode"]))
-
-(defvar finder-mode-syntax-table
- (let ((st (make-syntax-table emacs-lisp-mode-syntax-table)))
- (modify-syntax-entry ?\; ". " st)
- st)
- "Syntax table used while in `finder-mode'.")
-
-(defvar finder-headmark nil
- "Internal Finder mode variable, local in Finder buffer.")
-
-;;; Code for regenerating the keyword list.
-
-(defvar finder-keywords-hash nil
- "Hash table mapping keywords to lists of package names.
-Keywords and package names both should be symbols.")
-
-(defvar generated-finder-keywords-file "finder-inf.el"
- "The function `finder-compile-keywords' writes keywords into this file.")
-
-;; Skip autogenerated files, because they will never contain anything
-;; useful, and because in parallel builds of Emacs they may get
-;; modified while we are trying to read them.
-;; https://lists.gnu.org/r/emacs-pretest-bug/2007-01/msg00469.html
-;; ldefs-boot is not auto-generated, but has nothing useful.
-(defvar finder-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|ldefs-boot\\|\
-cus-load\\|finder-inf\\|esh-groups\\|subdirs\\|leim-list\\)\\.el$\\)"
- "Regexp matching file names not to scan for keywords.")
-
-(defconst finder--builtins-descriptions
- ;; I have no idea whether these are supposed to be capitalized
- ;; and/or end in a full-stop. Existing file headers are inconsistent,
- ;; but mainly seem to not do so.
- '((emacs . "the extensible text editor")
- (nxml . "a new XML mode"))
- "Alist of built-in package descriptions.
-Entries have the form (PACKAGE-SYMBOL . DESCRIPTION).
-When generating `package--builtins', this overrides what the description
-would otherwise be.")
-
-(defvar finder--builtins-alist
- '(("calc" . calc)
- ("erc" . erc)
- ("eshell" . eshell)
- ("gnus" . gnus)
- ("international" . emacs)
- ("language" . emacs)
- ("leim" . emacs)
- ("ja-dic" . emacs)
- ("quail" . emacs)
- ("obsolete" . emacs)
- ;; This should really be ("nxml" . nxml-mode), because nxml-mode.el
- ;; is the main file for the package. Then we would not need an
- ;; entry in finder--builtins-descriptions. But I do not know if
- ;; it is safe to change this, in case it is already in use.
- ("nxml" . nxml)
- ("org" . org)
- ("term" . emacs)
- ("use-package" . use-package)
- ("url" . url))
- "Alist of built-in package directories.
-Each element should have the form (DIR . PACKAGE), where DIR is a
-directory name and PACKAGE is the name of a package (a symbol).
-When generating `package--builtins', Emacs assumes any file in
-DIR is part of the package PACKAGE.")
-
-(defconst finder-buffer "*Finder*"
- "Name of the Finder buffer.")
-
-(defun finder-compile-keywords (&rest dirs)
- "Regenerate list of built-in Emacs packages.
-This recomputes `package--builtins' and `finder-keywords-hash',
-and prints them into the file `generated-finder-keywords-file'.
-
-Optional DIRS is a list of Emacs Lisp directories to compile
-from; the default is `load-path'."
- ;; Allow compressed files also.
- (setq package--builtins nil)
- (setq finder-keywords-hash (make-hash-table :test 'eq))
- (let* ((el-file-regexp "\\`\\([^=].*\\)\\.el\\(\\.\\(gz\\|Z\\)\\)?\\'")
- (file-count 0)
- (files (cl-loop for d in (or dirs load-path)
- when (file-exists-p (directory-file-name d))
- append (mapcar
- (lambda (f)
- (cons d f))
- (directory-files d nil el-file-regexp))))
- (progress (make-progress-reporter
- (byte-compile-info "Scanning files for finder")
- 0 (length files)))
- base-name summary keywords package version entry desc)
- (dolist (elem files)
- (let* ((d (car elem))
- (f (cdr elem))
- (package-override
- (intern-soft
- (cdr-safe
- (assoc (file-name-nondirectory
- (directory-file-name d))
- finder--builtins-alist)))))
- (progress-reporter-update progress (setq file-count (1+ file-count)))
- (unless (or (string-match finder-no-scan-regexp f)
- (null (setq base-name
- (and (string-match el-file-regexp f)
- (intern (match-string 1 f))))))
- ;; (memq base-name processed))
- ;; There are multiple files in the tree with the same
- ;; basename. So skipping files based on basename means you
- ;; randomly (depending on which order the files are
- ;; traversed in) miss some packages.
- ;; https://debbugs.gnu.org/14010
- ;; You might think this could lead to two files providing
- ;; the same package, but it does not, because the duplicates
- ;; are (at time of writing) all due to files in cedet, which
- ;; end up with package-override set. FIXME this is
- ;; obviously fragile. Make the (eq base-name package) case
- ;; below issue a warning if package-override is nil?
- ;; (push base-name processed)
- (with-temp-buffer
- (insert-file-contents (expand-file-name f d))
- (setq keywords (mapcar #'intern (lm-keywords-list))
- package (or package-override
- (let ((str (lm-header "package")))
- (if str (intern str)))
- base-name)
- summary (or (cdr
- (assq package finder--builtins-descriptions))
- (lm-synopsis))
- version (lm-header "version")))
- (when summary
- (setq version (or (ignore-errors (version-to-list version))
- (alist-get package package--builtin-versions)))
- (setq entry (assq package package--builtins))
- (cond ((null entry)
- (push (cons package
- (package-make-builtin version summary))
- package--builtins))
- ;; The idea here is that eg calc.el gets to define
- ;; the description of the calc package.
- ;; This does not work for eg nxml-mode.el.
- ((eq base-name package)
- (setq desc (cdr entry))
- (aset desc 0 version)
- (aset desc 2 summary)))
- (dolist (kw keywords)
- (puthash kw
- (cons package
- (delq package
- (gethash kw finder-keywords-hash)))
- finder-keywords-hash))))))
- (progress-reporter-done progress))
- (setq package--builtins
- (sort package--builtins
- (lambda (a b) (string< (symbol-name (car a))
- (symbol-name (car b))))))
-
- (with-current-buffer
- (find-file-noselect generated-finder-keywords-file)
- (setq buffer-undo-list t)
- (erase-buffer)
- (generate-lisp-file-heading
- generated-finder-keywords-file 'finder-compile-keywords
- :title "keyword-to-package mapping")
- ;; FIXME: Now that we have package--builtin-versions, package--builtins is
- ;; only needed to get the list of unversioned packages and to get the
- ;; summary description of each package.
- (insert "(setq package--builtins '(\n")
- (dolist (package package--builtins)
- (insert " ")
- (prin1 package (current-buffer))
- (insert "\n"))
- (insert "))\n\n")
- ;; Insert hash table.
- (insert "(setq finder-keywords-hash\n ")
- (prin1 finder-keywords-hash (current-buffer))
- (insert ")\n")
- (generate-lisp-file-trailer generated-finder-keywords-file)
- (basic-save-buffer)))
-
-(defun finder-compile-keywords-make-dist ()
- "Regenerate `finder-inf.el' for the Emacs distribution."
- (apply #'finder-compile-keywords command-line-args-left)
- (kill-emacs))
-
-;;; Now the retrieval code
-
-(defun finder-insert-at-column (column &rest strings)
- "Insert, at column COLUMN, other args STRINGS."
- (if (>= (current-column) column) (insert "\n"))
- (move-to-column column t)
- (apply #'insert strings))
-
-(defvar finder-help-echo nil)
-
-(defun finder-mouse-face-on-line ()
- "Put `mouse-face' and `help-echo' properties on the previous line."
- (save-excursion
- (forward-line -1)
- ;; If finder-insert-at-column moved us to a new line, go back one more.
- (if (looking-at "[ \t]") (forward-line -1))
- (unless finder-help-echo
- (setq finder-help-echo
- (let* ((keys1 (where-is-internal 'finder-select
- finder-mode-map))
- (keys (nconc (where-is-internal
- 'finder-mouse-select finder-mode-map)
- keys1)))
- (concat (mapconcat #'key-description keys ", ")
- ": select item"))))
- (add-text-properties
- (line-beginning-position) (line-end-position)
- '(mouse-face highlight
- help-echo finder-help-echo))))
-
-(defun finder-unknown-keywords ()
- "Return an alist of unknown keywords and number of their occurrences.
-Unknown keywords are those present in `finder-keywords-hash' but
-not `finder-known-keywords'."
- (let (alist)
- (maphash (lambda (kw packages)
- (unless (assq kw finder-known-keywords)
- (push (cons kw (length packages)) alist)))
- finder-keywords-hash)
- (sort alist (lambda (a b) (string< (car a) (car b))))))
-
-;;;###autoload
-(defun finder-list-keywords ()
- "Display descriptions of the keywords in the Finder buffer."
- (interactive)
- (if (get-buffer finder-buffer)
- (pop-to-buffer finder-buffer)
- (pop-to-buffer (get-buffer-create finder-buffer))
- (finder-mode)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (dolist (assoc finder-known-keywords)
- (let ((keyword (car assoc)))
- (insert (propertize (symbol-name keyword)
- 'font-lock-face 'font-lock-constant-face))
- (finder-insert-at-column 14 (concat (cdr assoc) "\n"))
- (finder-mouse-face-on-line)))
- (goto-char (point-min))
- (setq finder-headmark (point)
- buffer-read-only t)
- (set-buffer-modified-p nil)
- (balance-windows)
- (finder-summary))))
-
-(defun finder-list-matches (key)
- (let* ((id (intern key))
- (packages (gethash id finder-keywords-hash)))
- (unless packages
- (error "No packages matching key `%s'" key))
- (let ((package-list-unversioned t))
- (package-show-package-list packages))))
-
-;;;###autoload
-(defun finder-commentary (file)
- "Display FILE's commentary section.
-FILE should be in a form suitable for passing to `locate-library'."
- ;; FIXME: Merge this function into `describe-package', which is
- ;; strictly better as it has links to URLs and is in a proper help
- ;; buffer with navigation forward and backward, etc.
- (interactive
- (list
- (completing-read "Library name: "
- (apply-partially 'locate-file-completion-table
- (or find-library-source-path load-path)
- (find-library-suffixes)))))
- (let ((str (lm-commentary (find-library-name file))))
- (or str (error "Can't find any Commentary section"))
- ;; This used to use *Finder* but that would clobber the
- ;; directory of categories.
- (pop-to-buffer "*Finder-package*")
- (setq buffer-read-only nil
- buffer-undo-list t)
- (erase-buffer)
- (insert str)
- (goto-char (point-min))
- (package--describe-add-library-links)
- (goto-char (point-min))
- (setq buffer-read-only t)
- (set-buffer-modified-p nil)
- (shrink-window-if-larger-than-buffer)
- (finder-mode)
- (finder-summary)))
-
-(defun finder-current-item ()
- (let ((key (save-excursion
- (beginning-of-line)
- (current-word))))
- (if (or (and finder-headmark (< (point) finder-headmark))
- (zerop (length key)))
- (error "No keyword or filename on this line")
- key)))
-
-(defun finder-select ()
- "Select item on current line in a Finder buffer."
- (interactive nil finder-mode)
- (let ((key (finder-current-item)))
- (if (string-match "\\.el$" key)
- (finder-commentary key)
- (finder-list-matches key))))
-
-(defun finder-mouse-select (event)
- "Select item in a Finder buffer with the mouse."
- (interactive "e")
- (with-current-buffer (window-buffer (posn-window (event-start event)))
- (goto-char (posn-point (event-start event)))
- (finder-select)))
-
-;;;###autoload
-(defun finder-by-keyword ()
- "Find packages matching a given keyword."
- ;; FIXME: Why does this function exist? Should it just be an alias?
- (interactive)
- (finder-list-keywords))
-
-(define-derived-mode finder-mode special-mode "Finder"
- "Major mode for browsing package documentation.
-\\<finder-mode-map>
-\\[finder-select] more help for the item on the current line
-\\[finder-exit] exit Finder mode and kill the Finder buffer.
-
-\\{finder-mode-map}"
- :interactive nil
- (setq-local finder-headmark nil))
-
-(defun finder-summary ()
- "Summarize basic Finder commands."
- (interactive nil finder-mode)
- (message "%s"
- (substitute-command-keys
- "\\<finder-mode-map>\\[finder-select] select, \
-\\[finder-mouse-select] select, \\[finder-list-keywords] go to \
-finder directory, \\[finder-exit] quit, \\[finder-summary] help")))
-
-(defun finder-exit ()
- "Exit Finder mode.
-Quit the window and kill all Finder-related buffers."
- (interactive nil finder-mode)
- (quit-window t)
- (dolist (buf (list finder-buffer "*Finder-package*"))
- (and (get-buffer buf) (kill-buffer buf))))
-
-(defun finder-unload-function ()
- "Unload the Finder library."
- (with-demoted-errors "Error unloading finder: %S"
- (unload-feature 'finder-inf t))
- ;; continue standard unloading
- nil)
-
-(define-obsolete-function-alias 'finder-goto-xref
- #'package--finder-goto-xref "29.1")
-
-\f
-(provide 'finder)
-
-;;; finder.el ends here
(interactive (list (read-library-name "Describe library")))
(require 'find-func)
(require 'lisp-mnt)
+ (when (symbolp library) (setq library (symbol-name library)))
(let* ((file (find-library-name library))
(name (file-name-nondirectory file))
(help-buffer-under-preparation t))
(message "Unable to find location in file"))))
'help-echo "mouse-2, RET: find face's definition")
-(define-button-type 'help-package
- :supertype 'help-xref
- 'help-function 'describe-package
- 'help-echo "mouse-2, RET: Describe package")
-
(define-button-type 'help-package-def
:supertype 'help-xref
'help-function #'dired
"m" #'describe-mode
"o" #'describe-symbol
"n" #'view-emacs-news
- "p" #'finder-by-keyword
- "P" #'describe-package
"r" #'info-emacs-manual
"R" #'info-display-manual
"s" #'describe-syntax
(cons (lambda (s) (save-selected-window(info-apropos s))) "apropos"))
\f
-(add-to-list 'Info-virtual-files
- '("\\`\\*Finder.*\\*\\'"
- (find-file . Info-finder-find-file)
- (find-node . Info-finder-find-node)
- ))
-
-(defvar Info-finder-file "*Finder*"
- "Info file name of the virtual Info keyword finder manual.")
-
-(defun Info-finder-find-file (filename &optional _noerror)
- "Finder-specific implementation of `Info-find-file'."
- filename)
-
-(defvar finder-known-keywords)
-(declare-function find-library-name "find-func" (library))
-(declare-function finder-unknown-keywords "finder" ())
-(declare-function lm-commentary "lisp-mnt" (&optional file))
-(defvar finder-keywords-hash)
-(defvar package--builtins) ; finder requires package
-
-(defun info--prettify-description (desc)
- (if (stringp desc)
- (with-temp-buffer
- (insert (substitute-command-keys desc))
- (if (equal ?. (char-before))
- (delete-char -1))
- (goto-char (point-min))
- (or (let (case-fold-search) (looking-at-p "\\.\\|[[:upper:]]"))
- (capitalize-word 1))
- (buffer-string))
- desc))
-
-(defun Info-finder-find-node (_filename nodename &optional _no-going-back)
- "Finder-specific implementation of `Info-find-node-2'."
- (require 'finder)
- (cond
- ((equal nodename "Top")
- ;; Display Top menu with descriptions of the keywords
- (insert (format "\n\^_\nFile: %s, Node: %s, Up: (dir)\n\n"
- Info-finder-file nodename))
- (insert "Finder Keywords\n")
- (insert "***************\n\n")
- (insert "* Menu:\n\n")
- (dolist (assoc (append '((all . "All package info")
- (unknown . "Unknown keywords"))
- finder-known-keywords))
- (let ((keyword (car assoc)))
- (insert (format "* %s %s.\n"
- (concat (symbol-name keyword) ": "
- "Keyword " (symbol-name keyword) ".")
- (info--prettify-description (cdr assoc)))))))
- ((equal nodename "Keyword unknown")
- ;; Display unknown keywords
- (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
- Info-finder-file nodename))
- (insert "Finder Unknown Keywords\n")
- (insert "***********************\n\n")
- (insert "* Menu:\n\n")
- (mapc
- (lambda (assoc)
- (insert (format "* %-14s %s.\n"
- (concat (symbol-name (car assoc)) ": "
- "Keyword " (symbol-name (car assoc)) ".")
- (cdr assoc))))
- (finder-unknown-keywords)))
- ((equal nodename "Keyword all")
- ;; Display all package info.
- (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
- Info-finder-file nodename))
- (insert "Finder Package Info\n")
- (insert "*******************\n\n")
- (insert "* Menu:\n\n")
- (let (desc)
- (dolist (package package--builtins)
- (setq desc (cdr-safe package))
- (when (vectorp desc)
- (insert (format "* %-16s %s.\n"
- (concat (symbol-name (car package)) "::")
- (info--prettify-description (aref desc 2))))))))
- ((string-match "\\`Keyword " nodename)
- (setq nodename (substring nodename (match-end 0)))
- ;; Display packages that match the keyword
- ;; or the list of keywords separated by comma.
- (insert (format "\n\^_\nFile: %s, Node: Keyword %s, Up: Top\n\n"
- Info-finder-file nodename))
- (insert "Finder Packages\n")
- (insert "***************\n\n")
- (insert
- "The following packages match the keyword ‘" nodename "’:\n\n")
- (insert "* Menu:\n\n")
- (let ((keywords
- (mapcar #'intern (if (string-search "," nodename)
- (split-string nodename ",[ \t\n]*" t)
- (list nodename))))
- hits desc)
- (dolist (keyword keywords)
- (push (copy-tree (gethash keyword finder-keywords-hash)) hits))
- (setq hits (delete-dups (apply #'append hits))
- ;; Not a meaningful package.
- hits (delete 'emacs hits)
- hits (sort hits (lambda (a b) (string< (symbol-name a)
- (symbol-name b)))))
- (dolist (package hits)
- (setq desc (cdr-safe (assq package package--builtins)))
- (when (vectorp desc)
- (insert (format "* %-16s %s.\n"
- (concat (symbol-name package) "::")
- (info--prettify-description (aref desc 2))))))))
- (t
- ;; Display commentary section
- (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
- Info-finder-file nodename))
- (insert "Package Description\n")
- (insert "*******************\n\n")
- (insert
- "Description of the package ‘" nodename "’:\n\n")
- ;; This assumes that a file named package.el exists,
- ;; which is not always true. E.g. for the nxml package,
- ;; there is no "nxml.el" (it's nxml-mode.el).
- ;; But package.el makes the same assumption.
- ;; I think nxml is the only exception - maybe it should be just be renamed.
- (insert (or (ignore-errors (lm-commentary (find-library-name nodename)))
- "Can’t find package description.\n\n")))))
-;;;###autoload
-(defun info-finder (&optional keywords)
- "Display descriptions of the keywords in the Finder virtual manual.
-In interactive use, a prefix argument directs this command to read
-a list of keywords separated by comma. After that, it displays a node
-with a list of packages that contain all specified keywords."
- (interactive
- (when current-prefix-arg
- (require 'finder)
- (list
- (completing-read-multiple
- "Keywords (separated by comma): "
- (mapcar #'symbol-name (mapcar #'car (append finder-known-keywords
- (finder-unknown-keywords))))
- nil t))))
- (require 'finder)
- (if keywords
- (Info-find-node Info-finder-file (concat "Keyword " (mapconcat 'identity keywords ", ")))
- (Info-find-node Info-finder-file "Top")))
-
-\f
(defun Info-help ()
"Enter the Info tutorial."
(interactive)
(define-key menu [customize]
`(menu-item "Customize Emacs" ,menu-bar-custom-menu))
- (define-key menu [package]
- '(menu-item "Manage Emacs Packages" package-list-packages
- :help "Install or uninstall additional Emacs packages"))
-
(define-key menu [save]
'(menu-item "Save Options" menu-bar-options-save
:help "Save options set from the menu above"))
(define-key menu [describe-current-display-table]
'(menu-item "Describe Display Table" describe-current-display-table
:help "Describe the current display table"))
- (define-key menu [describe-package]
- '(menu-item "Describe Package..." describe-package
- :help "Display documentation of a Lisp package"))
(define-key menu [describe-face]
'(menu-item "Describe Face..." describe-face
:help "Display the properties of a face"))
(define-key menu [external-packages]
'(menu-item "Finding Extra Packages" view-external-packages
:help "How to get more Lisp packages for use in Emacs"))
- (define-key menu [find-emacs-packages]
- '(menu-item "Search Built-in Packages" finder-by-keyword
- :help "Find built-in packages and features by keyword"))
(define-key menu [more-manuals]
`(menu-item "More Manuals" ,menu-bar-manuals-menu))
(define-key menu [emacs-manual]
(eq (jsonrpc-process-type server)
'network))
(emacs-pid))
- :clientInfo
- (append
- '(:name "Eglot")
- (let ((v (and (featurep 'package)
- (package-get-version))))
- (and v (list :version v))))
+ :clientInfo '(:name "Eglot" :version "1.18")
;; Maybe turn trampy `/ssh:foo@bar:/path/to/baz.py'
;; into `/path/to/baz.py', so LSP groks it.
:rootPath (file-local-name
(defun so-long-commentary ()
"View the `so-long' library's documentation in `outline-mode'."
(interactive)
- (let ((buf "*So Long: Commentary*"))
- (when (buffer-live-p (get-buffer buf))
- (kill-buffer buf))
- ;; Use `finder-commentary' to generate the buffer.
- (require 'finder)
- (cl-letf (((symbol-function 'finder-summary) #'ignore))
- (finder-commentary "so-long"))
- (let ((inhibit-read-only t))
- (if (looking-at "^Commentary:\n\n")
- (replace-match "so-long.el\n\n")
- (insert "so-long.el\n")
- (forward-line 1))
- (save-excursion
- (while (re-search-forward "^-+$" nil :noerror)
- (replace-match ""))))
- (rename-buffer buf)
- ;; Enable `outline-mode' and `view-mode' for user convenience.
- (outline-mode)
- (declare-function outline-next-visible-heading "outline")
- (declare-function outline-previous-visible-heading "outline")
- (declare-function outline-toggle-children "outline")
- (declare-function outline-toggle-children "outline")
- (view-mode 1)
- ;; Add some custom local bindings.
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "TAB") #'outline-toggle-children)
- (define-key map (kbd "<M-tab>") #'outline-toggle-children)
- (define-key map (kbd "M-n") #'outline-next-visible-heading)
- (define-key map (kbd "M-p") #'outline-previous-visible-heading)
- (set-keymap-parent map (current-local-map))
- (use-local-map map))
- ;; Display the So Long menu.
- (so-long--ensure-enabled)
- (let ((so-long-action nil))
- (so-long))))
+ (describe-library "so-long"))
;;;###autoload
(defun so-long-customize ()
(when (featurep 'native-compile)
(startup--update-eln-cache))
- ;; If any package directory exists, initialize the package system.
- (and user-init-file
- package-enable-at-startup
- (not (bound-and-true-p package--activated))
- (catch 'package-dir-found
- (let ((dirs (cons package-user-dir package-directory-list)))
- (dolist (dir dirs)
- (when (file-directory-p dir)
- (dolist (subdir (directory-files dir))
- (when (let ((subdir (expand-file-name subdir dir)))
- (and (file-directory-p subdir)
- (file-exists-p
- (expand-file-name
- (package--description-file subdir)
- subdir))))
- (throw 'package-dir-found t)))))))
- (package-activate-all))
-
;; Make sure window system's init file was loaded in loadup.el if
;; using a window system.
;; Initialize the window-system only after processing the command-line
:link `("Customize Startup"
,(lambda (_button) (customize-group 'initialization))
"Change initialization settings including this screen")
- "\t"
- :link `("Explore Packages"
- ,(lambda (_button) (call-interactively 'package-list-packages))
- "Explore, install and remove Emacs packages (requires Internet connection)")
"\n"))
(fancy-splash-insert
:face 'variable-pitch "To quit a partially entered command, type "
NAME is the package name as a symbol, and VERSION is its version
as a list.")
-(defun package--description-file (dir)
- "Return package description file name for package DIR."
- (concat (let ((subdir (file-name-nondirectory
- (directory-file-name dir))))
- (if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir)
- (match-string 1 subdir) subdir))
- "-pkg.el"))
-
\f
;;; Thread support.
(provide 'hashtable-print-readable))
;; This is used in lisp/Makefile.in and in leim/Makefile.in to
-;; generate file names for autoloads, custom-deps, and finder-data.
+;; generate file names for autoloads and custom-deps.
(defun unmsys--file-name (file)
"Produce the canonical file name for FILE from its MSYS form.
(defun reftex-show-commentary ()
"Use the finder to view the file documentation from `reftex.el'."
(interactive)
- (finder-commentary "reftex.el"))
+ (describe-library "reftex"))
(defun reftex-info (&optional node)
"Read documentation for RefTeX in the info system.
(when use-package-compute-statistics
`((use-package-statistics-gather :config ',name t))))))
-;;;; :vc
-
-(defun use-package-vc-install (arg &optional local-path)
- "Install a package with `package-vc.el'.
-ARG is a list of the form (NAME OPTIONS REVISION), as returned by
-`use-package-normalize--vc-arg'. If LOCAL-PATH is non-nil, call
-`package-vc-install-from-checkout'; otherwise, indicating a
-remote host, call `package-vc-install' instead."
- (pcase-let* ((`(,name ,opts ,rev) arg)
- (spec (if opts (cons name opts) name)))
- (unless (package-installed-p name)
- (if local-path
- (package-vc-install-from-checkout local-path (symbol-name name))
- (package-vc-install spec rev)))))
-
-(defun use-package-handler/:vc (name _keyword arg rest state)
- "Generate code to install package NAME, or do so directly.
-When the use-package declaration is part of a byte-compiled file,
-install the package during compilation; otherwise, add it to the
-macro expansion and wait until runtime. The remaining arguments
-are as follows:
-
-_KEYWORD is ignored.
-
-ARG is the normalized input to the `:vc' keyword, as returned by
-the `use-package-normalize/:vc' function.
-
-REST is a plist of other (following) keywords and their
-arguments, each having already been normalized by the respective
-function.
-
-STATE is a plist of any state that keywords processed before
-`:vc' (see `use-package-keywords') may have accumulated.
-
-Also see the Info node `(use-package) Creating an extension'."
- (let ((body (use-package-process-keywords name rest state))
- (local-path (car (plist-get state :load-path))))
- ;; See `use-package-handler/:ensure' for an explanation.
- (if (bound-and-true-p byte-compile-current-file)
- (funcall #'use-package-vc-install arg local-path) ; compile time
- (push `(use-package-vc-install ',arg ,local-path) body)) ; runtime
- body))
-
-(defconst use-package-vc-valid-keywords
- '( :url :branch :lisp-dir :main-file :vc-backend :rev
- :shell-command :make :ignored-files)
- "Valid keywords for the `:vc' keyword.
-See Info node `(emacs)Fetching Package Sources'.")
-
-(defun use-package-normalize--vc-arg (arg)
- "Normalize possible arguments to the `:vc' keyword.
-ARG is a cons-cell of approximately the form that
-`package-vc-selected-packages' accepts, plus an additional `:rev'
-keyword. If `:rev' is not given, it defaults to `:last-release'.
-
-Returns a list (NAME SPEC REV), where (NAME . SPEC) is compliant
-with `package-vc-selected-packages' and REV is a (possibly nil,
-indicating the latest commit) revision."
- (cl-flet* ((ensure-string (s)
- (if (and s (stringp s)) s (symbol-name s)))
- (ensure-symbol (s)
- (if (and s (stringp s)) (intern s) s))
- (normalize (k v)
- (pcase k
- (:rev (pcase v
- ('nil (if use-package-vc-prefer-newest nil :last-release))
- (:last-release :last-release)
- (:newest nil)
- (_ (ensure-string v))))
- (:vc-backend (ensure-symbol v))
- (:ignored-files (if (listp v) v (list v)))
- (_ (ensure-string v)))))
- (pcase-let* ((`(,name . ,opts) arg))
- (if (stringp opts) ; (NAME . VERSION-STRING) ?
- (list name opts)
- (let ((opts (use-package-split-when
- (lambda (el)
- (seq-contains-p use-package-vc-valid-keywords el))
- opts)))
- ;; Error handling
- (cl-loop for (k . _) in opts
- if (not (member k use-package-vc-valid-keywords))
- do (use-package-error
- (format "Keyword :vc received unknown argument: %s. Supported keywords are: %s"
- k use-package-vc-valid-keywords)))
- ;; Actual normalization
- (list name
- (cl-loop for (k . v) in opts
- if (not (eq k :rev))
- nconc (list k (normalize k (if (length= v 1) (car v) v))))
- (normalize :rev (car (alist-get :rev opts)))))))))
-
-(defun use-package-normalize/:vc (name _keyword args)
- "Normalize possible arguments to the `:vc' keyword.
-NAME is the name of the `use-package' declaration, _KEYWORD is
-ignored, and ARGS it a list of arguments given to the `:vc'
-keyword, the cdr of which is ignored.
-
-See `use-package-normalize--vc-arg' for most of the actual
-normalization work. Also see the Info
-node `(use-package) Creating an extension'."
- (let ((arg (car args)))
- (pcase arg
- ((or 'nil 't) (list name)) ; guess name
- ((pred symbolp) (list arg)) ; use this name
- ((pred stringp) (list name arg)) ; version string + guess name
- (`(,(pred keywordp) . ,(pred listp)) ; list + guess name
- (use-package-normalize--vc-arg (cons name arg)))
- (`(,(pred symbolp) . ,(or (pred listp) ; list/version string + name
- (pred stringp)))
- (use-package-normalize--vc-arg arg))
- (_ (use-package-error "Unrecognized argument to :vc.\
- The keyword wants an argument of nil, t, a name of a package,\
- or a cons-cell as accepted by `package-vc-selected-packages', where \
- the accepted plist is augmented by a `:rev' keyword.")))))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; The main macro
(require 'cl-lib)
(require 'use-package-core)
-(eval-when-compile
- (declare-function package-installed-p "package")
- (declare-function package-read-all-archive-contents "package" ()))
-
-;;;; :pin
-
-(defun use-package-normalize/:pin (_name keyword args)
- (use-package-only-one (symbol-name keyword) args
- #'(lambda (_label arg)
- (cond
- ((stringp arg) arg)
- ((use-package-non-nil-symbolp arg) (symbol-name arg))
- (t
- (use-package-error
- ":pin wants an archive name (a string)"))))))
-
-(eval-when-compile
- (defvar package-pinned-packages)
- (defvar package-archives))
-
-(defun use-package-archive-exists-p (archive)
- "Check if a given ARCHIVE is enabled.
-
-ARCHIVE can be a string or a symbol or `manual' to indicate a
-manually updated package."
- (if (member archive '(manual "manual"))
- 't
- (let ((valid nil))
- (dolist (pa package-archives)
- (when (member archive (list (car pa) (intern (car pa))))
- (setq valid 't)))
- valid)))
-
-(defun use-package-pin-package (package archive)
- "Pin PACKAGE to ARCHIVE."
- (unless (boundp 'package-pinned-packages)
- (setq package-pinned-packages ()))
- (let ((archive-symbol (if (symbolp archive) archive (intern archive)))
- (archive-name (if (stringp archive) archive (symbol-name archive))))
- (if (use-package-archive-exists-p archive-symbol)
- (add-to-list 'package-pinned-packages (cons package archive-name))
- (error "Archive '%s' requested for package '%s' is not available"
- archive-name package))
- (unless (bound-and-true-p package--initialized)
- (package-initialize t))))
-
-(defun use-package-handler/:pin (name _keyword archive-name rest state)
- (let ((body (use-package-process-keywords name rest state))
- (pin-form (if archive-name
- `(use-package-pin-package ',(use-package-as-symbol name)
- ,archive-name))))
- ;; Pinning should occur just before ensuring
- ;; See `use-package-handler/:ensure'.
- (if (bound-and-true-p byte-compile-current-file)
- (eval pin-form) ; Eval when byte-compiling,
- (push pin-form body)) ; or else wait until runtime.
- body))
-
;;;; :ensure
-(defvar package-archive-contents)
-
;;;###autoload
(defun use-package-normalize/:ensure (_name keyword args)
(if (null args)
(concat ":ensure wants an optional package name "
"(an unquoted symbol name), or (<symbol> :pin <string>)"))))))))
-(defun use-package-ensure-elpa (name args _state &optional _no-refresh)
- (dolist (ensure args)
- (let ((package
- (or (and (eq ensure t) (use-package-as-symbol name))
- ensure)))
- (when package
- (require 'package)
- (when (consp package)
- (use-package-pin-package (car package) (cdr package))
- (setq package (car package)))
- (unless (package-installed-p package)
- (condition-case-unless-debug err
- (progn
- (when (assoc package (bound-and-true-p
- package-pinned-packages))
- (package-read-all-archive-contents))
- (if (assoc package package-archive-contents)
- (package-install package)
- (package-refresh-contents)
- (when (assoc package (bound-and-true-p
- package-pinned-packages))
- (package-read-all-archive-contents))
- (package-install package))
- t)
- (error
- (display-warning 'use-package
- (format "Failed to install %s: %s"
- name (error-message-string err))
- :error))))))))
-
;;;###autoload
(defun use-package-handler/:ensure (name _keyword ensure rest state)
(let* ((body (use-package-process-keywords name rest state))
(defun widget-emacs-commentary-link-action (widget &optional _event)
"Find the Commentary section of the Emacs file specified by WIDGET."
- (finder-commentary (widget-value widget)))
+ (describe-library (widget-value widget)))
;;; The `editable-field' Widget.
((facep symbol)
(describe-face symbol))
((featurep symbol)
- (describe-package symbol))
+ (describe-library symbol))
((or (boundp symbol) (get symbol 'variable-documentation))
(describe-variable symbol))
(t
+++ /dev/null
-(1
- (simple-single .
- [(1 3)
- nil "A single-file package with no dependencies" single
- ((:url . "http://doodles.au")
- (:keywords quote ("frobnicate")))])
- (simple-depend .
- [(1 0)
- ((simple-single (1 3))) "A single-file package with a dependency." single])
- (simple-two-depend .
- [(1 1)
- ((simple-depend (1 0)) (simple-single (1 3)))
- "A single-file package with two dependencies." single])
- (multi-file .
- [(0 2 3)
- nil "Example of a multi-file tar package" tar
- ((:url . "http://puddles.li"))]))
+++ /dev/null
-;; Dummy elpa-package.eld
-
-(() :version 1)
+++ /dev/null
------BEGIN PGP PUBLIC KEY BLOCK-----
-Comment: Alice's OpenPGP certificate
-
-mDMEXEcE6RYJKwYBBAHaRw8BAQdArjWwk3FAqyiFbFBKT4TzXcVBqPTB3gmzlC/U
-b7O1u120JkFsaWNlIExvdmVsYWNlIDxhbGljZUBvcGVucGdwLmV4YW1wbGU+iJAE
-ExYIADgCGwMFCwkIBwIGFQoJCAsCBBYCAwECHgECF4AWIQTrhbtfozp14V6UTmPy
-MVUMT0fjjgUCXaWfOgAKCRDyMVUMT0fjjukrAPoDnHBSogOmsHOsd9qGsiZpgRnO
-dypvbm+QtXZqth9rvwD9HcDC0tC+PHAsO7OTh1S1TC9RiJsvawAfCPaQZoed8gK4
-OARcRwTpEgorBgEEAZdVAQUBAQdAQv8GIa2rSTzgqbXCpDDYMiKRVitCsy203x3s
-E9+eviIDAQgHiHgEGBYIACAWIQTrhbtfozp14V6UTmPyMVUMT0fjjgUCXEcE6QIb
-DAAKCRDyMVUMT0fjjlnQAQDFHUs6TIcxrNTtEZFjUFm1M0PJ1Dng/cDW4xN80fsn
-0QEA22Kr7VkCjeAEC08VSTeV+QFsmz55/lntWkwYWhmvOgE=
-=iIGO
------END PGP PUBLIC KEY BLOCK-----
+++ /dev/null
------BEGIN PGP PRIVATE KEY BLOCK-----
-Comment: Alice's OpenPGP Transferable Secret Key
-
-lFgEXEcE6RYJKwYBBAHaRw8BAQdArjWwk3FAqyiFbFBKT4TzXcVBqPTB3gmzlC/U
-b7O1u10AAP9XBeW6lzGOLx7zHH9AsUDUTb2pggYGMzd0P3ulJ2AfvQ4RtCZBbGlj
-ZSBMb3ZlbGFjZSA8YWxpY2VAb3BlbnBncC5leGFtcGxlPoiQBBMWCAA4AhsDBQsJ
-CAcCBhUKCQgLAgQWAgMBAh4BAheAFiEE64W7X6M6deFelE5j8jFVDE9H444FAl2l
-nzoACgkQ8jFVDE9H447pKwD6A5xwUqIDprBzrHfahrImaYEZzncqb25vkLV2arYf
-a78A/R3AwtLQvjxwLDuzk4dUtUwvUYibL2sAHwj2kGaHnfICnF0EXEcE6RIKKwYB
-BAGXVQEFAQEHQEL/BiGtq0k84Km1wqQw2DIikVYrQrMttN8d7BPfnr4iAwEIBwAA
-/3/xFPG6U17rhTuq+07gmEvaFYKfxRB6sgAYiW6TMTpQEK6IeAQYFggAIBYhBOuF
-u1+jOnXhXpROY/IxVQxPR+OOBQJcRwTpAhsMAAoJEPIxVQxPR+OOWdABAMUdSzpM
-hzGs1O0RkWNQWbUzQ8nUOeD9wNbjE3zR+yfRAQDbYqvtWQKN4AQLTxVJN5X5AWyb
-Pnn+We1aTBhaGa86AQ==
-=n8OM
------END PGP PRIVATE KEY BLOCK-----
+++ /dev/null
-;;; macro-builtin-aux.el --- laksd -*- lexical-binding: t; -*-
-
-;; Author: Artur Malabarba <emacs@endlessparentheses.com>
-
-;;; Code:
-
-(defun macro-builtin-aux-1 ( &rest forms)
- "Description"
- `(progn ,@forms))
-
-(provide 'macro-builtin-aux)
-;;; macro-builtin-aux.el ends here
+++ /dev/null
-;;; macro-builtin.el --- laksd -*- lexical-binding: t; -*-
-
-;; Author: Artur Malabarba <emacs@endlessparentheses.com>
-;; Keywords: tools
-;; Version: 1.0
-
-;;; Code:
-
-(require 'macro-builtin-aux)
-
-(defmacro macro-builtin-1 ( &rest forms)
- "Description"
- `(progn ,@forms))
-
-(defun macro-builtin-func ()
- ""
- (macro-builtin-1 'a 'b)
- (macro-builtin-aux-1 'a 'b))
-
-(provide 'macro-builtin)
-;;; macro-builtin.el ends here
+++ /dev/null
-;;; macro-builtin-aux.el --- laksd -*- lexical-binding: t; -*-
-
-;; Author: Artur Malabarba <emacs@endlessparentheses.com>
-
-;;; Code:
-
-(defmacro macro-builtin-aux-1 ( &rest forms)
- "Description"
- `(progn ,@forms))
-
-(defmacro macro-builtin-aux-3 ( &rest _)
- "Description"
- 90)
-
-(provide 'macro-builtin-aux)
-;;; macro-builtin-aux.el ends here
+++ /dev/null
-;;; macro-builtin.el --- laksd -*- lexical-binding: t; -*-
-
-;; Author: Artur Malabarba <emacs@endlessparentheses.com>
-;; Keywords: tools
-;; Version: 2.0
-
-;;; Code:
-
-(require 'macro-builtin-aux)
-
-(defmacro macro-builtin-1 ( &rest forms)
- "Description"
- `(progn ,(cadr (car forms))))
-
-
-(defun macro-builtin-func ()
- ""
- (list (macro-builtin-1 '1 'b)
- (macro-builtin-aux-1 'a 'b)))
-
-(defmacro macro-builtin-3 (&rest _)
- "Description"
- 10)
-
-(defun macro-builtin-10-and-90 ()
- ""
- (list (macro-builtin-3 haha) (macro-builtin-aux-3 hehe)))
-
-(provide 'macro-builtin)
-;;; macro-builtin.el ends here
+++ /dev/null
-;;; macro-aux.el --- laksd -*- lexical-binding: t; -*-
-
-;; Author: Artur Malabarba <emacs@endlessparentheses.com>
-
-;;; Code:
-
-(defun macro-aux-1 ( &rest forms)
- "Description."
- `(progn ,@forms))
-
-(provide 'macro-aux)
-;;; macro-aux.el ends here
+++ /dev/null
-;;; macro-problem.el --- laksd -*- lexical-binding: t; -*-
-
-;; Author: Artur Malabarba <emacs@endlessparentheses.com>
-;; Keywords: tools
-;; Version: 1.0
-
-;;; Code:
-
-(require 'macro-aux)
-
-(defmacro macro-problem-1 ( &rest forms)
- "Description."
- `(progn ,@forms))
-
-(defun macro-problem-func ()
- "Description."
- (macro-problem-1 'a 'b)
- (macro-aux-1 'a 'b))
-
-(provide 'macro-problem)
-;;; macro-problem.el ends here
+++ /dev/null
-;;; macro-aux.el --- laksd -*- lexical-binding: t; -*-
-
-;; Author: Artur Malabarba <emacs@endlessparentheses.com>
-
-;;; Code:
-
-(defmacro macro-aux-1 ( &rest forms)
- "Description."
- `(progn ,@forms))
-
-(defmacro macro-aux-3 ( &rest _)
- "Description."
- 90)
-
-(provide 'macro-aux)
-;;; macro-aux.el ends here
+++ /dev/null
-;;; macro-problem.el --- laksd -*- lexical-binding: t; -*-
-
-;; Author: Artur Malabarba <emacs@endlessparentheses.com>
-;; Keywords: tools
-;; Version: 2.0
-
-;;; Code:
-
-(require 'macro-aux)
-
-(defmacro macro-problem-1 ( &rest forms)
- "Description."
- `(progn ,(cadr (car forms))))
-
-
-(defun macro-problem-func ()
- "Description."
- (list (macro-problem-1 '1 'b)
- (macro-aux-1 'a 'b)))
-
-(defmacro macro-problem-3 (&rest _)
- "Description."
- 10)
-
-(defun macro-problem-10-and-90 ()
- "Description."
- (list (macro-problem-3 haha) (macro-aux-3 hehe)))
-
-(provide 'macro-problem)
-;;; macro-problem.el ends here
+++ /dev/null
-This is a bare-bones readme file for the multi-file package.
+++ /dev/null
-(1
- (simple-single .
- [(1 4)
- nil "A single-file package with no dependencies" single])
- (simple-depend .
- [(1 0)
- ((simple-single (1 3))) "A single-file package with a dependency." single])
- (new-pkg .
- [(1 0)
- nil "A package only seen after "updating" archive-contents" single])
- (multi-file .
- [(0 2 3)
- nil "Example of a multi-file tar package" tar]))
+++ /dev/null
-;; Dummy elpa-package.eld
-
-(() :version 1)
+++ /dev/null
-;;; new-pkg.el --- A package only seen after "updating" archive-contents -*- lexical-binding:t -*-
-
-;; Author: J. R. Hacker <jrh@example.com>
-;; Version: 1.0
-
-;;; Commentary:
-
-;; This will only show up after updating "archive-contents".
-
-;;; Code:
-
-(defun new-pkg-frob ()
- "Ignore me."
- (ignore))
-
-(provide 'new-pkg)
-
-;;; new-pkg.el ends here
+++ /dev/null
-;;; simple-single.el --- A single-file package with no dependencies -*- lexical-binding:t -*-
-
-;; Author: J. R. Hacker <jrh@example.com>
-;; Version: 1.4
-;; Keywords: frobnicate
-
-;;; Commentary:
-
-;; This package provides a minor mode to frobnicate and/or bifurcate
-;; any flanges you desire. To activate it, type "C-M-r M-3 butterfly"
-;; and all your dreams will come true.
-;;
-;; This is a new, updated version.
-
-;;; Code:
-
-(defgroup simple-single nil "Simply a file."
- :group 'lisp)
-
-(defcustom simple-single-super-sunday nil
- "How great is this?
-Default changed to nil."
- :type 'boolean
- :group 'simple-single
- :package-version "1.4")
-
-(defvar simple-single-sudo-sandwich nil
- "Make a sandwich?")
-
-;;;###autoload
-(define-minor-mode simple-single-mode
- "It does good things to stuff.")
-
-(provide 'simple-single)
-
-;;; simple-single.el ends here
+++ /dev/null
-import sys
-
-try:
- from http.server import HTTPServer, SimpleHTTPRequestHandler
-except ImportError:
- from BaseHTTPServer import HTTPServer
- from SimpleHTTPServer import SimpleHTTPRequestHandler
-
-
-HandlerClass = SimpleHTTPRequestHandler
-HandlerClass.protocol_version = "HTTP/1.0"
-server_address = ("127.0.0.1", int(sys.argv[1]) if sys.argv[1:] else 0)
-httpd = HTTPServer(server_address, HandlerClass)
-
-ip, port = httpd.socket.getsockname()[0:2]
-print("Server started, http://%s:%s/" % (ip, port))
-# Flush in case we're in full buffering mode (instead of line
-# buffering), this might happen if python is a cygwin program and we
-# run it from a native w32 program.
-sys.stdout.flush()
-httpd.serve_forever()
+++ /dev/null
-(1
- (signed-good .
- [(1 0)
- nil "A package with good signature" single])
- (signed-bad .
- [(1 0)
- nil "A package with bad signature" single]))
+++ /dev/null
-;; Dummy elpa-package.eld
-
-(() :version 1)
+++ /dev/null
-;;; signed-bad.el --- A single-file package with bad signature -*- lexical-binding: t -*-
-
-;; Author: J. R. Hacker <jrh@example.com>
-;; Version: 1.0
-;; Keywords: frobnicate
-;; URL: http://doodles.au
-
-;;; Commentary:
-
-;; This package provides a minor mode to frobnicate and/or bifurcate
-;; any flanges you desire. To activate it, type "C-M-r M-3 butterfly"
-;; and all your dreams will come true.
-
-;;; Code:
-
-(defgroup signed-bad nil "Simply a file."
- :group 'lisp)
-
-(defcustom signed-bad-super-sunday t
- "How great is this?"
- :type 'boolean
- :group 'signed-bad)
-
-(defvar signed-bad-sudo-sandwich nil
- "Make a sandwich?")
-
-;;;###autoload
-(define-minor-mode signed-bad-mode
- "It does good things to stuff.")
-
-(provide 'signed-bad)
-
-;;; signed-bad.el ends here
+++ /dev/null
-;;; signed-good.el --- A single-file package with good signature -*- lexical-binding: t -*-
-
-;; Author: J. R. Hacker <jrh@example.com>
-;; Version: 1.0
-;; Keywords: frobnicate
-;; URL: http://doodles.au
-
-;;; Commentary:
-
-;; This package provides a minor mode to frobnicate and/or bifurcate
-;; any flanges you desire. To activate it, type "C-M-r M-3 butterfly"
-;; and all your dreams will come true.
-
-;;; Code:
-
-(defgroup signed-good nil "Simply a file."
- :group 'lisp)
-
-(defcustom signed-good-super-sunday t
- "How great is this?"
- :type 'boolean
- :group 'signed-good)
-
-(defvar signed-good-sudo-sandwich nil
- "Make a sandwich?")
-
-;;;###autoload
-(define-minor-mode signed-good-mode
- "It does good things to stuff.")
-
-(provide 'signed-good)
-
-;;; signed-good.el ends here
+++ /dev/null
-#! /bin/sh
-
-# Generate a new key and update the signatures for tests.
-
-# Copyright (C) 2020-2025 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/>.
-
-export GPG_AGENT=""
-KEYRING="./key.ring"
-TRUSTDB="./trust.db"
-GPG="gpg --no-default-keyring --trustdb-name $TRUSTDB --keyring $KEYRING --yes"
-
-rm $KEYRING
-#$GPG --full-generate-key
-#$GPG --export --armor > "../key.pub"
-#$GPG --export-secret-keys -armor > "../key.sec"
-$GPG --import ../key.sec
-$GPG --detach-sign --sign "./archive-contents"
-$GPG --detach-sign --sign "./elpa-packages.eld"
-$GPG --detach-sign --sign "./signed-good-1.0.el"
+++ /dev/null
-;;; simple-depend.el --- A single-file package with a dependency. -*- lexical-binding:t -*-
-
-;; Author: J. R. Hacker <jrh@example.com>
-;; Version: 1.0
-;; Keywords: frobnicate
-;; Package-Requires: ((simple-single "1.3"))
-
-;;; Commentary:
-
-;; Depends on another package.
-
-;;; Code:
-
-(defvar simple-depend "Value"
- "Some trivial code.")
-
-;;; simple-depend.el ends here
+++ /dev/null
-;;; simple-single.el --- A single-file package with no dependencies -*- lexical-binding:t -*-
-
-;; Author: J. R. Hacker <jrh@example.com>
-;; Version: 1.3
-;; Keywords: frobnicate
-;; URL: http://doodles.au
-
-;;; Commentary:
-
-;; This package provides a minor mode to frobnicate and/or bifurcate
-;; any flanges you desire. To activate it, type "C-M-r M-3 butterfly"
-;; and all your dreams will come true.
-
-;;; Code:
-
-(defgroup simple-single nil "Simply a file."
- :group 'lisp)
-
-(defcustom simple-single-super-sunday t
- "How great is this?"
- :type 'boolean
- :group 'simple-single)
-
-(defvar simple-single-sudo-sandwich nil
- "Make a sandwich?")
-
-;;;###autoload
-(define-minor-mode simple-single-mode
- "It does good things to stuff.")
-
-(provide 'simple-single)
-
-;;; simple-single.el ends here
+++ /dev/null
-This package provides a minor mode to frobnicate and/or bifurcate
-any flanges you desire. To activate it, type "C-M-r M-3 butterfly"
-and all your dreams will come true.
+++ /dev/null
-;;; simple-two-depend.el --- A single-file package with two dependencies. -*- lexical-binding:t -*-
-
-;; Author: J. R. Hacker <jrh@example.com>
-;; Version: 1.1
-;; Keywords: frobnicate
-;; Package-Requires: ((simple-depend "1.0") (simple-single "1.3"))
-
-;;; Commentary:
-
-;; Depends on two another packages.
-
-;;; Code:
-
-(defvar simple-two-depend "Value"
- "Some trivial code.")
-
-;;; simple-two-depend.el ends here
+++ /dev/null
-(1
- (foo .
- [(1 0)
- nil "foo package" single])
- nil
- (bar .
- [(1 0)
- nil "bar package" single]))
+++ /dev/null
-;; Dummy elpa-package.eld
-
-(() :version 1)
+++ /dev/null
-;;; package-tests.el --- Tests for the Emacs package system -*- lexical-binding:t -*-
-
-;; Copyright (C) 2013-2025 Free Software Foundation, Inc.
-
-;; Author: Daniel Hackney <dan@haxney.org>
-;; Version: 1.0
-
-;; 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:
-
-;; You may want to run this from a separate Emacs instance from your
-;; main one, because a bug in the code below could mess with your
-;; installed packages.
-
-;; Run this in a clean Emacs session using:
-;;
-;; $ emacs -Q --batch -L . -l package-tests.el -l ert -f ert-run-tests-batch-and-exit
-;;
-;; From the top level directory of the Emacs development repository,
-;; you can use this instead:
-;;
-;; $ make -C test package-tests
-
-;;; Code:
-
-(require 'package)
-(require 'ert)
-(require 'ert-x)
-(require 'cl-lib)
-
-(setq package-menu-async nil)
-
-(defvar package-test-user-dir nil
- "Directory to use for installing packages during testing.")
-
-(defvar package-test-file-dir (file-name-directory (or load-file-name
- buffer-file-name))
- "Directory of the actual \"package-test.el\" file.")
-
-(defvar simple-single-desc
- (package-desc-create :name 'simple-single
- :version '(1 3)
- :summary "A single-file package with no dependencies"
- :kind 'single
- :extras '((:authors ("J. R. Hacker" . "jrh@example.com"))
- (:maintainer "J. R. Hacker" . "jrh@example.com")
- (:url . "http://doodles.au")))
- "Expected `package-desc' parsed from simple-single-1.3.el.")
-
-(defvar simple-depend-desc
- (package-desc-create :name 'simple-depend
- :version '(1 0)
- :summary "A single-file package with a dependency."
- :kind 'single
- :reqs '((simple-single (1 3)))
- :extras '((:authors ("J. R. Hacker" . "jrh@example.com"))
- (:maintainer "J. R. Hacker" . "jrh@example.com")))
- "Expected `package-desc' parsed from simple-depend-1.0.el.")
-
-(defvar multi-file-desc
- (package-desc-create :name 'multi-file
- :version '(0 2 3)
- :summary "Example of a multi-file tar package"
- :kind 'tar
- :extras '((:url . "http://puddles.li")))
- "Expected `package-desc' from \"multi-file-0.2.3.tar\".")
-
-(defvar new-pkg-desc
- (package-desc-create :name 'new-pkg
- :version '(1 0)
- :kind 'single)
- "Expected `package-desc' parsed from new-pkg-1.0.el.")
-
-(defvar simple-depend-desc-1
- (package-desc-create :name 'simple-depend-1
- :version '(1 0)
- :summary "A single-file package with a dependency."
- :kind 'single
- :reqs '((simple-depend (1 0))
- (multi-file (0 1))))
- "`package-desc' used for testing dependencies.")
-
-(defvar simple-depend-desc-2
- (package-desc-create :name 'simple-depend-2
- :version '(1 0)
- :summary "A single-file package with a dependency."
- :kind 'single
- :reqs '((simple-depend-1 (1 0))
- (multi-file (0 1))))
- "`package-desc' used for testing dependencies.")
-
-(defvar package-test-data-dir (ert-resource-directory)
- "Base directory of package test files.")
-
-(cl-defmacro with-package-test ((&optional &key file
- basedir
- install
- location
- update-news
- upload-base)
- &rest body)
- "Set up temporary locations and variables for testing."
- (declare (indent 1) (debug (([&rest form]) body)))
- `(ert-with-temp-directory package-test-user-dir
- (let* ((process-environment (cons (format "HOME=%s" package-test-user-dir)
- process-environment))
- (package-user-dir package-test-user-dir)
- (package-gnupghome-dir (expand-file-name "gnupg" package-user-dir))
- (package-archives `(("gnu" . ,(or ,location package-test-data-dir))))
- (default-directory package-test-file-dir)
- abbreviated-home-dir
- package--initialized
- package-alist
- package-selected-packages
- ,@(if update-news
- '(package-update-news-on-upload t)
- (list (cl-gensym)))
- ,@(if upload-base
- '((package-test-archive-upload-base (make-temp-file "pkg-archive-base-" t))
- (package-archive-upload-base package-test-archive-upload-base))
- (list (cl-gensym)))) ;; Dummy value so `let' doesn't try to bind nil
- (let ((buf (get-buffer "*Packages*")))
- (when (buffer-live-p buf)
- (kill-buffer buf)))
- (unwind-protect
- (progn
- ,(if basedir `(cd ,basedir))
- (unless (file-directory-p package-user-dir)
- (mkdir package-user-dir))
- (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t))
- ((symbol-function 'y-or-n-p) (lambda (&rest _) t)))
- ,@(when install
- `((package-initialize)
- (package-refresh-contents)
- (mapc 'package-install ,install)))
- (with-temp-buffer
- ,(if file
- `(insert-file-contents ,file))
- ,@body)))
-
- (when ,upload-base
- (dolist (f '("archive-contents"
- "simple-single-1.3.el"
- "simple-single-1.4.el"
- "simple-single-readme.txt"))
- (ignore-errors
- (delete-file
- (expand-file-name f package-test-archive-upload-base))))
- (delete-directory package-test-archive-upload-base))
-
- (when (and (boundp 'package-test-archive-upload-base)
- (file-directory-p package-test-archive-upload-base))
- (delete-directory package-test-archive-upload-base t))))))
-
-(defmacro with-fake-help-buffer (&rest body)
- "Execute BODY in a temp buffer which is treated as the \"*Help*\" buffer."
- (declare (debug body))
- `(with-temp-buffer
- (help-mode)
- ;; Trick `help-buffer' into using the temp buffer.
- (let ((help-xref-following t))
- ,@body)))
-
-(defun package-test-strip-version (dir)
- (replace-regexp-in-string "-pkg\\.el\\'" "" (package--description-file dir)))
-
-(defun package-test-suffix-matches (base suffix-list)
- "Return file names matching BASE concatenated with each item in SUFFIX-LIST."
- (mapcan (lambda (item) (file-expand-wildcards (concat base item)))
- suffix-list))
-
-(defvar tar-parse-info)
-(declare-function tar-header-name "tar-mode" (cl-x) t) ; defstruct
-
-(defun package-test-search-tar-file (filename)
- "Search the current buffer's `tar-parse-info' variable for FILENAME.
-
-Must called from within a `tar-mode' buffer."
- (cl-dolist (header tar-parse-info)
- (let ((tar-name (tar-header-name header)))
- (when (string= tar-name filename)
- (cl-return t)))))
-
-(defun package-test-desc-version-string (desc)
- "Return the package version as a string."
- (package-version-join (package-desc-version desc)))
-
-(defun package-test--compatible-p (pkg-desc pkg-sample &optional kind)
- (and (cl-every (lambda (f)
- (equal (funcall f pkg-desc)
- (funcall f pkg-sample)))
- (cons (if kind #'package-desc-kind #'ignore)
- '(package-desc-name
- package-desc-version
- package-desc-summary
- package-desc-reqs
- package-desc-archive
- package-desc-dir
- package-desc-signed)))
- ;; The `extras' field should contain at least the specified elements.
- (let ((extras (package-desc-extras pkg-desc))
- (extras-sample (package-desc-extras pkg-sample)))
- (cl-every (lambda (sample-elem)
- (member sample-elem extras))
- extras-sample))))
-
-(ert-deftest package-test-desc-from-buffer ()
- "Parse an elisp buffer to get a `package-desc' object."
- (with-package-test (:basedir (ert-resource-directory)
- :file "simple-single-1.3.el")
- (let ((pi (package-buffer-info)))
- (should (package-test--compatible-p pi simple-single-desc 'kind))
- ;; The terminating line is not mandatory any more.
- (re-search-forward "^;;; .* ends here")
- (delete-region (match-beginning 0) (point-max))
- (should (equal (package-buffer-info) pi))))
- (with-package-test (:basedir (ert-resource-directory) :file "simple-depend-1.0.el")
- (should (package-test--compatible-p
- (package-buffer-info) simple-depend-desc 'kind)))
- (with-package-test (:basedir (ert-resource-directory)
- :file "multi-file-0.2.3.tar")
- (tar-mode)
- (should (equal (package-tar-file-info) multi-file-desc))))
-
-(ert-deftest package-test-install-single ()
- "Install a single file without using an archive."
- (with-package-test (:basedir (ert-resource-directory) :file "simple-single-1.3.el")
- (should (package-install-from-buffer))
- (package-initialize)
- (should (package-installed-p 'simple-single))
- ;; Check if we properly report an "already installed".
- (package-install 'simple-single)
- (with-current-buffer "*Messages*"
- (should (string-match "^[`‘']simple-single[’'] is already installed\n?\\'"
- (buffer-string))))
- (should (package-installed-p 'simple-single))
- (let* ((simple-pkg-dir (file-name-as-directory
- (expand-file-name
- "simple-single-1.3"
- package-test-user-dir)))
- (autoloads-file (expand-file-name "simple-single-autoloads.el"
- simple-pkg-dir)))
- (should (file-directory-p simple-pkg-dir))
- (with-temp-buffer
- (insert-file-contents (expand-file-name "simple-single-pkg.el"
- simple-pkg-dir))
- (goto-char (point-min))
- (let ((sexp (read (current-buffer))))
- (should (eq (car-safe sexp) 'define-package))
- (should (package-test--compatible-p
- (apply #'package-desc-from-define (cdr sexp))
- simple-single-desc))))
- (should (file-exists-p autoloads-file))
- (should-not (get-file-buffer autoloads-file)))))
-
-(ert-deftest package-test-install-file ()
- "Install files with `package-install-file'."
- (with-package-test (:basedir (ert-resource-directory))
- (package-initialize)
- (let* ((pkg-el "simple-single-1.3.el")
- (source-file (expand-file-name pkg-el (ert-resource-directory))))
- (should-not (package-installed-p 'simple-single))
- (package-install-file source-file)
- (should (package-installed-p 'simple-single))
- (package-delete (cadr (assq 'simple-single package-alist)))
- (should-not (package-installed-p 'simple-single)))
-
- (let* ((pkg-el "multi-file-0.2.3.tar")
- (source-file (expand-file-name pkg-el (ert-resource-directory))))
- (should-not (package-installed-p 'multie-file))
- (package-install-file source-file)
- (should (package-installed-p 'multi-file))
- (package-delete (cadr (assq 'multi-file package-alist))))))
-
-(ert-deftest package-test-bug58367 ()
- "Check variations in tarball formats."
- (with-package-test (:basedir (ert-resource-directory))
- (package-initialize)
-
- ;; A package whose first entry is the main dir but without trailing /.
- (let* ((pkg-el "ustar-withsub-0.1.tar")
- (source-file (expand-file-name pkg-el (ert-resource-directory))))
- (should-not (package-installed-p 'ustar-withsub))
- (package-install-file source-file)
- (should (package-installed-p 'ustar-withsub))
- (package-delete (cadr (assq 'ustar-withsub package-alist))))
-
- ;; A package whose first entry is a file in a subdir.
- (let* ((pkg-el "v7-withsub-0.1.tar")
- (source-file (expand-file-name pkg-el (ert-resource-directory))))
- (should-not (package-installed-p 'v7-withsub))
- (package-install-file source-file)
- (should (package-installed-p 'v7-withsub))
- (package-delete (cadr (assq 'v7-withsub package-alist))))
- ))
-
-(ert-deftest package-test-bug65475 ()
- "Deleting the last package clears `package-selected-packages'."
- (with-package-test (:basedir (ert-resource-directory))
- (package-initialize)
- (let* ((pkg-el "simple-single-1.3.el")
- (source-file (expand-file-name pkg-el (ert-resource-directory))))
- (package-install-file source-file)
- (should package-alist)
- (should package-selected-packages)
- (let ((desc (cadr (assq 'simple-single package-alist))))
- (should desc)
- (package-delete desc))
- (should-not package-alist)
- (should-not package-selected-packages))))
-
-(ert-deftest package-test-install-file-EOLs ()
- "Install same file multiple time with `package-install-file'
-but with a different end of line convention (bug#48137)."
- (with-package-test (:basedir (ert-resource-directory))
- (package-initialize)
- (let* ((pkg-el "simple-single-1.3.el")
- (source-file (expand-file-name pkg-el (ert-resource-directory))))
-
- (with-temp-buffer
- (insert-file-contents source-file)
-
- (let (hashes)
- (dolist (coding '(unix dos mac) hashes)
- (let* ((eol-file (expand-file-name pkg-el package-test-user-dir)))
- ;; save package with this EOL convention.
- (set-buffer-file-coding-system coding)
- (write-region (point-min) (point-max) eol-file)
-
- (should-not (package-installed-p 'simple-single))
- (package-install-file eol-file)
- (should (package-installed-p 'simple-single))
-
- ;; check the package file has been installed unmodified.
- (let ((eol-hash (with-temp-buffer
- (insert-file-contents-literally eol-file)
- (buffer-hash))))
- ;; also perform an additional check that the package
- ;; file created with this EOL convention is different
- ;; than all the others created so far.
- (should-not (member eol-hash hashes))
- (setq hashes (cons eol-hash hashes))
-
- (let* ((descr (cadr (assq 'simple-single package-alist)))
- (pkg-dir (package-desc-dir descr))
- (dest-file (expand-file-name "simple-single.el" pkg-dir ))
- (dest-hash (with-temp-buffer
- (insert-file-contents-literally dest-file)
- (buffer-hash))))
-
- (should (string= dest-hash eol-hash))))
-
- (package-delete (cadr (assq 'simple-single package-alist)))
- (should-not (package-installed-p 'simple-single))
- (delete-file eol-file)
- (should-not (file-exists-p eol-file))
- )))))))
-
-(ert-deftest package-test-install-dependency ()
- "Install a package which includes a dependency."
- (with-package-test ()
- (package-initialize)
- (package-refresh-contents)
- (package-install 'simple-depend)
- (should (package-installed-p 'simple-single))
- (should (package-installed-p 'simple-depend))))
-
-(declare-function macro-problem-func "macro-problem" ())
-(declare-function macro-problem-10-and-90 "macro-problem" ())
-(declare-function macro-builtin-func "macro-builtin" ())
-(declare-function macro-builtin-10-and-90 "macro-builtin" ())
-
-(ert-deftest package-test-macro-compilation ()
- "\"Activation has to be done before compilation, so that if we're
- upgrading and macros have changed we load the new definitions
- before compiling.\" -- package.el"
- (with-package-test (:basedir (ert-resource-directory))
- (package-install-file (expand-file-name "macro-problem-package-1.0/"))
- (require 'macro-problem)
- ;; `macro-problem-func' uses a macro from `macro-aux'.
- (should (equal (macro-problem-func) '(progn a b)))
- (package-install-file (expand-file-name "macro-problem-package-2.0/"))
- ;; After upgrading, `macro-problem-func' depends on a new version
- ;; of the macro from `macro-aux'.
- (should (equal (macro-problem-func) '(1 b)))
- ;; `macro-problem-10-and-90' depends on an entirely new macro from `macro-aux'.
- (should (equal (macro-problem-10-and-90) '(10 90)))))
-
-(ert-deftest package-test-macro-compilation-gz ()
- "Built-in's can be superseded as well."
- (with-package-test (:basedir (ert-resource-directory))
- (let ((dir (expand-file-name "macro-builtin-package-1.0")))
- (unwind-protect
- (let ((load-path load-path))
- (add-to-list 'load-path (directory-file-name dir))
- (byte-recompile-directory dir 0 t)
- (mapc (lambda (f) (call-process "gzip" nil nil nil f))
- (directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))
- (require 'macro-builtin)
- (should (member (expand-file-name "macro-builtin-aux.elc" dir)
- (mapcar #'car load-history)))
- ;; `macro-builtin-func' uses a macro from `macro-aux'.
- (should (equal (macro-builtin-func) '(progn a b)))
- (package-install-file (expand-file-name "macro-builtin-package-2.0/"))
- ;; After upgrading, `macro-builtin-func' depends on a new version
- ;; of the macro from `macro-builtin-aux'.
- (should (equal (macro-builtin-func) '(1 b)))
- ;; `macro-builtin-10-and-90' depends on an entirely new macro from `macro-aux'.
- (should (equal (macro-builtin-10-and-90) '(10 90))))
- (mapc #'delete-file
- (directory-files-recursively dir "\\`[^\\.].*\\.elc\\'"))
- (mapc (lambda (f) (call-process "gunzip" nil nil nil f))
- (directory-files-recursively dir "\\`[^\\.].*\\.el\\.gz\\'"))))))
-
-(ert-deftest package-test-install-two-dependencies ()
- "Install a package which includes a dependency."
- (with-package-test ()
- (package-initialize)
- (package-refresh-contents)
- (package-install 'simple-two-depend)
- (should (package-installed-p 'simple-single))
- (should (package-installed-p 'simple-depend))
- (should (package-installed-p 'simple-two-depend))))
-
-(ert-deftest package-test-refresh-contents ()
- "Parse an \"archive-contents\" file."
- (with-package-test ()
- (package-initialize)
- (package-refresh-contents)
- (should (eq 4 (length package-archive-contents)))))
-
-(ert-deftest package-test-install-single-from-archive ()
- "Install a single package from a package archive."
- (with-package-test ()
- (package-initialize)
- (package-refresh-contents)
- (package-install 'simple-single)))
-
-(ert-deftest package-test-install-prioritized ()
- "Install a lower version from a higher-prioritized archive."
- (with-package-test ()
- (let* ((newer-version (ert-resource-file "newer-versions"))
- (package-archives `(("older" . ,package-test-data-dir)
- ("newer" . ,newer-version)))
- (package-archive-priorities '(("older" . 100))))
-
- (package-initialize)
- (package-refresh-contents)
- (package-install 'simple-single)
-
- (let ((installed (cadr (assq 'simple-single package-alist))))
- (should (version-list-= '(1 3)
- (package-desc-version installed)))))))
-
-(ert-deftest package-test-install-multifile ()
- "Check properties of the installed multi-file package."
- (with-package-test (:basedir (ert-resource-directory) :install '(multi-file))
- (let ((autoload-file
- (expand-file-name "multi-file-autoloads.el"
- (expand-file-name
- "multi-file-0.2.3"
- package-test-user-dir)))
- (installed-files '("dir" "multi-file.info" "multi-file-sub.elc"
- "multi-file-autoloads.el" "multi-file.elc"))
- (autoload-forms '("^(defvar multi-file-custom-var"
- "^(custom-autoload 'multi-file-custom-var"
- "^(autoload 'multi-file-mode"))
- (pkg-dir (file-name-as-directory
- (expand-file-name
- "multi-file-0.2.3"
- package-test-user-dir))))
- (package-refresh-contents)
- (should (package-installed-p 'multi-file))
- (with-temp-buffer
- (insert-file-contents-literally autoload-file)
- (dolist (fn installed-files)
- (should (file-exists-p (expand-file-name fn pkg-dir))))
- (dolist (re autoload-forms)
- (goto-char (point-min))
- (should (re-search-forward re nil t)))))))
-
-\f
-;;; Package Menu tests
-
-(defmacro with-package-menu-test (&rest body)
- "Set up Package Menu (\"*Packages*\") buffer for testing."
- (declare (indent 0) (debug (([&rest form]) body)))
- `(with-package-test ()
- (let ((buf (package-list-packages)))
- (unwind-protect
- (progn ,@body)
- (kill-buffer buf)))))
-
-(ert-deftest package-test-update-listing ()
- "Ensure installed package status is updated."
- (with-package-menu-test
- (search-forward-regexp "^ +simple-single")
- (package-menu-mark-install)
- (package-menu-execute)
- (run-hooks 'post-command-hook)
- (should (package-installed-p 'simple-single))
- (switch-to-buffer "*Packages*")
- (goto-char (point-min))
- (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t))
- (goto-char (point-min))
- (should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t))))
-
-(ert-deftest package-test-list-filter-by-archive ()
- "Ensure package list is filtered correctly by archive version."
- (with-package-menu-test
- ;; TODO: Add another package archive to test filtering, because
- ;; the testing environment currently only has one.
- (package-menu-filter-by-archive "gnu")
- (goto-char (point-min))
- (should (looking-at "^\\s-+multi-file"))
- (should (= (count-lines (point-min) (point-max)) 4))
- (should-error (package-menu-filter-by-archive "non-existent archive"))))
-
-(ert-deftest package-test-list-filter-by-keyword ()
- "Ensure package list is filtered correctly by package keyword."
- (with-package-menu-test
- (package-menu-filter-by-keyword "frobnicate")
- (goto-char (point-min))
- (should (re-search-forward "^\\s-+simple-single" nil t))
- (should (= (count-lines (point-min) (point-max)) 1))
- (should-error (package-menu-filter-by-keyword "non-existent-keyword"))))
-
-(ert-deftest package-test-list-filter-by-name ()
- "Ensure package list is filtered correctly by package name."
- (with-package-menu-test ()
- (package-menu-filter-by-name "ansi-color")
- (goto-char (point-min))
- (should (re-search-forward "^\\s-+ansi-color" nil t))
- (should (= (count-lines (point-min) (point-max)) 1))))
-
-(ert-deftest package-test-list-filter-by-status ()
- "Ensure package list is filtered correctly by package status."
- (with-package-menu-test
- (package-menu-filter-by-status "available")
- (goto-char (point-min))
- (should (re-search-forward "^\\s-+multi-file" nil t))
- (should (= (count-lines (point-min) (point-max)) 4))
- ;; No installed packages in default environment.
- (should-error (package-menu-filter-by-status "installed"))))
-
-(ert-deftest package-test-list-filter-marked ()
- "Ensure package list is filtered correctly by non-empty mark."
- (with-package-test ()
- (package-list-packages)
- (revert-buffer)
- (search-forward-regexp "^ +simple-single")
- (package-menu-mark-install)
- (package-menu-filter-marked)
- (goto-char (point-min))
- (should (re-search-forward "^I +simple-single" nil t))
- (should (= (count-lines (point-min) (point-max)) 1))
- (package-menu-mark-unmark)
- ;; No marked packages in default environment.
- (should-error (package-menu-filter-marked))))
-
-(ert-deftest package-test-list-filter-by-version ()
- (with-package-menu-test
- (should-error (package-menu-filter-by-version "1.1" 'unknown-symbol))) )
-
-(defun package-test-filter-by-version (version predicate name)
- (with-package-menu-test
- (package-menu-filter-by-version version predicate)
- (goto-char (point-min))
- ;; We just check that the given package is included in the
- ;; listing. One could be more ambitious.
- (should (re-search-forward name))))
-
-(ert-deftest package-test-list-filter-by-version-= ()
- "Ensure package list is filtered correctly by package version (=)."
- (package-test-filter-by-version "1.1" '= "^\\s-+simple-two-depend"))
-
-(ert-deftest package-test-list-filter-by-version-< ()
- "Ensure package list is filtered correctly by package version (<)."
- (package-test-filter-by-version "1.2" '< "^\\s-+simple-two-depend"))
-
-(ert-deftest package-test-list-filter-by-version-> ()
- "Ensure package list is filtered correctly by package version (>)."
- (package-test-filter-by-version "1.0" '> "^\\s-+simple-two-depend"))
-
-(ert-deftest package-test-list-clear-filter ()
- "Ensure package list filter is cleared correctly."
- (with-package-menu-test
- (let ((num-packages (count-lines (point-min) (point-max))))
- (package-menu-filter-by-name "ansi-color")
- (should (= (count-lines (point-min) (point-max)) 1))
- (package-menu-clear-filter)
- (should (= (count-lines (point-min) (point-max)) num-packages)))))
-
-(ert-deftest package-test-update-archives ()
- "Test updating package archives."
- (with-package-test ()
- (let ((_buf (package-list-packages)))
- (revert-buffer)
- (search-forward-regexp "^ +simple-single")
- (package-menu-mark-install)
- (package-menu-execute)
- (should (package-installed-p 'simple-single))
- (let ((package-test-data-dir (ert-resource-file "newer-versions")))
- (setq package-archives `(("gnu" . ,package-test-data-dir)))
- (revert-buffer)
-
- ;; New version should be available and old version should be installed
- (goto-char (point-min))
- (should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+available" nil t))
- (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t))
-
- (goto-char (point-min))
- (should (re-search-forward "^\\s-+new-pkg\\s-+1.0\\s-+\\(available\\|new\\)" nil t))
-
- (package-menu-mark-upgrades)
- (package-menu-execute)
- (revert-buffer)
- (should (package-installed-p 'simple-single '(1 4)))))))
-
-(ert-deftest package-test-update-archives-async ()
- "Test updating package archives asynchronously."
- :tags '(:expensive-test)
- (let* ((package-menu-async t)
- (default-directory package-test-data-dir)
- (python-interpreter (seq-some #'executable-find '("python" "python3" "python2")))
- process addr)
- (skip-unless python-interpreter)
- (setq process (start-process
- "package-server" "package-server-buffer"
- python-interpreter
- "package-test-server.py"))
- (unwind-protect
- (progn
- (with-current-buffer "package-server-buffer"
- (should
- (with-timeout (10 nil)
- (while (not addr)
- (accept-process-output nil 1)
- (goto-char (point-min))
- (when (re-search-forward "Server started, \\(.*\\)\n" nil t)
- (setq addr (match-string 1))))
- addr)))
- (with-package-test (:basedir (ert-resource-directory) :location addr)
- (list-packages)
- (should package--downloads-in-progress)
- (should mode-line-process)
- (should-not
- (with-timeout (10 'timeout)
- (while package--downloads-in-progress
- (accept-process-output nil 1))
- nil))
- ;; If the server process died, there's some non-Emacs problem.
- ;; Eg maybe the port was already in use.
- (skip-unless (process-live-p process))
- (goto-char (point-min))
- (should
- (search-forward-regexp "^ +simple-single" nil t))))
- (if (process-live-p process) (kill-process process)))))
-
-(ert-deftest package-test-update-archives/ignore-nil-entry ()
- "Ignore any packages that are nil. Test for Bug#28502."
- (with-package-test ()
- (let* ((with-nil-entry (ert-resource-file "with-nil-entry"))
- (package-archives `(("with-nil-entry" . ,with-nil-entry))))
- (package-initialize)
- (package-refresh-contents)
- (should (equal (length package-archive-contents) 2)))))
-
-(ert-deftest package-test-package-installed-p ()
- "Test package-installed-p before and after package initialization."
- (with-package-test ()
- ;; Verify that `package-installed-p' evaluates true for a built-in
- ;; package, in this case `project', before package initialization.
- (should (not package--initialized))
- (should (package-installed-p 'project nil))
- (should (not (package-installed-p 'imaginary-package nil)))
-
- ;; The results don't change after package initialization.
- (package-initialize)
- (should package--initialized)
- (should (package-installed-p 'project nil))
- (should (not (package-installed-p 'imaginary-package nil)))))
-
-(ert-deftest package-test-describe-package ()
- "Test displaying help for a package."
-
- (require 'finder-inf)
- ;; Built-in
- (with-fake-help-buffer
- (describe-package '5x5)
- (goto-char (point-min))
- (should (search-forward "5x5 is built-in." nil t))
- ;; Don't assume the descriptions are in any particular order.
- (save-excursion (should (search-forward "Status: Built-in." nil t)))
- (save-excursion (should (search-forward "Summary: simple little puzzle game" nil t)))
- (should (search-forward "The aim of 5x5" nil t)))
-
- ;; Installed
- (with-package-test ()
- (package-initialize)
- (package-refresh-contents)
- (package-install 'simple-single)
- (with-fake-help-buffer
- (describe-package 'simple-single)
- (goto-char (point-min))
- (should (search-forward "Package simple-single is installed." nil t))
- (save-excursion (should (re-search-forward "Status: Installed in ['`‘]simple-single-1.3/['’] (unsigned)." nil t)))
- (save-excursion (should (search-forward "Version: 1.3" nil t)))
- (save-excursion (should (search-forward "Summary: A single-file package with no dependencies" nil t)))
- (save-excursion (should (search-forward "Website: http://doodles.au" nil t)))
- (save-excursion (should (re-search-forward "Keywords: \\[?frobnicate\\]?" nil t)))
- (save-excursion (should (search-forward "This package provides a minor mode to frobnicate"
- nil t)))
- )))
-
-(ert-deftest package-test-describe-installed-multi-file-package ()
- "Test displaying of the readme for installed multi-file package."
-
- (with-package-test ()
- (package-initialize)
- (package-refresh-contents)
- (package-install 'multi-file)
- (with-fake-help-buffer
- (describe-package 'multi-file)
- (goto-char (point-min))
- (should (search-forward "Website: http://puddles.li" nil t))
- (should (search-forward "This is a bare-bones readme file for the multi-file"
- nil t)))))
-
-(ert-deftest package-test-describe-non-installed-package ()
- "Test displaying of the readme for non-installed package."
-
- (with-package-test ()
- (package-initialize)
- (package-refresh-contents)
- (with-fake-help-buffer
- (describe-package 'simple-single)
- (goto-char (point-min))
- (should (search-forward "Website: http://doodles.au" nil t))
- (should (search-forward "This package provides a minor mode to frobnicate"
- nil t)))))
-
-(ert-deftest package-test-describe-non-installed-multi-file-package ()
- "Test displaying of the readme for non-installed multi-file package."
-
- (with-package-test ()
- (package-initialize)
- (package-refresh-contents)
- (with-fake-help-buffer
- (describe-package 'multi-file)
- (goto-char (point-min))
- (should (search-forward "Website: http://puddles.li" nil t))
- (should (search-forward "This is a bare-bones readme file for the multi-file"
- nil t)))))
-
-(defvar epg-config--program-alist) ; Silence byte-compiler.
-(ert-deftest package-test-signed ()
- "Test verifying package signature."
- (skip-unless (ert-with-temp-directory homedir
- (let ((process-environment
- (cons (concat "HOME=" homedir)
- process-environment)))
- (require 'epg-config)
- (defvar epg-config--program-alist)
- (epg-find-configuration
- 'OpenPGP nil
- ;; By default we require gpg2 2.1+ due to some
- ;; practical problems with pinentry. But this
- ;; test works fine with 2.0 as well.
- (let ((prog-alist (copy-tree epg-config--program-alist)))
- (setf (alist-get "gpg2"
- (alist-get 'OpenPGP prog-alist)
- nil nil #'equal)
- "2.0")
- prog-alist)))))
- (let* ((keyring (expand-file-name "key.pub" package-test-data-dir))
- (package-test-data-dir (ert-resource-file "signed")))
- (with-package-test ()
- (package-initialize)
- (package-import-keyring keyring)
- (package-refresh-contents)
- (let ((package-check-signature 'allow-unsigned))
- (should (progn (package-install 'signed-good) 'noerror))
- (should-error (package-install 'signed-bad)))
- (package-delete (car (alist-get 'signed-good package-alist)))
- (let ((package-check-signature t))
- (should (progn (package-install 'signed-good) 'noerror))
- (should-error (package-install 'signed-bad)))
- (package-delete (car (alist-get 'signed-good package-alist)))
- (let ((package-check-signature nil))
- (should (progn (package-install 'signed-good) 'noerror))
- (should (progn (package-install 'signed-bad) 'noerror)))
- ;; Check if the installed package status is updated.
- (let ((_buf (package-list-packages)))
- (revert-buffer)
- (should (re-search-forward
- "^\\s-+signed-good\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-"
- nil t))
- (should (string-equal (match-string-no-properties 1) "1.0"))
- (should (string-equal (match-string-no-properties 2) "installed")))
- ;; Check if the package description is updated.
- (with-fake-help-buffer
- (describe-package 'signed-good)
- (goto-char (point-min))
- (should (re-search-forward "Package signed-good is \\(\\S-+\\)\\." nil t))
- (should (string-equal (match-string-no-properties 1) "installed"))
- (should (re-search-forward
- "Status: Installed in ['`‘]signed-good-1.0/['’]."
- nil t))))))
-
-(ert-deftest package-test-get-deps ()
- "Test `package--get-deps' with complex structures."
- (let ((package-alist
- (mapcar (lambda (p) (list (package-desc-name p) p))
- (list simple-single-desc
- simple-depend-desc
- multi-file-desc
- new-pkg-desc
- simple-depend-desc-1
- simple-depend-desc-2)))
- (pkg-cmp #'string-lessp))
- (should
- (equal (sort (package--get-deps '(simple-depend)) pkg-cmp)
- (sort (list 'simple-depend 'simple-single) pkg-cmp)))
- (should
- (equal (sort (package--get-deps '(simple-depend-2)) pkg-cmp)
- (sort (list 'simple-depend-2 'simple-depend-1 'multi-file
- 'simple-depend 'simple-single)
- pkg-cmp)))))
-
-(ert-deftest package-test-sort-by-dependence ()
- "Test `package--sort-by-dependence' with complex structures."
- (let ((package-alist
- (mapcar (lambda (p) (list (package-desc-name p) p))
- (list simple-single-desc
- simple-depend-desc
- multi-file-desc
- new-pkg-desc
- simple-depend-desc-1
- simple-depend-desc-2)))
- (delete-list
- (list simple-single-desc
- simple-depend-desc
- multi-file-desc
- new-pkg-desc
- simple-depend-desc-1
- simple-depend-desc-2)))
- (should
- (equal (package--sort-by-dependence delete-list)
-
- (list simple-depend-desc-2 simple-depend-desc-1 new-pkg-desc
- multi-file-desc simple-depend-desc simple-single-desc)))
- (should
- (equal (package--sort-by-dependence (reverse delete-list))
- (list new-pkg-desc simple-depend-desc-2 simple-depend-desc-1
- multi-file-desc simple-depend-desc simple-single-desc)))))
-
-(provide 'package-test)
-
-;;; package-tests.el ends here
+++ /dev/null
-;;; erc-button-tests.el --- Tests for erc-button -*- lexical-binding:t -*-
-
-;; Copyright (C) 2023-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-;;
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; GNU Emacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-(require 'erc-button)
-
-(require 'ert-x) ; cl-lib
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-tests-common)))
-
-(ert-deftest erc-button-alist--url ()
- (erc-tests-common-init-server-proc "sleep" "1")
- (with-current-buffer (erc--open-target "#chan")
- (let ((verify
- (lambda (p url)
- (should (equal (get-text-property p 'erc-data) (list url)))
- (should (equal (get-text-property p 'mouse-face) 'highlight))
- (should (eq (get-text-property p 'font-lock-face) 'erc-button))
- (should (eq (get-text-property p 'erc-callback)
- 'browse-url-button-open-url)))))
- (goto-char (point-min))
-
- ;; Most common (unbracketed)
- (erc-display-message nil nil (current-buffer)
- "Foo https://example.com bar.")
- (search-forward "https")
- (funcall verify (point) "https://example.com")
-
- ;; The <URL: form> still works despite being removed in ERC 5.6.
- (erc-display-message nil nil (current-buffer)
- "Foo <URL: https://gnu.org> bar.")
- (search-forward "https")
- (funcall verify (point) "https://gnu.org")
-
- ;; Bracketed
- (erc-display-message nil nil (current-buffer) "Foo <ftp://gnu.org> bar.")
- (search-forward "ftp")
- (funcall verify (point) "ftp://gnu.org"))
-
- (when noninteractive
- (kill-buffer))))
-
-(defvar erc-button-tests--form nil)
-(defvar erc-button-tests--some-var nil)
-
-(defun erc-button-tests--form (&rest rest)
- (push rest erc-button-tests--form)
- (apply #'erc-button-add-button rest))
-
-(defun erc-button-tests--erc-button-alist--function-as-form (func)
- (erc-tests-common-init-server-proc "sleep" "1")
-
- (with-current-buffer (erc--open-target "#chan")
- (let* ((erc-button-tests--form nil)
- (entry (list (rx "+1") 0 func #'ignore 0))
- (erc-button-alist (cons entry erc-button-alist)))
-
- (erc-tests-common-display-message nil 'notice (current-buffer)
- "Foo bar baz")
- (erc-tests-common-display-message nil nil (current-buffer) "+1")
- (erc-tests-common-display-message nil 'notice (current-buffer) "Spam")
-
- (should (equal (pop erc-button-tests--form)
- '(53 55 ignore nil ("+1") "\\+1")))
- (should-not erc-button-tests--form)
- (goto-char (point-min))
- (search-forward "+")
- (should (equal (get-text-property (point) 'erc-data) '("+1")))
- (should (equal (get-text-property (point) 'mouse-face) 'highlight))
- (should (eq (get-text-property (point) 'font-lock-face) 'erc-button))
- (should (eq (get-text-property (point) 'erc-callback) 'ignore)))
-
- (when noninteractive
- (kill-buffer))))
-
-(ert-deftest erc-button-alist--function-as-form ()
- (erc-button-tests--erc-button-alist--function-as-form
- #'erc-button-tests--form)
-
- (erc-button-tests--erc-button-alist--function-as-form
- (symbol-function #'erc-button-tests--form))
-
- (erc-button-tests--erc-button-alist--function-as-form
- (lambda (&rest r) (push r erc-button-tests--form)
- (apply #'erc-button-add-button r))))
-
-(defun erc-button-tests--erc-button-alist--nil-form (form)
- (erc-tests-common-init-server-proc "sleep" "1")
-
- (with-current-buffer (erc--open-target "#chan")
- (let* ((erc-button-tests--form nil)
- (entry (list (rx "+1") 0 form #'ignore 0))
- (erc-button-alist (cons entry erc-button-alist)))
-
- (erc-display-message nil 'notice (current-buffer) "Foo bar baz")
- (erc-display-message nil nil (current-buffer) "+1")
- (erc-display-message nil 'notice (current-buffer) "Spam")
- (should-not erc-button-tests--form)
- (goto-char (point-min))
- (search-forward "+")
- (should-not (get-text-property (point) 'erc-data))
- (should-not (get-text-property (point) 'mouse-face))
- (should-not (get-text-property (point) 'font-lock-face))
- (should-not (get-text-property (point) 'erc-callback)))
-
- (when noninteractive
- (kill-buffer))))
-
-(ert-deftest erc-button-alist--nil-form ()
- (erc-button-tests--erc-button-alist--nil-form nil)
- (erc-button-tests--erc-button-alist--nil-form 'erc-button-tests--some-var))
-
-(defun erc-button-tests--insert-privmsg (speaker &rest msg-parts)
- (declare (indent 1))
- (let ((msg (erc-format-privmessage speaker
- (apply #'concat msg-parts) nil t)))
- (erc-display-message nil nil (current-buffer) msg)))
-
-(defun erc-button-tests--populate (test)
- (let ((inhibit-message noninteractive)
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
-
- (with-current-buffer
- (cl-letf
- (((symbol-function 'erc-server-connect)
- (lambda (&rest _)
- (setq erc-server-process
- (start-process "sleep" (current-buffer) "sleep" "1"))
- (set-process-query-on-exit-flag erc-server-process nil))))
-
- (erc-open "localhost" 6667 "tester" "Tester" 'connect
- nil nil nil nil nil "tester" 'foonet))
-
- (with-current-buffer (erc--open-target "#chan")
- (erc-update-channel-member
- "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
-
- (erc-update-channel-member
- "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
-
- (erc-display-message
- nil 'notice (current-buffer)
- (concat "This server is in debug mode and is logging all user I/O. "
- "Blah alice (1) bob (2) blah."))
-
- (funcall test))
-
- (when noninteractive
- (kill-buffer "#chan")
- (kill-buffer)))))
-
-(ert-deftest erc-button-next ()
- (erc-button-tests--populate
- (lambda ()
- (erc-button-tests--insert-privmsg "alice"
- "(3) bob (4) come, you are a tedious fool: to the purpose.")
-
- (erc-button-tests--insert-privmsg "bob"
- "(5) alice (6) Come me to what was done to her.")
-
- (should (= erc-input-marker (point)))
-
- ;; Break out of input area
- (erc-button-previous 1)
- (should (looking-at (rx "alice (6)")))
-
- ;; No next button
- (should-error (erc-button-next 1) :type 'user-error)
- (should (looking-at (rx "alice (6)")))
-
- ;; Next with negative arg is equivalent to previous
- (erc-button-next -1)
- (should (looking-at (rx "bob> (5)")))
-
- ;; One past end of button
- (forward-char 3)
- (should (looking-at (rx "> (5)")))
- (should-not (get-text-property (point) 'erc-callback))
- (erc-button-previous 1)
- (should (looking-at (rx "bob> (5)")))
-
- ;; At end of button
- (forward-char 2)
- (should (looking-at (rx "b> (5)")))
- (erc-button-previous 1)
- (should (looking-at (rx "bob (4)")))
-
- ;; Skip multiple buttons back
- (erc-button-previous 2)
- (should (looking-at (rx "bob (2)")))
-
- ;; Skip multiple buttons forward
- (erc-button-next 2)
- (should (looking-at (rx "bob (4)")))
-
- ;; No error as long as some progress made
- (erc-button-previous 100)
- (should (looking-at (rx "alice (1)")))
-
- ;; Error when no progress made
- (should-error (erc-button-previous 1) :type 'user-error)
- (should (looking-at (rx "alice (1)"))))))
-
-;; See also `erc-scenarios-networks-announced-missing' in
-;; erc-scenarios-misc.el for a more realistic example.
-(ert-deftest erc-button--display-error-notice-with-keys ()
- (with-current-buffer (get-buffer-create "*fake*")
- (let ((mode erc-button-mode)
- (inhibit-message noninteractive)
- erc-modules
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
- (erc-tests-common-prep-for-insertion)
- (erc-tests-common-init-server-proc "sleep" "1")
-
- (erc-button-mode +1)
- (should (equal (erc-button--display-error-notice-with-keys
- "If \\[erc-bol] fails, "
- "see \\[erc-bug] or `erc-mode-map'.")
- "*** If C-a fails, see M-x erc-bug or `erc-mode-map'."))
- (goto-char (point-min))
-
- (ert-info ("Keymap substitution succeeds")
- (erc-button-next 1)
- (should (looking-at "C-a"))
- (should (eq (get-text-property (point) 'mouse-face) 'highlight))
- (erc-button-press-button)
- (with-current-buffer "*Help*"
- (goto-char (point-min))
- (should (search-forward "erc-bol" nil t)))
- (erc-button-next 1)
- ;; End of interval correct
- (erc-button-previous 1)
- (should (looking-at "C-a fails")))
-
- (ert-info ("Extended command mapping succeeds")
- (erc-button-next 1)
- (should (looking-at "M-x erc-bug"))
- (erc-button-press-button)
- (should (eq (get-text-property (point) 'mouse-face) 'highlight))
- (with-current-buffer "*Help*"
- (goto-char (point-min))
- (should (search-forward "erc-bug" nil t))))
-
- (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k
- (erc-button-next 1)
- (should (equal (get-text-property (point) 'font-lock-face)
- '(erc-button erc-error-face erc-notice-face)))
- (should (eq (get-text-property (point) 'mouse-face) 'highlight))
- (should (eq erc-button-face 'erc-button))) ; extent evaporates
-
- (ert-info ("Format when trailing args include non-strings")
- (should (equal (erc-button--display-error-notice-with-keys
- "abc" " %d def" " 45%s" 123 '\6)
- "*** abc 123 def 456")))
-
- (ert-info ("Respects buffer as first argument when given")
- (should (equal (erc-button--display-error-notice-with-keys
- (make-erc-response) "abc") ; compat
- "*** abc"))
- (should (equal (erc-button--display-error-notice-with-keys
- (current-buffer) "abc")
- "*** abc")))
-
- (ert-info ("Accounts for nil members when concatenating")
- (should (equal (erc-button--display-error-notice-with-keys
- "a" nil)
- "*** a"))
- (should (equal (erc-button--display-error-notice-with-keys
- "a" nil " b")
- "*** a b"))
- (should (equal (erc-button--display-error-notice-with-keys
- "a: %d" nil 1)
- "*** a: 1"))
- (should (equal (erc-button--display-error-notice-with-keys
- "a: %d %s" 1 nil)
- "*** a: 1 nil"))
- (should (equal (erc-button--display-error-notice-with-keys
- "a: " "%d %s" 1 nil)
- "*** a: 1 nil"))
- (should (equal (erc-button--display-error-notice-with-keys
- "a: " nil "%d %s" 1 nil)
- "*** a: 1 nil")))
-
- (when noninteractive
- (unless mode
- (erc-button-mode -1))
- (kill-buffer "*Help*")
- (kill-buffer)))))
-
-;;; erc-button-tests.el ends here
+++ /dev/null
-;;; erc-dcc-tests.el --- Tests for erc-dcc -*- lexical-binding:t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-;;
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; GNU Emacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-(require 'ert-x)
-(require 'erc-dcc)
-(require 'erc-pcomplete)
-
-(ert-deftest erc-dcc-ctcp-query-send-regexp ()
- (let ((s "DCC SEND \"file name\" 2130706433 9899 1405135128"))
- (should (string-match erc-dcc-ctcp-query-send-regexp s))
- (should-not (match-string 2 s))
- (should (string= "file name" (match-string 1 s)))
- (should (string= "SEND" (match-string 6 s))))
- (let ((s "DCC SEND \"file \\\" name\" 2130706433 9899 1405135128"))
- (should (string-match erc-dcc-ctcp-query-send-regexp s))
- (should-not (match-string 2 s))
- (should (string= "SEND" (match-string 6 s)))
- (should (string= "file \" name"
- (erc-dcc-unquote-filename (match-string 1 s)))))
- (let ((s "DCC SEND filename 2130706433 9899 1405135128"))
- (should (string-match erc-dcc-ctcp-query-send-regexp s))
- (should (string= "filename" (match-string 2 s)))
- (should (string= "2130706433" (match-string 3 s)))
- (should (string= "9899" (match-string 4 s)))
- (should (string= "1405135128" (match-string 5 s))))
- (let ((s "DCC TSEND filename 2130706433 9899 1405135128"))
- (should (string-match erc-dcc-ctcp-query-send-regexp s))
- (should (string= "TSEND" (match-string 6 s)))))
-
-;; This also indirectly tests base functionality for
-;; `erc-dcc-do-LIST-command'
-
-(defun erc-dcc-tests--dcc-handle-ctcp-send (turbo)
- (let (erc-send-completed-hook
- erc-insert-modify-hook
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
- (with-current-buffer (get-buffer-create "fake-server")
- (erc-mode)
- (setq erc-server-process
- (start-process "fake" (current-buffer) "sleep" "10")
- erc-server-current-nick "dummy")
- (erc--initialize-markers (point) nil)
- (set-process-query-on-exit-flag erc-server-process nil)
- (should-not erc-dcc-list)
- (erc-ctcp-query-DCC erc-server-process
- "tester"
- "~tester"
- "fake.irc"
- "dummy"
- (concat "DCC " (if turbo "TSEND" "SEND")
- " foo 2130706433 9899 1405135128"))
- (should-not (cdr erc-dcc-list))
- (should (equal (plist-put (car erc-dcc-list) :parent 'fake)
- `(:nick "tester!~tester@fake.irc"
- :type GET
- :peer nil
- :parent fake
- :ip "127.0.0.1"
- :port "9899"
- :file "foo"
- :size 1405135128
- :turbo ,(and turbo t)
- :secure nil)))
- (goto-char (point-min))
- (should (search-forward "file foo offered by tester" nil t))
- (erc-dcc-do-LIST-command erc-server-process)
- (should (search-forward-regexp (concat
- "GET +no +1405135128 +foo"
- (and turbo " +(T)") "$")
- nil t))
- (when noninteractive
- (kill-buffer))))
- ;; `erc-dcc-list' is global; must leave it empty
- (should erc-dcc-list)
- (setq erc-dcc-list nil))
-
-(ert-deftest erc-dcc-handle-ctcp-send--base ()
- (erc-dcc-tests--dcc-handle-ctcp-send nil))
-
-(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 nuh)
- (unless nuh (setq nuh "tester!~tester@fake.irc"))
- (with-temp-buffer
- (let* ((proc (start-process "fake" (current-buffer) "sleep" "10"))
- (elt (list :nick nuh
- :type 'GET
- :peer nil
- :parent proc
- :ip "127.0.0.1"
- :port "9899"
- :file file
- :size 1405135128))
- (nic (erc-extract-nick nuh))
- (erc-dcc-list (list elt))
- ;;
- erc-accidental-paste-threshold-seconds
- erc-insert-modify-hook erc-send-completed-hook
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook
- calls)
- (erc-mode)
- (setq erc-server-process proc
- erc-server-current-nick "dummy")
- (erc--initialize-markers (point) nil)
- (set-process-query-on-exit-flag proc nil)
- (cl-letf (((symbol-function 'read-file-name)
- (lambda (&rest _) file))
- ((symbol-function 'erc-dcc-get-file)
- (lambda (&rest r) (push r calls))))
- (goto-char (point-max))
-
- (ert-info ("No turbo")
- (should-not (plist-member elt :turbo))
- (goto-char erc-input-marker)
- (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))))
-
- (ert-info ("Arg turbo in pos 2")
- (should-not (plist-member elt :turbo))
- (goto-char erc-input-marker)
- (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))))
-
- (ert-info ("Arg turbo in pos 4")
- (setq elt (plist-put elt :turbo nil)
- erc-dcc-list (list elt))
- (goto-char erc-input-marker)
- (insert "/dcc GET " 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))))
-
- (ert-info ("Arg turbo in pos 6")
- (setq elt (plist-put elt :turbo nil)
- erc-dcc-list (list elt))
- (goto-char erc-input-marker)
- (insert "/dcc GET " 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)))))))))
-
-(ert-deftest erc-dcc-do-GET-command ()
- (erc-dcc-tests--erc-dcc-do-GET-command "foo.bin")
- (erc-dcc-tests--erc-dcc-do-GET-command "foo - file.bin")
- (erc-dcc-tests--erc-dcc-do-GET-command "foo -t file.bin")
- (erc-dcc-tests--erc-dcc-do-GET-command "-t" "-- ")
-
- ;; 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*")
- (let* ((inhibit-message noninteractive)
- (proc (start-process "fake" (current-buffer) "sleep" "10"))
- (elt (list :nick "tester!~tester@fake.irc"
- :type 'GET
- :peer nil
- :parent proc
- :ip "127.0.0.1"
- :port "9899"
- :file (or file "foo.bin")
- :size 1405135128))
- ;;
- erc-accidental-paste-threshold-seconds
- erc-insert-modify-hook erc-send-completed-hook
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
- (erc-mode)
- (pcomplete-erc-setup)
- (add-hook 'erc-complete-functions #'erc-pcompletions-at-point 0 t)
- (setq erc-server-process proc
- erc-input-marker (make-marker)
- erc-insert-marker (make-marker)
- erc-server-current-nick "dummy")
- (setq-local erc-dcc-list (list elt)) ; for interactive noodling
- (set-process-query-on-exit-flag proc nil)
- (goto-char (point-max))
- (set-marker erc-insert-marker (point-max))
- (erc-display-prompt)
- (goto-char erc-input-marker)
- (funcall test-fn))
- (when noninteractive
- (kill-buffer))))
-
-(ert-deftest pcomplete/erc-mode/DCC--get-basic ()
- (erc-dcc-tests--pcomplete-common
- (lambda ()
- (insert "/dcc get ")
- (call-interactively #'completion-at-point)
- (save-excursion
- (beginning-of-line)
- (should (search-forward "/dcc get tester" nil t)))
- (call-interactively #'completion-at-point)
- (save-excursion
- (beginning-of-line)
- (should (search-forward "/dcc get tester foo.bin" nil t))))))
-
-(ert-deftest pcomplete/erc-mode/DCC--get-quoted ()
- (erc-dcc-tests--pcomplete-common
- (lambda ()
- (insert "/dcc get ")
- (call-interactively #'completion-at-point)
- (save-excursion
- (beginning-of-line)
- (should (search-forward "/dcc get tester" nil t)))
- (call-interactively #'completion-at-point)
- (save-excursion
- (beginning-of-line)
- (should (search-forward "/dcc get tester \"foo bar.bin\"" nil t))))
- "foo bar.bin"))
-
-(ert-deftest pcomplete/erc-mode/DCC--get-1flag ()
- (erc-dcc-tests--pcomplete-common
- (lambda ()
- (goto-char erc-input-marker)
- (delete-region (point) (point-max))
- (insert "/dcc get -")
- (call-interactively #'completion-at-point)
- (with-current-buffer "*Completions*"
- (goto-char (point-min))
- (search-forward "-s")
- (search-forward "-t"))
- (insert "s ")
- (call-interactively #'completion-at-point)
- (save-excursion
- (beginning-of-line)
- (should (search-forward "/dcc get -s tester" nil t)))
- (call-interactively #'completion-at-point)
- (save-excursion
- (beginning-of-line)
- (should (search-forward "/dcc get -s tester foo.bin" nil t))))))
-
-(ert-deftest pcomplete/erc-mode/DCC--get-2flags ()
- (erc-dcc-tests--pcomplete-common
- (lambda ()
- (goto-char erc-input-marker)
- (delete-region (point) (point-max))
- (insert "/dcc get -")
- (call-interactively #'completion-at-point)
- (with-current-buffer "*Completions*"
- (goto-char (point-min))
- (search-forward "-s")
- (search-forward "-t"))
- (insert "s -")
- (call-interactively #'completion-at-point)
- (save-excursion
- (beginning-of-line)
- (should (search-forward "/dcc get -s -t " nil t)))
- (call-interactively #'completion-at-point)
- (save-excursion
- (beginning-of-line)
- (should (search-forward "/dcc get -s -t tester" nil t)))
- (call-interactively #'completion-at-point)
- (save-excursion
- (beginning-of-line)
- (should (search-forward "/dcc get -s -t tester foo.bin" nil t))))))
-
-(ert-deftest pcomplete/erc-mode/DCC--get-2flags-reverse ()
- (erc-dcc-tests--pcomplete-common
- (lambda ()
- (goto-char erc-input-marker)
- (delete-region (point) (point-max))
- (insert "/dcc get -")
- (call-interactively #'completion-at-point)
- (with-current-buffer "*Completions*"
- (goto-char (point-min))
- (search-forward "-s")
- (search-forward "-t"))
- (insert "t -")
- (call-interactively #'completion-at-point)
- (save-excursion
- (beginning-of-line)
- (should (search-forward "/dcc get -t -s " nil t)))
- (call-interactively #'completion-at-point)
- (save-excursion
- (beginning-of-line)
- (should (search-forward "/dcc get -t -s tester" nil t)))
- (call-interactively #'completion-at-point)
- (save-excursion
- (beginning-of-line)
- (should (search-forward "/dcc get -t -s tester foo.bin" nil t))))))
-
-(ert-deftest pcomplete/erc-mode/DCC--get-sep ()
- (erc-dcc-tests--pcomplete-common
- (lambda ()
- (insert "/dcc get ")
- (call-interactively #'completion-at-point)
- (save-excursion
- (beginning-of-line)
- (should (search-forward "/dcc get tester" nil t)))
- (insert "-")
- (call-interactively #'completion-at-point)
- (save-excursion
- (beginning-of-line)
- (should (search-forward "/dcc get tester -- " nil t)))
- (call-interactively #'completion-at-point)
- (save-excursion
- (beginning-of-line)
- (should (search-forward "/dcc get tester -- -t" nil t))))
- "-t"))
-
-;;; erc-dcc-tests.el ends here
+++ /dev/null
-;;; erc-fill-tests.el --- Tests for erc-fill -*- lexical-binding:t -*-
-
-;; Copyright (C) 2023-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-;;
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; GNU Emacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; FIXME these tests are brittle and error prone. Replace with
-;; scenarios.
-
-;;; Code:
-(require 'erc-fill)
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-tests-common)))
-
-(defvar erc-fill-tests--buffers nil)
-(defvar erc-fill-tests--current-time-value nil)
-
-(cl-defmethod erc-stamp--current-time
- (&context (erc-fill-tests--current-time-value integer))
- erc-fill-tests--current-time-value)
-
-(defun erc-fill-tests--insert-privmsg (speaker &rest msg-parts)
- (declare (indent 1))
- (let* ((erc--msg-prop-overrides `((erc--msg . msg)))
- (msg (erc-format-privmessage speaker
- (apply #'concat msg-parts) nil t))
- (parsed (make-erc-response :unparsed (format ":%s PRIVMSG #chan :%s"
- speaker msg)
- :sender speaker
- :command "PRIVMSG"
- :command-args (list "#chan" msg)
- :contents msg)))
- (erc-tests-common-display-message parsed nil (current-buffer) msg)))
-
-(defun erc-fill-tests--wrap-populate (test)
- (let ((original-window-buffer (window-buffer (selected-window)))
- (erc-fill--wrap-scrolltobottom-exempt-p t)
- (erc-stamp--tz t)
- (erc-fill-function 'erc-fill-wrap)
- (pre-command-hook pre-command-hook)
- (inhibit-message noninteractive)
- (erc-fill-tests--current-time-value 0)
- erc-insert-post-hook
- extended-command-history
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
- (cl-letf (((symbol-function 'erc-server-connect)
- (lambda (&rest _)
- (erc-tests-common-init-server-proc "sleep" "1"))))
- (with-current-buffer
- (car (push (erc-open "localhost" 6667 "tester" "Tester" 'connect
- nil nil nil nil nil "tester" 'foonet)
- erc-fill-tests--buffers))
- (setq erc-network 'foonet
- erc-server-connected t)
- (with-current-buffer (erc--open-target "#chan")
- (set-window-buffer (selected-window) (current-buffer))
-
- (erc-update-channel-member
- "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
-
- (erc-update-channel-member
- "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
-
- (erc-tests-common-display-message
- nil 'notice (current-buffer)
- (concat "This server is in debug mode and is logging all user I/O. "
- "If you do not wish for everything you send to be readable "
- "by the server owner(s), please disconnect."))
-
- (erc-fill-tests--insert-privmsg "alice"
- "bob: come, you are a tedious fool: to the purpose. "
- "What was done to Elbow's wife, that he hath cause to complain of?"
- " Come me to what was done to her.")
-
- ;; Introduce an artificial gap in properties `line-prefix' and
- ;; `wrap-prefix' and later ensure they're not incremented twice.
- (save-excursion
- (forward-line -1)
- (search-forward "? ")
- (with-silent-modifications
- (remove-text-properties (1- (point)) (point)
- '(line-prefix t wrap-prefix t))))
-
- (erc-fill-tests--insert-privmsg "bob"
- "alice: Either your unparagoned mistress is dead, "
- "or she's outprized by a trifle.")
-
- ;; Defend against non-local exits from `ert-skip'
- (unwind-protect
- (funcall test)
- (when set-transient-map-timer
- (timer-event-handler set-transient-map-timer))
- (set-window-buffer (selected-window) original-window-buffer)
- (when (or noninteractive (getenv "ERC_TESTS_GRAPHICAL"))
- (erc-tests-common-kill-buffers erc-fill-tests--buffers)
- (setq erc-fill-tests--buffers nil))))))))
-
-(defun erc-fill-tests--wrap-check-prefixes (&rest prefixes)
- ;; Check that prefix props are applied over correct intervals.
- (save-excursion
- (goto-char (point-min))
- (dolist (prefix prefixes)
- (should (search-forward prefix nil t))
- (should (get-text-property (pos-bol) 'line-prefix))
- (should (get-text-property (1- (pos-eol)) 'line-prefix))
- (should-not (get-text-property (pos-eol) 'line-prefix))
- ;; Spans entire line uninterrupted.
- (let* ((val (get-text-property (pos-bol) 'line-prefix))
- (end (text-property-not-all (pos-bol) (point-max)
- 'line-prefix val)))
- (when (and (/= end (pos-eol)) (= ?? (char-before end)))
- (setq end (text-property-not-all (1+ end) (point-max)
- 'line-prefix val)))
- (should (eq end (pos-eol))))
- (should (equal (get-text-property (pos-bol) 'wrap-prefix)
- '(space :width erc-fill--wrap-value)))
- (should-not (get-text-property (pos-eol) 'wrap-prefix))
- (should (equal (get-text-property (1- (pos-eol)) 'wrap-prefix)
- '(space :width erc-fill--wrap-value))))))
-
-;; On graphical displays, echo .graphic >> .git/info/exclude
-(defvar erc-fill-tests--graphic-dir "fill/snapshots/.graphic/")
-
-(defun erc-fill-tests--compare (name)
- (let ((dir (expand-file-name (if (display-graphic-p)
- erc-fill-tests--graphic-dir
- "fill/snapshots/" )
- (ert-resource-directory)))
- (transform-fn (lambda (got)
- (string-replace "erc-fill--wrap-value"
- (number-to-string erc-fill--wrap-value)
- got)))
- (buffer-setup-fn (lambda ()
- (push (current-buffer) erc-fill-tests--buffers))))
- (erc-tests-common-snapshot-compare name dir transform-fn buffer-setup-fn)))
-
-;; To inspect variable pitch, set `erc-mode-hook' to
-;;
-;; (lambda () (face-remap-add-relative 'default :family "Sans Serif"))
-;;
-;; or similar.
-
-(ert-deftest erc-fill-wrap--monospace ()
- :tags `(:unstable
- ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical)))
- (unless (>= emacs-major-version 29)
- (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
-
- (let ((erc-prompt (lambda () "ABC>")))
- (erc-fill-tests--wrap-populate
-
- (lambda ()
- (should (= erc-fill--wrap-value 27))
- (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
- (erc-fill-tests--compare "monospace-01-start")
-
- (ert-info ("Shift right by one (plus)")
- ;; Args are all `erc-fill-wrap-nudge' +1 because interactive "p"
- (ert-with-message-capture messages
- ;; M-x erc-fill-wrap-nudge RET =
- (ert-simulate-command '(erc-fill-wrap-nudge 2))
- (should (string-match (rx "for further adjustment") messages)))
- (should (= erc-fill--wrap-value 29))
- (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
- (erc-fill-tests--compare "monospace-02-right"))
-
- (ert-info ("Shift left by five")
- ;; "M-x erc-fill-wrap-nudge RET -----"
- (ert-simulate-command '(erc-fill-wrap-nudge -4))
- (should (= erc-fill--wrap-value 25))
- (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
- (erc-fill-tests--compare "monospace-03-left"))
-
- (ert-info ("Reset")
- ;; M-x erc-fill-wrap-nudge RET 0
- (ert-simulate-command '(erc-fill-wrap-nudge 0))
- (should (= erc-fill--wrap-value 27))
- (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
- (erc-fill-tests--compare "monospace-04-reset"))
-
- (erc--assert-input-bounds)))))
-
-(defun erc-fill-tests--simulate-refill ()
- ;; Simulate `erc-fill-wrap-refill-buffer' synchronously and without
- ;; a progress reporter.
- (save-excursion
- (with-silent-modifications
- (erc-fill--wrap-rejigger-region (point-min) erc-insert-marker nil nil))))
-
-(ert-deftest erc-fill-wrap--merge ()
- :tags `(:unstable
- ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical)))
- (unless (>= emacs-major-version 29)
- (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
-
- (erc-fill-tests--wrap-populate
-
- (lambda ()
- (erc-update-channel-member
- "#chan" "Dummy" "Dummy" t nil nil nil nil nil "fake" "~u" nil nil t)
-
- ;; Set this here so that the first few messages are from 1970.
- ;; Following the current date stamp, the speaker isn't merged
- ;; even though it's continued: "<bob> zero."
- (let ((erc-fill-tests--current-time-value 1680332400))
- (erc-fill-tests--insert-privmsg "bob" "zero.")
- (erc-fill-tests--insert-privmsg "alice" "one.")
- (erc-fill-tests--insert-privmsg "alice" "two.")
- (erc-fill-tests--insert-privmsg "bob" "three.")
- (erc-fill-tests--insert-privmsg "bob" "four.")
- (erc-fill-tests--insert-privmsg "Dummy" "five.")
- (erc-fill-tests--insert-privmsg "Dummy" "six."))
-
- (should (= erc-fill--wrap-value 27))
- (erc-fill-tests--wrap-check-prefixes
- "*** " "<alice> " "<bob> "
- "<bob> " "<alice> " "<alice> " "<bob> " "<bob> " "<Dummy> " "<Dummy> ")
- (erc-fill-tests--compare "merge-01-start")
-
- (ert-info ("Shift right by one (plus)")
- (ert-simulate-command '(erc-fill-wrap-nudge 2))
- (should (= erc-fill--wrap-value 29))
- (erc-fill-tests--wrap-check-prefixes
- "*** " "<alice> " "<bob> "
- "<bob> " "<alice> " "<alice> " "<bob> " "<bob> " "<Dummy> " "<Dummy> ")
- (erc-fill-tests--compare "merge-02-right")
-
- (ert-info ("Command `erc-fill-wrap-refill-buffer' is idempotent")
- (kill-buffer (pop erc-fill-tests--buffers))
- (erc-fill-tests--simulate-refill) ; idempotent
- (erc-fill-tests--compare "merge-02-right"))))))
-
-(defun erc-fill-wrap-tests--merge-action (compare-file)
- (unless (>= emacs-major-version 29)
- (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
-
- (erc-fill-tests--wrap-populate
-
- (lambda ()
- ;; Allow prior messages to be from 1970.
- (let ((erc-fill-tests--current-time-value 1680332400))
- (erc-fill-tests--insert-privmsg "bob" "zero.")
- (erc-fill-tests--insert-privmsg "bob" "0.5")
-
- (erc-tests-common-with-date-aware-display-message
- (erc-process-ctcp-query
- erc-server-process
- (make-erc-response
- :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION one.\1"
- :sender "bob!~u@fake"
- :command "PRIVMSG"
- :command-args '("#chan" "\1ACTION one.\1")
- :contents "\1ACTION one.\1")
- "bob" "~u" "fake"))
-
- (erc-fill-tests--insert-privmsg "bob" "two.")
- (erc-fill-tests--insert-privmsg "bob" "2.5")
-
- ;; Compat switch to opt out of overhanging speaker.
- (erc-tests-common-with-date-aware-display-message
- (let (erc-fill--wrap-action-dedent-p)
- (erc-process-ctcp-query
- erc-server-process
- (make-erc-response
- :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION three\1"
- :sender "bob!~u@fake" :command "PRIVMSG"
- :command-args '("#chan" "\1ACTION three\1")
- :contents "\1ACTION three\1")
- "bob" "~u" "fake")))
-
- (erc-fill-tests--insert-privmsg "bob" "four."))
-
- (should (= erc-fill--wrap-value 27))
- (erc-fill-tests--wrap-check-prefixes
- "*** " "<alice> " "<bob> " "<bob> " "* bob " "<bob> " "* " "<bob> ")
- (erc-fill-tests--compare compare-file))))
-
-(ert-deftest erc-fill-wrap--merge-action ()
- :tags `(:unstable
- ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical)))
- (erc-fill-wrap-tests--merge-action "merge-wrap-01"))
-
-(ert-deftest erc-fill-wrap--merge-action/indicator-pre ()
- :tags `(:unstable
- ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical)))
- (let ((erc-fill-wrap-merge-indicator '(?> . shadow)))
- (erc-fill-wrap-tests--merge-action "merge-wrap-indicator-pre-01")))
-
-(ert-deftest erc-fill-line-spacing ()
- :tags `(:unstable
- ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical)))
- (unless (>= emacs-major-version 29)
- (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
-
- (let ((erc-fill-line-spacing 0.5))
- (erc-fill-tests--wrap-populate
- (lambda ()
- (erc-fill-tests--insert-privmsg "bob" "This buffer is for text.")
- (erc-tests-common-display-message nil 'notice
- (current-buffer) "one two three")
- (erc-tests-common-display-message nil 'notice
- (current-buffer) "four five six")
- (erc-fill-tests--insert-privmsg "bob" "Somebody stop me")
- (erc-fill-tests--compare "spacing-01-mono")))))
-
-(ert-deftest erc-fill-wrap-visual-keys--body ()
- :tags `(:unstable
- ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical)))
- (erc-fill-tests--wrap-populate
-
- (lambda ()
- (ert-info ("Value: non-input")
- (should (eq erc-fill--wrap-visual-keys 'non-input))
- (goto-char (point-min))
- (should (search-forward "that he hath" nil t))
- (execute-kbd-macro "\C-a")
- (should-not (looking-at (rx "<alice> ")))
- (execute-kbd-macro "\C-e")
- (should (search-backward "tedious fool" nil t))
- (should-not (looking-back "done to her\\."))
- (forward-char)
- (execute-kbd-macro "\C-e")
- (should (search-forward "done to her." nil t)))
-
- (ert-info ("Value: nil")
- (call-interactively #'erc-fill-wrap-cycle-visual-movement)
- (should-not erc-fill--wrap-visual-keys)
- (goto-char (point-min))
- (should (search-forward "in debug mode" nil t))
- (execute-kbd-macro "\C-a")
- (should (looking-at (rx "*** ")))
- (execute-kbd-macro "\C-e")
- (should (eql ?\] (char-before (point)))))
-
- (ert-info ("Value: t")
- (call-interactively #'erc-fill-wrap-cycle-visual-movement)
- (should (eq erc-fill--wrap-visual-keys t))
- (goto-char (point-min))
- (should (search-forward "that he hath" nil t))
- (execute-kbd-macro "\C-a")
- (should-not (looking-at (rx "<alice> ")))
- (should (search-backward "tedious fool" nil t))
- (execute-kbd-macro "\C-e")
- (should-not (looking-back (rx "done to her\\.")))
- (should (search-forward "done to her." nil t))
- (execute-kbd-macro "\C-a")
- (should-not (looking-at (rx "<alice> ")))))))
-
-(ert-deftest erc-fill-wrap-visual-keys--prompt ()
- :tags `(:unstable
- ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical)))
- (erc-fill-tests--wrap-populate
-
- (lambda ()
- (set-window-buffer (selected-window) (current-buffer))
- (goto-char erc-input-marker)
- (insert "This buffer is for text that is not saved, and for Lisp "
- "evaluation. To create a file, visit it with C-x C-f and "
- "enter text in its buffer.")
-
- (ert-info ("Value: non-input")
- (should (eq erc-fill--wrap-visual-keys 'non-input))
- (execute-kbd-macro "\C-a")
- (should (looking-at "This buffer"))
- (execute-kbd-macro "\C-e")
- (should (looking-back "its buffer\\."))
- (execute-kbd-macro "\C-a")
- (execute-kbd-macro "\C-k")
- (should (eobp)))
-
- (ert-info ("Value: nil") ; same
- (call-interactively #'erc-fill-wrap-cycle-visual-movement)
- (should-not erc-fill--wrap-visual-keys)
- (execute-kbd-macro "\C-y")
- (should (looking-back "its buffer\\."))
- (execute-kbd-macro "\C-a")
- (should (looking-at "This buffer"))
- (execute-kbd-macro "\C-k")
- (should (eobp)))
-
- (ert-info ("Value: non-input")
- (call-interactively #'erc-fill-wrap-cycle-visual-movement)
- (should (eq erc-fill--wrap-visual-keys t))
- (execute-kbd-macro "\C-y")
- (execute-kbd-macro "\C-a")
- (should-not (looking-at "This buffer"))
- (execute-kbd-macro "\C-p")
- (should-not (looking-back "its buffer\\."))
- (should (search-forward "its buffer." nil t))
- (should (search-backward "ERC> " nil t))
- (execute-kbd-macro "\C-a")))))
-
-(ert-deftest erc-fill--left-hand-stamps ()
- :tags `(:unstable
- ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical)))
- (unless (>= emacs-major-version 29)
- (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
-
- (let ((erc-timestamp-only-if-changed-flag nil)
- (erc-insert-timestamp-function #'erc-insert-timestamp-left))
- (erc-fill-tests--wrap-populate
- (lambda ()
- (should (= 8 left-margin-width))
- (pcase-let ((`((margin left-margin) ,displayed)
- (get-text-property erc-insert-marker 'display)))
- (should (equal-including-properties
- displayed #(" ERC>" 4 8
- ( read-only t
- front-sticky t
- field erc-prompt
- erc-prompt t
- rear-nonsticky t
- font-lock-face erc-prompt-face)))))
- (erc-fill-tests--compare "stamps-left-01")
-
- (ert-info ("Shrink left margin by 1 col")
- (erc-stamp--adjust-margin -1)
- (with-silent-modifications (erc--refresh-prompt))
- (should (= 7 left-margin-width))
- (pcase-let ((`((margin left-margin) ,displayed)
- (get-text-property erc-insert-marker 'display)))
- (should (equal-including-properties
- displayed #(" ERC>" 3 7
- ( read-only t
- front-sticky t
- field erc-prompt
- erc-prompt t
- rear-nonsticky t
- font-lock-face erc-prompt-face))))))))))
-
-(ert-deftest erc-fill--wrap-massage-legacy-indicator-type ()
- (let (calls
- erc-fill-wrap-merge-indicator)
- (cl-letf (((symbol-function 'erc--warn-once-before-connect)
- (lambda (_ &rest args) (push args calls))))
- ;; List of (pre CHAR FACE) becomes (CHAR . FACE).
- (let ((erc-fill-wrap-merge-indicator
- '(pre #xb7 erc-fill-wrap-merge-indicator-face)))
- (erc-fill--wrap-massage-legacy-indicator-type)
- (should (equal erc-fill-wrap-merge-indicator
- '(#xb7 . erc-fill-wrap-merge-indicator-face)))
- (should (string-search "(pre CHAR FACE)" (nth 1 (pop calls)))))
-
- ;; Cons of (CHAR . STRING) becomes STRING.
- (let ((erc-fill-wrap-merge-indicator '(pre . "\u00b7")))
- (erc-fill--wrap-massage-legacy-indicator-type)
- (should (equal erc-fill-wrap-merge-indicator "\u00b7"))
- (should (string-search "(pre . STRING)" (nth 1 (pop calls)))))
-
- ;; Anything with a CAR of `post' becomes nil.
- (let ((erc-fill-wrap-merge-indicator
- '(post #xb6 erc-fill-wrap-merge-indicator-face)))
- (erc-fill--wrap-massage-legacy-indicator-type)
- (should-not erc-fill-wrap-merge-indicator)
- (should (string-search "no longer available" (nth 1 (pop calls)))))
- (let ((erc-fill-wrap-merge-indicator '(post . "\u00b7")))
- (erc-fill--wrap-massage-legacy-indicator-type)
- (should-not erc-fill-wrap-merge-indicator)
- (should (string-search "no longer available" (nth 1 (pop calls))))))))
-
-;;; erc-fill-tests.el ends here
+++ /dev/null
-;;; erc-goodies-tests.el --- Tests for erc-goodies -*- lexical-binding:t -*-
-
-;; Copyright (C) 2023-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-;;
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; GNU Emacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;; Code:
-(require 'erc-goodies)
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-tests-common)))
-
-(defun erc-goodies-tests--assert-face (beg end-str present &optional absent)
- (setq beg (+ beg (point-min)))
- (let ((end (+ beg (1- (length end-str)))))
- (ert-info ((format "beg: %S, end-str: %S" beg end-str))
- (while (and beg (< beg end))
- (let* ((val (get-text-property beg 'font-lock-face))
- (ft (flatten-tree (ensure-list val))))
- (ert-info ((format "looking-at: %S, val: %S"
- (buffer-substring-no-properties beg end)
- val))
- (dolist (p (ensure-list present))
- (if (consp p)
- (should (member p val))
- (should (memq p ft))))
- (dolist (a (ensure-list absent))
- (if (consp a)
- (should-not (member a val))
- (should-not (memq a ft)))))
- (setq beg (text-property-not-all beg (point-max)
- 'font-lock-face val)))))))
-
-;; These are from the "Examples" section of
-;; https://modern.ircdocs.horse/formatting.html
-
-(ert-deftest erc-controls-highlight--examples ()
- (should (eq t erc-interpret-controls-p))
- (let ((erc-insert-modify-hook '(erc-controls-highlight))
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
- (with-current-buffer (get-buffer-create "#chan")
- (erc-mode)
- (setq-local erc-interpret-mirc-color t)
- (erc--initialize-markers (point) nil)
-
- (let* ((m "I love \C-c3IRC!\C-c It is the \C-c7best protocol ever!")
- (msg (erc-format-privmessage "bob" m nil t)))
- (erc-display-message nil nil (current-buffer) msg))
- (forward-line -1)
- (should (search-forward "<bob> " nil t))
- (save-restriction
- (narrow-to-region (point) (pos-eol))
- (erc-goodies-tests--assert-face
- 0 "I love" 'erc-default-face 'fg:erc-color-face3)
- (erc-goodies-tests--assert-face
- 7 " IRC!" 'fg:erc-color-face3)
- (erc-goodies-tests--assert-face
- 11 " It is the " 'erc-default-face 'fg:erc-color-face7)
- (erc-goodies-tests--assert-face
- 22 "best protocol ever!" 'fg:erc-color-face7))
-
- (let* ((m "This is a \C-]\C-c13,9cool \C-cmessage")
- (msg (erc-format-privmessage "alice" m nil t)))
- (erc-display-message nil nil (current-buffer) msg))
- (should (search-forward "<alice> " nil t))
- (save-restriction
- (narrow-to-region (point) (pos-eol))
- (erc-goodies-tests--assert-face
- 0 "this is a " 'erc-default-face 'erc-italic-face)
- (erc-goodies-tests--assert-face
- 10 "cool " '(erc-italic-face fg:erc-color-face13 bg:erc-color-face9))
- (erc-goodies-tests--assert-face
- 15 "message" 'erc-italic-face
- '(fg:erc-color-face13 bg:erc-color-face9)))
-
- (let* ((m "IRC \C-bis \C-c4,12so \C-cgreat\C-o!")
- (msg (erc-format-privmessage "bob" m nil t)))
- (erc-display-message nil nil (current-buffer) msg))
- (should (search-forward "<bob> " nil t))
- (save-restriction
- (narrow-to-region (point) (pos-eol))
- (erc-goodies-tests--assert-face
- 0 "IRC " 'erc-default-face 'erc-bold-face)
- (erc-goodies-tests--assert-face
- 4 "is " 'erc-bold-face '(fg:erc-color-face4 bg:erc-color-face12))
- (erc-goodies-tests--assert-face
- 7 "so " '(erc-bold-face fg:erc-color-face4 bg:erc-color-face12))
- (erc-goodies-tests--assert-face
- 10 "great" 'erc-bold-face '(fg:erc-color-face4 bg:erc-color-face12))
- (erc-goodies-tests--assert-face
- 15 "!" 'erc-default-face 'erc-bold-face))
-
- (let* ((m (concat "Rules: Don't spam 5\C-c13,8,6\C-c,7,8, "
- "and especially not \C-b9\C-b\C-]!"))
- (msg (erc-format-privmessage "alice" m nil t)))
- (erc-display-message nil nil (current-buffer) msg))
- (should (search-forward "<alice> " nil t))
- (save-restriction
- (narrow-to-region (point) (pos-eol))
- (erc-goodies-tests--assert-face
- 0 "Rules: Don't spam 5" 'erc-default-face
- '(fg:erc-color-face13 bg:erc-color-face8))
- (erc-goodies-tests--assert-face
- 19 ",6" '(fg:erc-color-face13 bg:erc-color-face8))
- (erc-goodies-tests--assert-face
- 21 ",7,8, and especially not " 'erc-default-face
- '(fg:erc-color-face13 bg:erc-color-face8 erc-bold-face))
- (erc-goodies-tests--assert-face
- 44 "9" 'erc-bold-face 'erc-italic-face)
- (erc-goodies-tests--assert-face
- 45 "!" 'erc-italic-face 'erc-bold-face))
-
- (when noninteractive
- (kill-buffer)))))
-
-;; Like the test above, this is most intuitive when run interactively.
-;; Hovering over the redacted area should reveal its underlying text
-;; in a high-contrast face.
-
-(ert-deftest erc-controls-highlight--spoilers ()
- (should (eq t erc-interpret-controls-p))
- (erc-tests-common-make-server-buf)
- (with-current-buffer (erc--open-target "#chan")
- (setq-local erc-interpret-mirc-color t)
- (let* ((raw (concat "BEGIN "
- "\C-c0,0 WhiteOnWhite "
- "\C-c1,1 BlackOnBlack "
- "\C-c99,99 Default "
- "\C-o END"))
- (msg (erc-format-privmessage "bob" raw nil t)))
- (erc-display-message nil nil (current-buffer) msg))
- (forward-line -1)
- (should (search-forward "<bob> " nil t))
- (save-restriction
- ;; Narrow to EOL or start of right-side stamp.
- (narrow-to-region (point) (line-end-position))
- (save-excursion
- (search-forward "WhiteOn")
- (should (eq (get-text-property (point) 'mouse-face)
- 'erc-spoiler-face))
- (search-forward "BlackOn")
- (should (eq (get-text-property (point) 'mouse-face)
- 'erc-spoiler-face)))
- ;; Start with ERC default face.
- (erc-goodies-tests--assert-face
- 0 "BEGIN " 'erc-default-face
- '(fg:erc-color-face0 bg:erc-color-face0))
- ;; Masked in all white.
- (erc-goodies-tests--assert-face
- 6 "WhiteOnWhite" '(fg:erc-color-face0 bg:erc-color-face0)
- '(fg:erc-color-face1 bg:erc-color-face1))
- ;; Masked in all black.
- (erc-goodies-tests--assert-face
- 20 "BlackOnBlack" '(fg:erc-color-face1 bg:erc-color-face1) nil)
- ;; Explicit "default" code ignored.
- (erc-goodies-tests--assert-face
- 34 "Default" '(erc-default-face)
- '(fg:erc-color-face1 bg:erc-color-face1))
- (erc-goodies-tests--assert-face
- 43 "END" 'erc-default-face nil)))
- (when noninteractive
- (erc-tests-common-kill-buffers)))
-
-(ert-deftest erc-controls-highlight--inverse ()
- (should (eq t erc-interpret-controls-p))
- (erc-tests-common-make-server-buf)
- (with-current-buffer (erc--open-target "#chan")
- (setq-local erc-interpret-mirc-color t)
- (defvar erc-fill-column)
- (let* ((erc-fill-column 90)
- (raw (concat "BEGIN "
- "\C-c3,13 GreenOnPink "
- "\C-v PinkOnGreen "
- "\C-c99,99 ReversedDefault "
- "\C-v NormalDefault "
- "\C-o END"))
- (msg (erc-format-privmessage "bob" raw nil t)))
- (erc-display-message nil nil (current-buffer) msg))
- (forward-line -1)
- (should (search-forward "<bob> " nil t))
- (save-restriction
- ;; Narrow to EOL or start of right-side stamp.
- (narrow-to-region (point) (line-end-position))
- ;; Baseline.
- (erc-goodies-tests--assert-face
- 0 "BEGIN " 'erc-default-face
- '(fg:erc-color-face0 bg:erc-color-face0))
- ;; Normal fg/bg combo.
- (erc-goodies-tests--assert-face
- 6 "GreenOnPink" '(fg:erc-color-face3 bg:erc-color-face13)
- '(erc-inverse-face))
- ;; Reverse of previous, so former-bg on former-fg.
- (erc-goodies-tests--assert-face
- 19 "PinkOnGreen"
- '(erc-inverse-face fg:erc-color-face3 bg:erc-color-face13)
- nil)
- ;; The inverse of `default' because reverse still in effect.
- (erc-goodies-tests--assert-face
- 32 "ReversedDefault" '(erc-inverse-face erc-default-face)
- '(fg:erc-color-face3 bg:erc-color-face13))
- (erc-goodies-tests--assert-face
- 49 "NormalDefault" '(erc-default-face)
- '(erc-inverse-face fg:erc-color-face1 bg:erc-color-face1))
- (erc-goodies-tests--assert-face
- 64 "END" 'erc-default-face
- '(fg:erc-color-face0 bg:erc-color-face0))))
- (when noninteractive
- (erc-tests-common-kill-buffers)))
-
-;; This is meant to assert two behavioral properties:
-;;
-;; 1) The background is preserved when only a new foreground is
-;; defined, in accordance with this bit from the spec: "If only the
-;; foreground color is set, the background color stays the same."
-;; https://modern.ircdocs.horse/formatting#color
-;;
-;; 2) The same holds true for a new, lone foreground of 99. Rather
-;; than prepend `erc-default-face', this causes the removal of an
-;; existing foreground face and likewise doesn't clobber the
-;; existing background.
-(ert-deftest erc-controls-highlight/default-foreground ()
- (should (eq t erc-interpret-controls-p))
- (erc-tests-common-make-server-buf)
- (with-current-buffer (erc--open-target "#chan")
- (setq-local erc-interpret-mirc-color t)
- (defvar erc-fill-column)
- (let ((erc-fill-column 90))
- (erc-display-message nil nil (current-buffer)
- (erc-format-privmessage
- "bob" (concat "BEGIN "
- "\C-c03,08 GreenOnYellow "
- "\C-c99 BlackOnYellow "
- "\C-o END")
- nil t)))
- (forward-line -1)
- (should (search-forward "<bob> " nil t))
- (should (erc-tests-common-equal-with-props
- (erc--remove-text-properties
- (buffer-substring (point) (line-end-position)))
- #("BEGIN GreenOnYellow BlackOnYellow END"
- 0 6 (font-lock-face erc-default-face)
- 6 21 (font-lock-face (fg:erc-color-face3
- bg:erc-color-face8
- erc-default-face))
- 21 36 (font-lock-face (bg:erc-color-face8
- erc-default-face))
- 36 40 (font-lock-face (erc-default-face)))))
- (should (search-forward "BlackOnYellow"))
- (let ((faces (get-text-property (point) 'font-lock-face)))
- (should (equal (face-background (car faces) nil (cdr faces))
- "yellow")))
-
- ;; Redefine background color alongside default foreground.
- (let ((erc-fill-column 90))
- (erc-display-message nil nil (current-buffer)
- (erc-format-privmessage
- "bob" (concat "BEGIN "
- "\C-c03,08 GreenOnYellow "
- "\C-c99,07 BlackOnOrange "
- "\C-o END")
- nil t)))
- (should (search-forward "<bob> " nil t))
- (should (erc-tests-common-equal-with-props
- (erc--remove-text-properties
- (buffer-substring (point) (line-end-position)))
- #("BEGIN GreenOnYellow BlackOnOrange END"
- 0 6 (font-lock-face erc-default-face)
- 6 21 (font-lock-face (fg:erc-color-face3
- bg:erc-color-face8
- erc-default-face))
- 21 36 (font-lock-face (bg:erc-color-face7
- erc-default-face))
- 36 40 (font-lock-face (erc-default-face)))))
- (should (search-forward "BlackOnOrange"))
- (let ((faces (get-text-property (point) 'font-lock-face)))
- (should (equal (face-background (car faces) nil (cdr faces))
- "orange")))) ; as opposed to white or black
- (when noninteractive
- (erc-tests-common-kill-buffers)))
-
-;; This merely asserts our current interpretation of "default faces":
-;; that they reflect the foreground and background exhibited by normal
-;; chat messages before any control-code formatting is applied (rather
-;; than, e.g., some sort of negation or no-op).
-(ert-deftest erc-controls-highlight/default-background ()
- (should (eq t erc-interpret-controls-p))
- (erc-tests-common-make-server-buf)
- (with-current-buffer (erc--open-target "#chan")
- (setq-local erc-interpret-mirc-color t)
- (defvar erc-fill-column)
- (let ((erc-fill-column 90))
- (erc-display-message nil nil (current-buffer)
- (erc-format-privmessage
- "bob" (concat "BEGIN "
- "\C-c03,08 GreenOnYellow "
- "\C-c05,99 BrownOnWhite "
- "\C-o END")
- nil t)))
- (forward-line -1)
- (should (search-forward "<bob> " nil t))
- (should (erc-tests-common-equal-with-props
- (erc--remove-text-properties
- (buffer-substring (point) (line-end-position)))
- #("BEGIN GreenOnYellow BrownOnWhite END"
- 0 6 (font-lock-face erc-default-face)
- 6 21 (font-lock-face (fg:erc-color-face3
- bg:erc-color-face8
- erc-default-face))
- 21 35 (font-lock-face (fg:erc-color-face5
- erc-default-face))
- 35 39 (font-lock-face (erc-default-face)))))
- ;; Ensure the background is white or black, rather than yellow.
- (should (search-forward "BrownOnWhite"))
- (let ((faces (get-text-property (point) 'font-lock-face)))
- (should (equal (face-background (car faces) nil `(,@(cdr faces) default))
- (face-background 'default)))))
- (when noninteractive
- (erc-tests-common-kill-buffers)))
-
-(defvar erc-goodies-tests--motd
- ;; This is from ergo's MOTD
- '((":- - this is \2bold text\17.")
- (":- - this is \35italics text\17.")
- (":- - this is \0034red\3 and \0032blue\3 text.")
- (":- - this is \0034,12red text with a light blue background\3.")
- (":- - this is a normal escaped dollarsign: $")
- (":- ")
- (":- "
- "\0031,0 00 \0030,1 01 \0030,2 02 \0030,3 03 "
- "\0031,4 04 \0030,5 05 \0030,6 06 \0031,7 07 ")
- (":- "
- "\0031,8 08 \0031,9 09 \0030,10 10 \0031,11 11 "
- "\0030,12 12 \0031,13 13 \0031,14 14 \0031,15 15 ")
- (":- ")
- (":- "
- "\0030,16 16 \0030,17 17 \0030,18 18 \0030,19 19 "
- "\0030,20 20 \0030,21 21 \0030,22 22 \0030,23 23 "
- "\0030,24 24 \0030,25 25 \0030,26 26 \0030,27 27 ")
- (":- "
- "\0030,28 28 \0030,29 29 \0030,30 30 \0030,31 31 "
- "\0030,32 32 \0030,33 33 \0030,34 34 \0030,35 35 "
- "\0030,36 36 \0030,37 37 \0030,38 38 \0030,39 39 ")
- (":- "
- "\0030,40 40 \0030,41 41 \0030,42 42 \0030,43 43 "
- "\0030,44 44 \0030,45 45 \0030,46 46 \0030,47 47 "
- "\0030,48 48 \0030,49 49 \0030,50 50 \0030,51 51 ")
- (":- "
- "\0030,52 52 \0030,53 53 \0031,54 54 \0031,55 55 "
- "\0031,56 56 \0031,57 57 \0031,58 58 \0030,59 59 "
- "\0030,60 60 \0030,61 61 \0030,62 62 \0030,63 63 ")
- (":- "
- "\0030,64 64 \0031,65 65 \0031,66 66 \0031,67 67 "
- "\0031,68 68 \0031,69 69 \0031,70 70 \0031,71 71 "
- "\0030,72 72 \0030,73 73 \0030,74 74 \0030,75 75 ")
- (":- "
- "\0031,76 76 \0031,77 77 \0031,78 78 \0031,79 79 "
- "\0031,80 80 \0031,81 81 \0031,82 82 \0031,83 83 "
- "\0031,84 84 \0031,85 85 \0031,86 86 \0031,87 87 ")
- (":- "
- "\0030,88 88 \0030,89 89 \0030,90 90 \0030,91 91 "
- "\0030,92 92 \0030,93 93 \0030,94 94 \0030,95 95 "
- "\0031,96 96 \0031,97 97 \0031,98 98 \399,99 99 ")
- (":- ")))
-
-(ert-deftest erc-controls-highlight--motd ()
- (should (eq t erc-interpret-controls-p))
- (let ((erc-insert-modify-hook '(erc-controls-highlight))
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
- (with-current-buffer (get-buffer-create "#chan")
- (erc-mode)
- (setq-local erc-interpret-mirc-color t)
- (erc--initialize-markers (point) nil)
-
- (dolist (parts erc-goodies-tests--motd)
- (erc-display-message nil 'notice (current-buffer) (string-join parts)))
-
- ;; Spot check
- (goto-char (point-min))
- (should (search-forward " 16 " nil t))
- (save-restriction
- (narrow-to-region (point) (pos-eol))
- (erc-goodies-tests--assert-face
- 0 " 17 " '(fg:erc-color-face0 (:background "#472100")))
- (erc-goodies-tests--assert-face
- 4 " 18 " '(fg:erc-color-face0 (:background "#474700"))
- '((:background "#472100"))))
-
- (should (search-forward " 71 " nil t))
- (save-restriction
- (narrow-to-region (point) (pos-eol))
- (erc-goodies-tests--assert-face
- 0 " 72 " '(fg:erc-color-face0 (:background "#5959ff")))
- (erc-goodies-tests--assert-face
- 4 " 73 " '(fg:erc-color-face0 (:background "#c459ff"))
- '((:background "#5959ff"))))
-
- (goto-char (point-min))
- (when noninteractive
- (kill-buffer)))))
-
-
-;; Among other things, this test also asserts that a local module's
-;; minor-mode toggle is allowed to disable its mode variable as
-;; needed.
-
-(defun erc-goodies-tests--assert-kp-indicator-on ()
- (should erc--keep-place-indicator-overlay)
- (should (memq 'erc--keep-place-indicator-on-window-buffer-change
- window-buffer-change-functions))
- (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 (memq 'erc--keep-place-indicator-on-window-buffer-change
- window-buffer-change-functions))
- (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)
- (erc-keep-place-mode -1)
- (with-current-buffer (erc-tests-common-make-server-buf
- "*erc-keep-place-indicator-mode*")
- (let (erc-connect-pre-hook
- erc-modules)
-
- (ert-info ("Clean slate")
- (erc-goodies-tests--assert-kp-indicator-off)
- (should-not erc-keep-place-mode)
- (should-not (memq 'keep-place erc-modules)))
-
- (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))
- (erc-tests-common-kill-buffers))))
-
-(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")))))))
-
-(ert-deftest erc--get-inserted-msg-beg/readonly ()
- (erc-tests-common-assert-get-inserted-msg-readonly-with
- #'erc-tests-common-assert-get-inserted-msg/basic
- (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))
-
-(ert-deftest erc--get-inserted-msg-beg/truncated/readonly ()
- (erc-tests-common-assert-get-inserted-msg-readonly-with
- #'erc-tests-common-assert-get-inserted-msg/truncated
- (lambda (arg) (should (= 1 (erc--get-inserted-msg-beg arg))))))
-
-(ert-deftest erc--get-inserted-msg-end/readonly ()
- (erc-tests-common-assert-get-inserted-msg-readonly-with
- #'erc-tests-common-assert-get-inserted-msg/basic
- (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg))))))
-
-(ert-deftest erc--get-inserted-msg-bounds/readonly ()
- (erc-tests-common-assert-get-inserted-msg-readonly-with
- #'erc-tests-common-assert-get-inserted-msg/basic
- (lambda (arg)
- (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg))))))
-
-
-;;; erc-goodies-tests.el ends here
+++ /dev/null
-;;; erc-join-tests.el --- Tests for erc-join. -*- lexical-binding:t -*-
-
-;; Copyright (C) 2020-2025 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)
-(require 'erc-join)
-(require 'erc-networks)
-
-(ert-deftest erc-autojoin-channels--connect ()
- (should (eq erc-autojoin-timing 'connect))
- (should (= erc-autojoin-delay 30))
- (should-not erc--autojoin-timer)
-
- (let (calls
- common
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
-
- (cl-letf (((symbol-function 'erc-server-send)
- (lambda (line) (push line calls))))
-
- (setq common
- (lambda ()
- (ert-with-test-buffer (:name "foonet")
- (erc-mode)
- (setq erc-server-process
- (start-process "true" (current-buffer) "true")
- erc-network 'FooNet
- erc-session-server "irc.gnu.chat"
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create nil)
- erc-server-announced-name "foo.gnu.chat")
- (set-process-query-on-exit-flag erc-server-process nil)
- (erc-autojoin-channels erc-server-announced-name
- "tester")
- (should-not erc--autojoin-timer))))
-
- (ert-info ("Join immediately on connect; server")
- (let ((erc-autojoin-channels-alist '(("\\.gnu\\.chat\\'" "#chan"))))
- (funcall common))
- (should (equal (pop calls) "JOIN #chan")))
-
- (ert-info ("Join immediately on connect; network")
- (let ((erc-autojoin-channels-alist '((FooNet "#chan"))))
- (funcall common))
- (should (equal (pop calls) "JOIN #chan")))
-
- (ert-info ("Do nothing; server")
- (let ((erc-autojoin-channels-alist '(("bar\\.gnu\\.chat" "#chan"))))
- (funcall common))
- (should-not calls))
-
- (ert-info ("Do nothing; network")
- (let ((erc-autojoin-channels-alist '((BarNet "#chan"))))
- (funcall common))
- (should-not calls)))))
-
-(ert-deftest erc-autojoin-channels--delay ()
- (should (eq erc-autojoin-timing 'connect))
- (should (= erc-autojoin-delay 30))
- (should-not erc--autojoin-timer)
-
- (let (calls
- common
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook
- (erc-autojoin-timing 'ident)
- (erc-autojoin-delay 0.05))
-
- (cl-letf (((symbol-function 'erc-server-send)
- (lambda (line) (push line calls)))
- ((symbol-function 'erc-autojoin-after-ident)
- (lambda (&rest _r) (error "I ran but shouldn't have"))))
-
- (setq common
- (lambda ()
- (ert-with-test-buffer (:name "foonet")
- (erc-mode)
- (setq erc-server-process
- (start-process "true" (current-buffer) "true")
- erc-network 'FooNet
- erc-session-server "irc.gnu.chat"
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create nil)
- erc-server-announced-name "foo.gnu.chat")
- (set-process-query-on-exit-flag erc-server-process nil)
- (should-not erc--autojoin-timer)
- (erc-autojoin-channels erc-server-announced-name "tester")
- (should erc--autojoin-timer)
- (should-not calls)
- (sleep-for 0.1))))
-
- (ert-info ("Deferred on connect; server")
- (let ((erc-autojoin-channels-alist '(("\\.gnu\\.chat\\'" "#chan"))))
- (funcall common))
- (should (equal (pop calls) "JOIN #chan")))
-
- (ert-info ("Deferred on connect; network")
- (let ((erc-autojoin-channels-alist '((FooNet "#chan"))))
- (funcall common))
- (should (equal (pop calls) "JOIN #chan")))
-
- (ert-info ("Do nothing; server")
- (let ((erc-autojoin-channels-alist '(("bar\\.gnu\\.chat" "#chan"))))
- (funcall common))
- (should-not calls)))))
-
-(ert-deftest erc-autojoin-channels--ident ()
- (should (eq erc-autojoin-timing 'connect))
- (should (= erc-autojoin-delay 30))
- (should-not erc--autojoin-timer)
-
- (let (calls
- common
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook
- (erc-autojoin-timing 'ident))
-
- (cl-letf (((symbol-function 'erc-server-send)
- (lambda (line) (push line calls))))
-
- (setq common
- (lambda ()
- (ert-with-test-buffer (:name "foonet")
- (erc-mode)
- (setq erc-server-process
- (start-process "true" (current-buffer) "true")
- erc-network 'FooNet
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create nil)
- erc-server-announced-name "foo.gnu.chat")
- (set-process-query-on-exit-flag erc-server-process nil)
- (erc-autojoin-after-ident 'FooNet "tester")
- (should-not erc--autojoin-timer))))
-
- (ert-info ("Join on NickServ hook; server")
- (let ((erc-autojoin-channels-alist '(("\\.gnu\\.chat\\'" "#chan"))))
- (funcall common))
- (should (equal (pop calls) "JOIN #chan")))
-
- (ert-info ("Join on NickServ hook; network")
- (let ((erc-autojoin-channels-alist '((FooNet "#chan"))))
- (funcall common))
- (should (equal (pop calls) "JOIN #chan"))))))
-
-(defun erc-join-tests--autojoin-add--common (setup &optional fwd)
- (let (calls
- erc-autojoin-channels-alist
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
-
- (cl-letf (((symbol-function 'erc-handle-parsed-server-response)
- (lambda (_p m) (push m calls))))
-
- (ert-with-test-buffer (:name "foonet")
- (erc-mode)
- (setq erc-server-process
- (start-process "true" (current-buffer) "true")
- erc-server-current-nick "tester"
- erc--isupport-params (make-hash-table)
- erc-server-announced-name "foo.gnu.chat")
- (puthash 'CHANTYPES '("&#") erc--isupport-params)
- (funcall setup)
- (set-process-query-on-exit-flag erc-server-process nil)
- (should-not calls)
-
- (ert-info ("Add #chan")
- (erc-parse-server-response erc-server-process
- (concat ":tester!~i@c.u JOIN #chan"
- (and fwd " * :Tes Ter")))
- (should calls)
- (erc-autojoin-add erc-server-process (pop calls))
- (should (equal erc-autojoin-channels-alist '((FooNet "#chan")))))
-
- (ert-info ("More recently joined chans are prepended")
- (erc-parse-server-response
- erc-server-process ; with account username
- (concat ":tester!~i@c.u JOIN #spam" (and fwd " tester :Tes Ter")))
- (should calls)
- (erc-autojoin-add erc-server-process (pop calls))
- (should (equal erc-autojoin-channels-alist
- '((FooNet "#spam" "#chan")))))
-
- (ert-info ("Duplicates skipped")
- (erc-parse-server-response erc-server-process
- (concat ":tester!~i@c.u JOIN #chan"
- (and fwd " * :Tes Ter")))
- (should calls)
- (erc-autojoin-add erc-server-process (pop calls))
- (should (equal erc-autojoin-channels-alist
- '((FooNet "#spam" "#chan")))))
-
- (ert-info ("Server used for local channel")
- (erc-parse-server-response erc-server-process
- (concat ":tester!~i@c.u JOIN &local"
- (and fwd " * :Tes Ter")))
- (should calls)
- (erc-autojoin-add erc-server-process (pop calls))
- (should (equal erc-autojoin-channels-alist
- '(("foo\\.gnu\\.chat" "&local")
- (FooNet "#spam" "#chan")))))))))
-
-(ert-deftest erc-autojoin-add--network ()
- (erc-join-tests--autojoin-add--common
- (lambda () (setq erc-network 'FooNet
- erc-networks--id (erc-networks--id-create nil)))))
-
-(ert-deftest erc-autojoin-add--network-extended-syntax ()
- (erc-join-tests--autojoin-add--common
- (lambda () (setq erc-network 'FooNet
- erc-networks--id (erc-networks--id-create nil)))
- 'forward-compatible))
-
-(ert-deftest erc-autojoin-add--network-id ()
- (erc-join-tests--autojoin-add--common
- (lambda () (setq erc-network 'invalid
- erc-networks--id (erc-networks--id-create 'FooNet)))))
-
-(ert-deftest erc-autojoin-add--server ()
- (let (calls
- erc-autojoin-channels-alist
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
-
- (cl-letf (((symbol-function 'erc-handle-parsed-server-response)
- (lambda (_p m) (push m calls))))
-
- (ert-info ("Network unavailable, announced name used")
- (setq erc-autojoin-channels-alist nil)
- (ert-with-test-buffer (:name "foonet")
- (erc-mode)
- (setq erc-server-process
- (start-process "true" (current-buffer) "true")
- erc-server-current-nick "tester"
- erc-server-announced-name "foo.gnu.chat"
- erc-networks--id (make-erc-networks--id)) ; assume too early
- (set-process-query-on-exit-flag erc-server-process nil)
- (should-not calls)
- (erc-parse-server-response erc-server-process
- ":tester!~u@q6ddatxcq6txy.irc JOIN #chan")
- (should calls)
- (erc-autojoin-add erc-server-process (pop calls))
- (should (equal erc-autojoin-channels-alist
- '(("gnu.chat" "#chan")))))))))
-
-(defun erc-join-tests--autojoin-remove--common (setup)
- (let (calls
- erc-autojoin-channels-alist
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
-
- (cl-letf (((symbol-function 'erc-handle-parsed-server-response)
- (lambda (_p m) (push m calls))))
-
- (setq erc-autojoin-channels-alist ; mutated, so can't quote whole thing
- (list '(FooNet "#spam" "##chan")
- '(BarNet "#bar" "##bar")
- '("foo\\.gnu\\.chat" "&local")))
-
- (ert-with-test-buffer (:name "foonet")
- (erc-mode)
- (setq erc-server-process
- (start-process "true" (current-buffer) "true")
- erc-server-current-nick "tester"
- erc--isupport-params (make-hash-table)
- erc-server-announced-name "foo.gnu.chat")
- (puthash 'CHANTYPES '("&#") erc--isupport-params)
- (funcall setup)
- (set-process-query-on-exit-flag erc-server-process nil)
- (should-not calls)
-
- (ert-info ("Remove #chan")
- (erc-parse-server-response erc-server-process
- ":tester!~i@c.u PART ##chan")
- (should calls)
- (erc-autojoin-remove erc-server-process (pop calls))
- (should (equal erc-autojoin-channels-alist
- '((FooNet "#spam")
- (BarNet "#bar" "##bar")
- ("foo\\.gnu\\.chat" "&local")))))
-
- (ert-info ("Wrong network, nothing done")
- (erc-parse-server-response erc-server-process
- ":tester!~i@c.u PART #bar")
- (should calls)
- (erc-autojoin-remove erc-server-process (pop calls))
- (should (equal erc-autojoin-channels-alist
- '((FooNet "#spam")
- (BarNet "#bar" "##bar")
- ("foo\\.gnu\\.chat" "&local")))))
-
- (ert-info ("Local channel keyed by server found")
- (erc-parse-server-response erc-server-process
- ":tester!~i@c.u PART &local")
- (should calls)
- (erc-autojoin-remove erc-server-process (pop calls))
- (should (equal erc-autojoin-channels-alist
- '((FooNet "#spam") (BarNet "#bar" "##bar")))))))))
-
-(ert-deftest erc-autojoin-remove--network ()
- (erc-join-tests--autojoin-remove--common
- (lambda () (setq erc-network 'FooNet
- erc-networks--id (erc-networks--id-create nil)))))
-
-(ert-deftest erc-autojoin-remove--network-id ()
- (erc-join-tests--autojoin-remove--common
- (lambda () (setq erc-network 'fake-a-roo
- erc-networks--id (erc-networks--id-create 'FooNet)))))
-
-(ert-deftest erc-autojoin-remove--server ()
- (let (calls
- erc-autojoin-channels-alist
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
-
- (cl-letf (((symbol-function 'erc-handle-parsed-server-response)
- (lambda (_p m) (push m calls))))
-
- (setq erc-autojoin-channels-alist (list '("gnu.chat" "#spam" "##chan")
- '("fsf.chat" "#bar" "##bar")))
-
- (ert-with-test-buffer (:name "foonet")
- (erc-mode)
- (setq erc-server-process
- (start-process "true" (current-buffer) "true")
- erc-server-current-nick "tester"
- erc-server-announced-name "foo.gnu.chat"
- ;; Assume special case without known network
- erc-networks--id (make-erc-networks--id))
- (set-process-query-on-exit-flag erc-server-process nil)
- (should-not calls)
-
- (ert-info ("Announced name matched, #chan removed")
- (erc-parse-server-response erc-server-process
- ":tester!~i@c.u PART ##chan")
- (should calls)
- (erc-autojoin-remove erc-server-process (pop calls))
- (should (equal erc-autojoin-channels-alist
- '(("gnu.chat" "#spam")
- ("fsf.chat" "#bar" "##bar")))))
-
- (ert-info ("Wrong announced name, nothing done")
- (erc-parse-server-response erc-server-process
- ":tester!~i@c.u PART #bar")
- (should calls)
- (erc-autojoin-remove erc-server-process (pop calls))
- (should (equal erc-autojoin-channels-alist
- '(("gnu.chat" "#spam")
- ("fsf.chat" "#bar" "##bar")))))))))
-
-;;; erc-join-tests.el ends here
+++ /dev/null
-;;; erc-match-tests.el --- Tests for erc-match. -*- lexical-binding:t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;; Code:
-
-(require 'ert-x)
-(require 'erc-match)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-tests-common)))
-
-
-(ert-deftest erc-add-entry-to-list ()
- (let ((erc-pals '("z"))
- (erc-match-quote-when-adding 'ask))
-
- (ert-info ("Default (ask)")
- (ert-simulate-keys "\t\ry\r"
- (erc-add-entry-to-list 'erc-pals "?" '((".")) nil)
- (should (equal (pop erc-pals) "\\.")))
-
- (ert-info ("Inverted")
- (ert-simulate-keys "\t\ry\r"
- (erc-add-entry-to-list 'erc-pals "?" '((".")) nil)
- (should (equal (pop erc-pals) "\\."))))
-
- (ert-info ("Skipped")
- (ert-simulate-keys "\t\r"
- (erc-add-entry-to-list 'erc-pals "?" '(("x")) nil)
- (should (equal (pop erc-pals) "x")))))
-
- (ert-info ("Verbatim")
- (setq erc-match-quote-when-adding nil)
- (ert-simulate-keys "\t\r"
- (erc-add-entry-to-list 'erc-pals "?" '((".")) nil)
- (should (equal (pop erc-pals) ".")))
-
- (ert-info ("Inverted")
- (ert-simulate-keys "\t\r"
- (erc-add-entry-to-list 'erc-pals "?" '((".")) t)
- (should (equal (pop erc-pals) "\\.")))))
-
- (ert-info ("Quoted")
- (setq erc-match-quote-when-adding t)
- (ert-simulate-keys "\t\r"
- (erc-add-entry-to-list 'erc-pals "?" '((".")) nil)
- (should (equal (pop erc-pals) "\\.")))
-
- (ert-info ("Inverted")
- (ert-simulate-keys "\t\r"
- (erc-add-entry-to-list 'erc-pals "?" '((".")) t)
- (should (equal (pop erc-pals) ".")))))
-
- (should (equal erc-pals '("z")))))
-
-(ert-deftest erc-pals ()
- (with-temp-buffer
- (setq erc-server-process (start-process "true" (current-buffer) "true")
- erc-server-users (make-hash-table :test #'equal))
- (set-process-query-on-exit-flag erc-server-process nil)
- (erc-add-server-user "FOO[m]" (make-erc-server-user :nickname "foo[m]"))
- (erc-add-server-user "tester" (make-erc-server-user :nickname "tester"))
-
- (let ((erc-match-quote-when-adding t)
- erc-pals calls rvs)
- (cl-letf (((symbol-function 'completing-read)
- (lambda (&rest r) (push r calls) (pop rvs))))
-
- (ert-info ("`erc-add-pal'")
- (push "foo[m]" rvs)
- (ert-simulate-command '(erc-add-pal))
- (should (equal (cadr (pop calls)) '(("tester") ("foo[m]"))))
- (should (equal erc-pals '("foo\\[m]"))))
-
- (ert-info ("`erc-match-pal-p'")
- (should (erc-match-pal-p "FOO[m]!~u@example.net" nil)))
-
- (ert-info ("`erc-delete-pal'")
- (push "foo\\[m]" rvs)
- (ert-simulate-command '(erc-delete-pal))
- (should (equal (cadr (pop calls)) '(("foo\\[m]"))))
- (should-not erc-pals))
-
- (ert-info ("`erc-add-pal' verbatim")
- (push "foo[m]" rvs)
- (ert-simulate-command '(erc-add-pal (4)))
- (should (equal (cadr (pop calls)) '(("tester") ("foo[m]"))))
- (should (equal erc-pals '("foo[m]"))))))))
-
-(ert-deftest erc-fools ()
- (with-temp-buffer
- (setq erc-server-process (start-process "true" (current-buffer) "true")
- erc-server-users (make-hash-table :test #'equal))
- (set-process-query-on-exit-flag erc-server-process nil)
- (erc-add-server-user "FOO[m]" (make-erc-server-user :nickname "foo[m]"))
- (erc-add-server-user "tester" (make-erc-server-user :nickname "tester"))
-
- (let ((erc-match-quote-when-adding t)
- erc-fools calls rvs)
- (cl-letf (((symbol-function 'completing-read)
- (lambda (&rest r) (push r calls) (pop rvs))))
-
- (ert-info ("`erc-add-fool'")
- (push "foo[m]" rvs)
- (ert-simulate-command '(erc-add-fool))
- (should (equal (cadr (pop calls)) '(("tester") ("foo[m]"))))
- (should (equal erc-fools '("foo\\[m]"))))
-
- (ert-info ("`erc-match-fool-p'")
- (should (erc-match-fool-p "FOO[m]!~u@example.net" ""))
- (should (erc-match-fool-p "tester!~u@example.net" "FOO[m]: die")))
-
- (ert-info ("`erc-delete-fool'")
- (push "foo\\[m]" rvs)
- (ert-simulate-command '(erc-delete-fool))
- (should (equal (cadr (pop calls)) '(("foo\\[m]"))))
- (should-not erc-fools))
-
- (ert-info ("`erc-add-fool' verbatim")
- (push "foo[m]" rvs)
- (ert-simulate-command '(erc-add-fool (4)))
- (should (equal (cadr (pop calls)) '(("tester") ("foo[m]"))))
- (should (equal erc-fools '("foo[m]"))))))))
-
-(ert-deftest erc-keywords ()
- (let ((erc-match-quote-when-adding t)
- erc-keywords calls rvs)
- (cl-letf (((symbol-function 'completing-read)
- (lambda (&rest r) (push r calls) (pop rvs))))
-
- (ert-info ("`erc-add-keyword'")
- (push "[cit. needed]" rvs)
- (ert-simulate-command '(erc-add-keyword))
- (should (equal (cadr (pop calls)) nil))
- (should (equal erc-keywords '("\\[cit\\. needed]"))))
-
- (ert-info ("`erc-match-keyword-p'")
- (should (erc-match-keyword-p nil "is pretty [cit. needed]")))
-
- (ert-info ("`erc-delete-keyword'")
- (push "\\[cit\\. needed]" rvs)
- (ert-simulate-command '(erc-delete-keyword))
- (should (equal (cadr (pop calls)) '(("\\[cit\\. needed]"))))
- (should-not erc-keywords))
-
- (ert-info ("`erc-add-keyword' verbatim")
- (push "[...]" rvs)
- (ert-simulate-command '(erc-add-keyword (4)))
- (should (equal (cadr (pop calls)) nil))
- (should (equal erc-keywords '("[...]")))))))
-
-(ert-deftest erc-dangerous-hosts ()
- (let ((erc-match-quote-when-adding t)
- erc-dangerous-hosts calls rvs)
- (cl-letf (((symbol-function 'completing-read)
- (lambda (&rest r) (push r calls) (pop rvs))))
-
- (ert-info ("`erc-add-dangerous-host'")
- (push "example.net" rvs)
- (ert-simulate-command '(erc-add-dangerous-host))
- (should (equal (cadr (pop calls)) nil))
- (should (equal erc-dangerous-hosts '("example\\.net"))))
-
- (ert-info ("`erc-match-dangerous-host-p'")
- (should (erc-match-dangerous-host-p "FOO[m]!~u@example.net" nil)))
-
- (ert-info ("`erc-delete-dangerous-host'")
- (push "example\\.net" rvs)
- (ert-simulate-command '(erc-delete-dangerous-host))
- (should (equal (cadr (pop calls)) '(("example\\.net"))))
- (should-not erc-dangerous-hosts))
-
- (ert-info ("`erc-add-dangerous-host' verbatim")
- (push "example.net" rvs)
- (ert-simulate-command '(erc-add-dangerous-host (4)))
- (should (equal (cadr (pop calls)) nil))
- (should (equal erc-dangerous-hosts '("example.net")))))))
-
-(defun erc-match-tests--assert-face-absent (face end)
- "Ensure FACE is absent from point until pos or substring END."
- (when (stringp end)
- (save-excursion
- (search-forward end)
- (setq end (1- (match-beginning 0)))))
- (ert-info ((format "Face %S absent throughout: %S" face
- (buffer-substring-no-properties (point) end)))
- (while (<= (point) end)
- (ert-info ((format "Looking at: (%d %c)" (char-after) (char-after)))
- (let ((val (ensure-list (get-text-property (point) 'font-lock-face))))
- (should-not (memq face val))))
- (forward-char))))
-
-(defun erc-match-tests--assert-face-present (face end)
- "Ensure FACE is present from point until pos or substring END."
- (when (stringp end)
- (save-excursion
- (search-forward end)
- (setq end (1- (match-beginning 0)))))
- (ert-info ((format "Face %S appears throughout: %S" face
- (buffer-substring-no-properties (point) end)))
- (while (<= (point) end)
- (ert-info ((format "Looking at: (%d %c)" (char-after) (char-after)))
- (let ((val (ensure-list (get-text-property (point) 'font-lock-face))))
- (should (eq face (car val)))))
- (forward-char))))
-
-(defun erc-match-tests--assert-speaker-highlighted (nick face)
- (search-forward (concat "<" nick ">"))
- (goto-char (pos-bol))
- (should (= (char-after) ?<))
- (should (equal (get-text-property (point) 'font-lock-face)
- 'erc-default-face))
-
- (ert-info ((format "Nick in <%s> highlighted" nick))
- (forward-char)
- (erc-match-tests--assert-face-present face "> "))
-
- (should (= (char-after) ?>)))
-
-(defun erc-match-tests--assert-speaker-only-highlighted (nick face)
- (erc-match-tests--assert-speaker-highlighted nick face)
- (ert-info ("Remaining text in line not highlighted")
- (erc-match-tests--assert-face-absent face (pos-eol))))
-
-(defun erc-match-tests--perform (test)
- (erc-tests-common-make-server-buf)
- (setq erc-server-current-nick "tester")
- (with-current-buffer (erc--open-target "#chan")
- (funcall test))
- (when noninteractive
- (erc-tests-common-kill-buffers)))
-
-;; The `nick' highlight type only covers a matching sender's speaker
-;; tag. It does not do any highlighting for pal/fool/dangerous-host
-;; mentions. While `current-nick' and `keyword' categories match
-;; against a message's content, the speaker's nick is still highlighted
-;; (in the corresponding face) when a match occurs.
-(defun erc-match-tests--hl-type-nick (face &optional test)
- (should (eq erc-current-nick-highlight-type 'keyword))
- (should (eq erc-keyword-highlight-type 'keyword))
-
- (erc-match-tests--perform
- (lambda ()
- (erc-tests-common-add-cmem "bob")
- (erc-tests-common-add-cmem "alice")
- ;; Change highlight type for match categories `keyword' and
- ;; `current-nick' to `nick'.
- (let ((erc-current-nick-highlight-type 'nick)
- (erc-keyword-highlight-type 'nick)
- (erc-keywords '("thing")))
- (erc-tests-common-simulate-privmsg "bob" "hi alice")
- (erc-tests-common-simulate-privmsg "alice" "hi bob")
- (erc-tests-common-simulate-privmsg "bob" "hi tester")
- (erc-tests-common-simulate-privmsg "bob" "something blue"))
- (goto-char (point-min))
-
- ;; A sender's nick appears in `erc-{pals,fools,dangerous-hosts}',
- ;; so the nick portion of their speaker tag alone is highlighted.
- (erc-match-tests--assert-speaker-only-highlighted "bob" face)
-
- ;; A non-matching sender mentions a would-be match (if message
- ;; bodies were considered), and the nick portion of their speaker
- ;; tag is *not* highlighted.
- (search-forward "<alice>")
- (goto-char (pos-bol))
- (erc-match-tests--assert-face-absent face (pos-eol))
-
- ;; A matching sender mentions our own nick ("tester"), and their
- ;; speaker's nick is highlighted in `erc-current-nick-face' instead
- ;; of the normal category face (e.g., `erc-pal-face'). This
- ;; happens because the implementation applies highlighting for
- ;; non-NUH-based categories (`keyword' and `current-nick') after
- ;; sender-based ones.
- (should (looking-at (rx "<bob>")))
- (erc-match-tests--assert-speaker-only-highlighted
- "bob" 'erc-current-nick-face)
-
- ;; A matching sender mentions keyword "tester", and their speaker's
- ;; nick is highlighted in `erc-keyword-face' instead of the normal
- ;; category face for the same reason mentioned above.
- (should (looking-at (rx "<bob>")))
- (erc-match-tests--assert-speaker-only-highlighted
- "bob" 'erc-keyword-face)
-
- (when test
- (funcall test)))))
-
-(defun erc-match-tests--hl-type-nick/mention (face)
- (erc-match-tests--hl-type-nick
- face
- (lambda ()
- (erc-tests-common-simulate-privmsg "alice" "bob: one")
- (erc-tests-common-simulate-privmsg "alice" "bob, two")
- (erc-tests-common-simulate-privmsg "alice" "three, bob.")
-
- (search-forward "<alice> bob: one")
- (goto-char (pos-bol))
- (erc-match-tests--assert-speaker-only-highlighted "alice" face)
-
- (search-forward "<alice> bob, two")
- (goto-char (pos-bol))
- (erc-match-tests--assert-speaker-only-highlighted "alice" face)
-
- (search-forward "<alice> three, bob.")
- (goto-char (pos-bol))
- (erc-match-tests--assert-speaker-only-highlighted "alice" face))))
-
-(ert-deftest erc-match-message/pal/nick ()
- (should (eq erc-pal-highlight-type 'nick))
- (let ((erc-pals (list "bob")))
- (erc-match-tests--hl-type-nick 'erc-pal-face)))
-
-(ert-deftest erc-match-message/fool/nick ()
- (should (eq erc-fool-highlight-type 'nick))
- (let ((erc-fools (list "bob")))
- (erc-match-tests--hl-type-nick/mention 'erc-fool-face)))
-
-(ert-deftest erc-match-message/dangerous-host/nick ()
- (should (eq erc-dangerous-host-highlight-type 'nick))
- (let ((erc-dangerous-hosts (list "bob")))
- (erc-match-tests--hl-type-nick 'erc-dangerous-host-face)))
-
-(defun erc-match-tests--hl-type-message (face)
- (should (eq erc-current-nick-highlight-type 'keyword))
- (should (eq erc-keyword-highlight-type 'keyword))
-
- (erc-match-tests--perform
- (lambda ()
- (erc-tests-common-add-cmem "bob")
- (erc-tests-common-add-cmem "alice")
- ;; Change highlight type for categories `keyword' and
- ;; `current-nick' to `message'.
- (let ((erc-current-nick-highlight-type 'message)
- (erc-keyword-highlight-type 'message)
- (erc-keywords '("thing")))
- (erc-tests-common-simulate-privmsg "bob" "hi alice")
- (erc-tests-common-simulate-privmsg "alice" "hi bob")
- (erc-tests-common-simulate-privmsg "bob" "hi tester")
- (erc-tests-common-simulate-privmsg "bob" "something blue"))
- (goto-char (point-min))
-
- ;; Message body portion appears in `erc-{pals,fools,dangerous-hosts}'.
- ;; But the speaker portion is not highlighted by `match'.
- (erc-match-tests--assert-face-absent face "hi alice")
- (erc-match-tests--assert-face-present face
- (+ (point) (length "hi alice") -1))
-
- ;; A non-matching sender mentions a would-be match (if message
- ;; bodies were considered), but nothing is highlighted.
- (search-forward "<alice>")
- (goto-char (pos-bol))
- (erc-match-tests--assert-face-absent face (pos-eol))
-
- ;; A matching sender mentions our own nick ("tester"), and the
- ;; message body is highlighted in `erc-current-nick-face' instead
- ;; of the normal category face (e.g., `erc-pal-face').
- (should (looking-at (rx "<bob>")))
- (save-excursion (erc-match-tests--assert-face-absent face "hi tester"))
- (erc-match-tests--assert-face-absent 'erc-current-nick-face "hi tester")
- (erc-match-tests--assert-face-present 'erc-current-nick-face (pos-eol))
-
- ;; A matching sender mentions keyword "thing", and the message body
- ;; is highlighted in `erc-keyword-face' instead of the normal
- ;; category face.
- (should (looking-at (rx "<bob>")))
- (save-excursion (erc-match-tests--assert-face-absent face "something"))
- (erc-match-tests--assert-face-absent 'erc-keyword-face "something")
- (erc-match-tests--assert-face-present 'erc-keyword-face (pos-eol)))))
-
-(ert-deftest erc-match-message/pal/message ()
- (should (eq erc-pal-highlight-type 'nick))
- (let ((erc-pals (list "bob"))
- (erc-pal-highlight-type 'message))
- (erc-match-tests--hl-type-message 'erc-pal-face)))
-
-(ert-deftest erc-match-message/fool/message ()
- (should (eq erc-fool-highlight-type 'nick))
- (let ((erc-fools (list "bob"))
- (erc-fool-highlight-type 'message))
- (erc-match-tests--hl-type-message 'erc-fool-face)))
-
-(ert-deftest erc-match-message/dangerous-host/message ()
- (should (eq erc-dangerous-host-highlight-type 'nick))
- (let ((erc-dangerous-hosts (list "bob"))
- (erc-dangerous-host-highlight-type 'message))
- (erc-match-tests--hl-type-message 'erc-dangerous-host-face)))
-
-(defun erc-match-tests--hl-type-all (face)
- (should (eq erc-current-nick-highlight-type 'keyword))
- (should (eq erc-keyword-highlight-type 'keyword))
-
- (erc-match-tests--perform
- (lambda ()
- (erc-tests-common-add-cmem "bob")
- (erc-tests-common-add-cmem "alice")
- ;; Change highlight type for categories `current-nick' and
- ;; `keyword' to `all'.
- (let ((erc-current-nick-highlight-type 'all)
- (erc-keyword-highlight-type 'all)
- (erc-keywords '("thing")))
- (erc-tests-common-simulate-privmsg "bob" "hi alice")
- (erc-tests-common-simulate-privmsg "alice" "hi bob")
- (erc-tests-common-simulate-privmsg "bob" "hi tester")
- (erc-tests-common-simulate-privmsg "bob" "something blue"))
- (goto-char (point-min))
-
- ;; Entire message, including speaker appears in a speaker-based
- ;; face `erc-{pals,fools,dangerous-hosts}'.
- (search-forward "<bob>")
- (goto-char (pos-bol))
- (erc-match-tests--assert-face-present
- face (+ (point) (length "<bob> hi alice") -1))
-
- ;; A non-matching sender mentions a would-be match (if message
- ;; bodies were considered), but nothing is highlighted.
- (search-forward "<alice>")
- (goto-char (pos-bol))
- (erc-match-tests--assert-face-absent face (pos-eol))
-
- ;; A matching sender mentions our own nick ("tester"), and the
- ;; entire message, including the speaker portion, is highlighted in
- ;; `erc-current-nick-face' instead of the normal category face
- ;; (e.g., `erc-pal-face').
- (should (looking-at (rx "<bob>")))
- (save-excursion (erc-match-tests--assert-face-absent face (pos-eol)))
- (erc-match-tests--assert-face-present 'erc-current-nick-face (pos-eol))
-
- ;; A matching sender mentions keyword "thing", and the entire
- ;; message is highlighted in `erc-keyword-face' instead of the
- ;; normal category face.
- (should (looking-at (rx "<bob>")))
- (save-excursion (erc-match-tests--assert-face-absent face (pos-eol)))
- (erc-match-tests--assert-face-present 'erc-keyword-face (pos-eol)))))
-
-(ert-deftest erc-match-message/pal/all ()
- (should (eq erc-pal-highlight-type 'nick))
- (let ((erc-pals (list "bob"))
- (erc-pal-highlight-type 'all))
- (erc-match-tests--hl-type-all 'erc-pal-face)))
-
-(ert-deftest erc-match-message/fool/all ()
- (should (eq erc-fool-highlight-type 'nick))
- (let ((erc-fools (list "bob"))
- (erc-fool-highlight-type 'all))
- (erc-match-tests--hl-type-all 'erc-fool-face)))
-
-(ert-deftest erc-match-message/dangerous-host/all ()
- (should (eq erc-dangerous-host-highlight-type 'nick))
- (let ((erc-dangerous-hosts (list "bob"))
- (erc-dangerous-host-highlight-type 'all))
- (erc-match-tests--hl-type-all 'erc-dangerous-host-face)))
-
-(defun erc-match-tests--hl-type-nick-or-keyword ()
- (should (eq erc-current-nick-highlight-type 'keyword))
-
- (erc-match-tests--perform
- (lambda ()
- (erc-tests-common-add-cmem "bob")
- (erc-tests-common-add-cmem "alice")
- ;; Change highlight type for category `current-nick' from the
- ;; default to `nick-or-keyword'.
- (let ((erc-current-nick-highlight-type 'nick-or-keyword))
- (erc-tests-common-simulate-line
- ":irc.foonet.org 353 tester = #chan :bob tester alice")
- (erc-tests-common-simulate-line
- ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (erc-tests-common-simulate-privmsg "bob" "hi tester"))
- (goto-char (point-min))
-
- ;; An initial NAMES burst arrives. Its sender is "irc.foonet.org",
- ;; so `match' skips the "nick" half of `nick-or-keyword' and
- ;; considers the input non-NUH-based (because a host name alone
- ;; can't be a real user). IOW, it pretends the option's value is
- ;; `keyword', and highlights all occurrences in the message body.
- (search-forward "*** Users on #chan: bob tester")
- (goto-char (pos-bol))
- (erc-match-tests--assert-face-absent 'erc-current-nick-face "tester")
- (erc-match-tests--assert-face-present 'erc-current-nick-face
- (+ (point) (length "tester") -1))
- (erc-match-tests--assert-face-absent 'erc-current-nick-face (pos-eol))
-
- ;; Someone mentions our nick ("tester"), and only their speaker
- ;; tag's nick is highlighted in `erc-current-nick-face' because
- ;; that speaker is a real server user.
- (search-forward "<bob>")
- (goto-char (pos-bol))
- (should-not (get-text-property (point) 'erc-current-nick-face))
- (forward-char)
- (erc-match-tests--assert-face-present 'erc-current-nick-face
- "> hi tester")
- (erc-match-tests--assert-face-absent 'erc-current-nick-face
- (+ (point) (length "hi tester"))))))
-
-(ert-deftest erc-match-message/current-nick/nick-or-keyword ()
- (erc-match-tests--hl-type-nick-or-keyword))
-
-(defun erc-match-tests--hl-type-keyword ()
- (should (eq erc-keyword-highlight-type 'keyword))
-
- (erc-match-tests--perform
- (lambda ()
- (erc-tests-common-add-cmem "bob")
- (erc-tests-common-add-cmem "imamodel")
- (erc-tests-common-add-cmem "ModerNerd")
-
- (let ((erc-keywords '("mode")))
- (erc-tests-common-simulate-line
- ":irc.foonet.org 353 tester = #chan :bob imamodel ModerNerd tester")
- (erc-tests-common-simulate-line
- ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (erc-tests-common-simulate-line
- ":irc.foonet.org 324 tester #chan +Cnt")
- (erc-tests-common-simulate-line
- ":irc.foonet.org 329 tester #chan 1703579802")
- (erc-tests-common-simulate-privmsg "bob" "imamodel: spam a la mode!")
- (erc-tests-common-simulate-privmsg "imamodel" "hi bob"))
-
- (goto-char (point-min))
-
- ;; All occurrences highlighted in a non-user-based message.
- (search-forward "*** Users on #chan:")
- (goto-char (pos-bol))
- (erc-match-tests--assert-face-absent 'erc-keyword-face "model ")
- (erc-match-tests--assert-face-present 'erc-keyword-face "l ")
- (erc-match-tests--assert-face-absent 'erc-keyword-face "Mode")
- (erc-match-tests--assert-face-present 'erc-keyword-face "rNerd")
- (erc-match-tests--assert-face-absent 'erc-keyword-face (pos-eol))
-
- ;; Formatted text matched against rather than original message.
- (search-forward "*** #chan modes:")
- (goto-char (pos-bol))
- (erc-match-tests--assert-face-absent 'erc-keyword-face "modes:")
- (erc-match-tests--assert-face-present 'erc-keyword-face "s: +Cnt")
- (erc-match-tests--assert-face-absent 'erc-keyword-face (pos-eol))
-
- ;; All occurrences highlighted in a user-based message.
- (search-forward "<bob>")
- (goto-char (pos-bol))
- (erc-match-tests--assert-face-absent 'erc-keyword-face "model")
- (erc-match-tests--assert-face-present 'erc-keyword-face "l: spam")
- (erc-match-tests--assert-face-absent 'erc-keyword-face "mode!")
- (erc-match-tests--assert-face-present 'erc-keyword-face "!")
- (erc-match-tests--assert-face-absent 'erc-keyword-face (pos-eol))
-
- ;; Matching speaker ignored.
- (search-forward "<imamodel>")
- (goto-char (pos-bol))
- (erc-match-tests--assert-face-absent 'erc-keyword-face (pos-eol)))))
-
-(ert-deftest erc-match-message/keyword/keyword ()
- (erc-match-tests--hl-type-keyword))
-
-(defun erc-match-tests--log-matches ()
- (let ((erc-log-matches-flag t)
- (erc-timestamp-format "[@@TS@@]")
- (inhibit-message noninteractive))
- (erc-match-tests--hl-type-keyword)
- (with-current-buffer "*scratch*"
- (ert-simulate-keys "\t\r"
- (erc-go-to-log-matches-buffer))
- (should (equal (buffer-name) "ERC Keywords"))
- (goto-char (point-min))
- (should (equal (buffer-string) "\
- == Type \"q\" to dismiss messages ==
-[@@TS@@]<Server:353:#chan> *** Users on #chan: bob imamodel ModerNerd tester
-[@@TS@@]<Server:324:#chan> *** #chan modes: +Cnt
-[@@TS@@]<bob:#chan> imamodel: spam a la mode!
-"))
- (when noninteractive
- (kill-buffer)))))
-
-(ert-deftest erc-log-matches ()
- (erc-match-tests--log-matches))
-
-
-;;; erc-match-tests.el ends here
+++ /dev/null
-;;; erc-networks-tests.el --- Tests for erc-networks. -*- lexical-binding:t -*-
-
-;; Copyright (C) 2020-2025 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 'erc-compat)
-
-(require 'ert-x) ; cl-lib
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-tests-common)))
-
-(defun erc-networks-tests--create-dead-proc (&optional buf)
- (let ((p (start-process "true" (or buf (current-buffer)) "true")))
- (while (process-live-p p) (sit-for 0.1))
- p))
-
-(defun erc-networks-tests--create-live-proc ()
- (erc-tests-common-init-server-proc "sleep" "1"))
-
-;; When we drop 27, call `get-buffer-create with INHIBIT-BUFFER-HOOKS.
-(defun erc-networks-tests--clean-bufs ()
- (erc-tests-common-kill-buffers))
-
-(defun erc-networks-tests--bufnames (prefix)
- (let* ((case-fold-search)
- (pred (lambda (b) (string-prefix-p prefix (buffer-name b))))
- (prefixed (seq-filter pred (buffer-list))))
- (sort (mapcar #'buffer-name prefixed) #'string<)))
-
-(ert-deftest erc-networks--id ()
- (cl-letf (((symbol-function 'float-time)
- (lambda (&optional _) 0.0)))
-
- ;; Fixed
- (should (equal (erc-networks--id-fixed-create 'foo)
- (make-erc-networks--id-fixed :ts (float-time)
- :symbol 'foo)))
-
- ;; Eliding
- (let* ((erc-network 'FooNet)
- (erc-server-current-nick "Joe")
- (identity (erc-networks--id-create nil)))
-
- (should (equal identity #s(erc-networks--id-qualifying
- 0.0 FooNet [FooNet "joe"] 1)))
- (should (equal (erc-networks--id-qualifying-grow-id identity)
- 'FooNet/joe))
- (should (equal identity #s(erc-networks--id-qualifying
- 0.0 FooNet/joe [FooNet "joe"] 2)))
- (should-not (erc-networks--id-qualifying-grow-id identity))
- (should (equal identity #s(erc-networks--id-qualifying
- 0.0 FooNet/joe [FooNet "joe"] 2))))
-
- ;; Compat
- (with-current-buffer (get-buffer-create "fake.chat")
- (with-suppressed-warnings ((obsolete erc-rename-buffers))
- (let (erc-rename-buffers)
- (should (equal (erc-networks--id-create nil)
- (make-erc-networks--id-fixed :ts (float-time)
- :symbol 'fake.chat)))))
- (kill-buffer))))
-
-(ert-deftest erc-networks--id-string ()
- (should (equal (erc-networks--id-string (erc-networks--id-fixed-create 'foo))
- "foo"))
- (should (equal (let* ((erc-network 'FooNet)
- (erc-server-current-nick "Joe")) ; needs letstar
- (erc-networks--id-string (erc-networks--id-create nil)))
- "FooNet")))
-
-(ert-deftest erc-networks--id-create ()
- (cl-letf (((symbol-function 'float-time)
- (lambda (&optional _) 0.0)))
-
- (should (equal (erc-networks--id-create 'foo)
- (make-erc-networks--id-fixed :ts (float-time)
- :symbol 'foo)))
- (should (equal (erc-networks--id-create "foo")
- (make-erc-networks--id-fixed :ts (float-time)
- :symbol 'foo)))
- (should (equal (erc-networks--id-create [h i])
- (make-erc-networks--id-fixed :ts (float-time)
- :symbol (quote \[h\ \i\]))))
-
- (with-current-buffer (get-buffer-create "foo")
- (let ((expected (make-erc-networks--id-fixed :ts (float-time)
- :symbol 'foo)))
- (with-suppressed-warnings ((obsolete erc-rename-buffers))
- (let (erc-rename-buffers)
- (should (equal (erc-networks--id-create nil) expected))))
- (with-suppressed-warnings ((obsolete erc-reuse-buffers))
- (let (erc-reuse-buffers)
- (should (equal (erc-networks--id-create nil) expected))
- (should (equal (erc-networks--id-create 'bar) expected)))))
- (kill-buffer))))
-
-(ert-deftest erc-networks--id-qualifying-prefix-length ()
- (should-not (erc-networks--id-qualifying-prefix-length
- (make-erc-networks--id-qualifying)
- (make-erc-networks--id-qualifying)))
-
- (should-not (erc-networks--id-qualifying-prefix-length
- (make-erc-networks--id-qualifying :parts [1 2])
- (make-erc-networks--id-qualifying :parts [2 3])))
-
- (should (= 1 (erc-networks--id-qualifying-prefix-length
- (make-erc-networks--id-qualifying :parts [1])
- (make-erc-networks--id-qualifying :parts [1 2]))))
-
- (should (= 1 (erc-networks--id-qualifying-prefix-length
- (make-erc-networks--id-qualifying :parts [1 2])
- (make-erc-networks--id-qualifying :parts [1 3]))))
-
- (should (= 2 (erc-networks--id-qualifying-prefix-length
- (make-erc-networks--id-qualifying :parts [1 2])
- (make-erc-networks--id-qualifying :parts [1 2]))))
-
- (should (= 1 (erc-networks--id-qualifying-prefix-length
- (make-erc-networks--id-qualifying :parts ["1"])
- (make-erc-networks--id-qualifying :parts ["1"])))))
-
-(ert-deftest erc-networks--id-sort-buffers ()
- (let (oldest middle newest)
-
- (with-temp-buffer
- (setq erc-networks--id (erc-networks--id-fixed-create 'oldest)
- oldest (current-buffer))
- (sleep-for 0.02)
-
- (with-temp-buffer
- (setq erc-networks--id (erc-networks--id-fixed-create 'middle)
- middle (current-buffer))
- (sleep-for 0.02)
-
- (with-temp-buffer
- (setq erc-networks--id (erc-networks--id-fixed-create 'newest)
- newest (current-buffer))
-
- (should (equal (erc-networks--id-sort-buffers
- (list oldest newest middle))
- (list newest middle oldest))))))))
-
-(ert-deftest erc-networks-rename-surviving-target-buffer--channel ()
- (should (memq #'erc-networks-rename-surviving-target-buffer
- erc-kill-channel-hook))
-
- (let ((chan-foonet-buffer (get-buffer-create "#chan@foonet")))
-
- (with-current-buffer chan-foonet-buffer
- (erc-mode)
- (setq erc-networks--id (make-erc-networks--id-qualifying
- :parts [foonet "bob"] :len 1)
- erc--target (erc--target-from-string "#chan")))
-
- (with-current-buffer (get-buffer-create "#chan@barnet")
- (erc-mode)
- (setq erc-networks--id (make-erc-networks--id-qualifying
- :parts [barnet "bob"] :len 1)
- erc--target (erc--target-from-string "#chan")))
-
- (kill-buffer "#chan@barnet")
- (should (equal (erc-networks-tests--bufnames "#chan") '("#chan")))
- (should (eq chan-foonet-buffer (get-buffer "#chan"))))
-
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks-rename-surviving-target-buffer--query ()
- (should (memq #'erc-networks-rename-surviving-target-buffer
- erc-kill-buffer-hook))
-
- (let ((bob-foonet (get-buffer-create "bob@foonet")))
-
- (with-current-buffer bob-foonet
- (erc-mode)
- (setq erc-networks--id (make-erc-networks--id-qualifying
- :parts [foonet "bob"] :len 1)
- erc--target (erc--target-from-string "bob")))
-
- (with-current-buffer (get-buffer-create "bob@barnet")
- (erc-mode)
- (setq erc-networks--id (make-erc-networks--id-qualifying
- :parts [barnet "bob"] :len 1)
- erc--target (erc--target-from-string "bob")))
-
- (kill-buffer "bob@barnet")
- (should (equal (erc-networks-tests--bufnames "bob") '("bob")))
- (should (eq bob-foonet (get-buffer "bob"))))
-
- (erc-networks-tests--clean-bufs))
-
-;; A non-ERC buffer exists named "bob", and we're killing one of two
-;; ERC target buffers named "bob@<netid>". The surviving buffer
-;; retains its suffix.
-
-(ert-deftest erc-networks-rename-surviving-target-buffer--query-non-target ()
- (should (memq #'erc-networks-rename-surviving-target-buffer
- erc-kill-buffer-hook))
-
- (let ((existing (get-buffer-create "bob"))
- (bob-foonet (get-buffer-create "bob@foonet")))
-
- (with-current-buffer bob-foonet
- (erc-mode)
- (setq erc-networks--id (make-erc-networks--id-qualifying
- :parts [foonet "bob"] :len 1)
- erc--target (erc--target-from-string "bob")))
-
- (with-current-buffer (get-buffer-create "bob@barnet")
- (erc-mode)
- (setq erc-networks--id (make-erc-networks--id-qualifying
- :parts [barnet "bob"] :len 1)
- erc--target (erc--target-from-string "bob")))
-
- (kill-buffer "bob@barnet")
- (should (buffer-live-p existing))
- (should (buffer-live-p bob-foonet))
- (kill-buffer existing))
-
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks-rename-surviving-target-buffer--multi ()
-
- (ert-info ("Multiple leftover channels untouched")
- (with-current-buffer (get-buffer-create "#chan@foonet")
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan")))
- (with-current-buffer (get-buffer-create "#chan@barnet")
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan")))
- (with-current-buffer (get-buffer-create "#chan@baznet")
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan")))
- (kill-buffer "#chan@baznet")
- (should (equal (erc-networks-tests--bufnames "#chan")
- '("#chan@barnet" "#chan@foonet")))
- (erc-networks-tests--clean-bufs))
-
- (ert-info ("Multiple leftover queries untouched")
- (with-current-buffer (get-buffer-create "bob@foonet")
- (erc-mode)
- (setq erc--target (erc--target-from-string "bob")))
- (with-current-buffer (get-buffer-create "bob@barnet")
- (erc-mode)
- (setq erc--target (erc--target-from-string "bob")))
- (with-current-buffer (get-buffer-create "bob@baznet")
- (erc-mode)
- (setq erc--target (erc--target-from-string "bob")))
- (kill-buffer "bob@baznet")
- (should (equal (erc-networks-tests--bufnames "bob")
- '("bob@barnet" "bob@foonet")))
- (erc-networks-tests--clean-bufs)))
-
-;; As of May 2022, this "shrink" stuff runs whenever an ERC buffer is
-;; killed because `erc-networks-shrink-ids-and-buffer-names' is a
-;; default member of all three erc-kill-* functions.
-
-;; Note: this overlaps a fair bit with the "hook" variants, i.e.,
-;; `erc-networks--shrink-ids-and-buffer-names--hook-outstanding-*' If
-;; this ever fails, just delete this and fix those. But please copy
-;; over and adapt the comments first.
-
-(ert-deftest erc-networks--shrink-ids-and-buffer-names--perform-outstanding ()
- ;; While some buffer #a@barnet/dummy is being killed, its display ID
- ;; is not collapsed because collisions still exist.
- ;;
- ;; Note that we don't have to set `erc-server-connected' because
- ;; this function is intentionally connectivity agnostic.
- (with-current-buffer (get-buffer-create "foonet/tester")
- (erc-mode)
- (setq erc-server-current-nick "tester" ; Always set (`erc-open')
- ;; Set when transport connected
- erc-server-process (erc-networks-tests--create-live-proc)
- ;; Both set just before IRC (logically) connected (post MOTD)
- erc-network 'foonet
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'foonet/tester
- :parts [foonet "tester"]
- :len 2))) ; is/was a plain foonet collision
-
- ;; Presumably, some server buffer named foonet/dummy was just
- ;; killed, hence the length 2 display ID.
-
- ;; A target buffer for chan #a exists for foonet/tester. The
- ;; precise form of its name should not affect shrinking.
- (with-current-buffer (get-buffer-create
- (elt ["#a" "#a@foonet" "#a@foonet/tester"] (random 3)))
- (erc-mode)
- (setq erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "foonet/tester"))
- erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (buffer-local-value 'erc-networks--id
- (get-buffer "foonet/tester"))
- erc--target (erc--target-from-string "#a")))
-
- ;; Another network context exists (so we have buffers to iterate
- ;; over), and it's also part of a collision group.
- (with-current-buffer (get-buffer-create "barnet/tester")
- (erc-mode)
- (setq erc-network 'barnet
- erc-server-current-nick "tester"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'barnet/tester
- :parts [barnet "tester"]
- :len 2)
- erc-server-process (erc-networks-tests--create-live-proc)))
-
- (with-current-buffer (get-buffer-create "barnet/dummy")
- (erc-mode)
- (setq erc-network 'barnet
- erc-server-current-nick "dummy"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'barnet/dummy
- :parts [barnet "dummy"]
- :len 2)
- erc-server-process (erc-networks-tests--create-live-proc)))
-
- ;; The buffer being killed is not part of the foonet collision
- ;; group, which contains one display ID eligible for shrinkage.
- (with-current-buffer (get-buffer-create
- (elt ["#a@barnet" "#a@barnet/tester"] (random 2)))
- (erc-mode)
- (setq erc-network 'barnet
- erc-server-current-nick "tester"
- erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "barnet/tester"))
- erc-networks--id (buffer-local-value 'erc-networks--id
- (get-buffer "barnet/tester"))
- erc--target (erc--target-from-string "#a")))
-
- (with-temp-buffer ; doesn't matter what the current buffer is
- (setq erc-networks--id (make-erc-networks--id-qualifying)) ; mock
- (erc-networks--shrink-ids-and-buffer-names))
-
- (should (equal (mapcar #'buffer-name (erc-buffer-list))
- '("foonet" ; shrunk
- "#a@foonet" ; shrunk
- "barnet/tester"
- "barnet/dummy"
- "#a@barnet/tester")))
-
- (erc-networks-tests--clean-bufs))
-
-;; This likewise overlaps with the "hook" variants below. If this
-;; should ever fail, just delete it and optionally fix those.
-
-(ert-deftest erc-networks--shrink-ids-and-buffer-names--perform-collapse ()
- ;; This is similar to the "outstanding" variant above, but both
- ;; groups are eligible for renaming, which is abnormal but possible
- ;; when recovering from some mishap.
- (with-current-buffer (get-buffer-create "foonet/tester")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'foonet/tester
- :parts [foonet "tester"]
- :len 2)
- erc-server-process (erc-networks-tests--create-live-proc)))
-
- (with-current-buffer
- (get-buffer-create (elt ["#a" "#a@foonet/tester"] (random 2)))
- (erc-mode)
- (setq erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "foonet/tester"))
- erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (buffer-local-value 'erc-networks--id
- (get-buffer "foonet/tester"))
- erc--target (erc--target-from-string "#a")))
-
- (with-current-buffer (get-buffer-create "barnet/tester")
- (erc-mode)
- (setq erc-network 'barnet
- erc-server-current-nick "tester"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'barnet/tester
- :parts [barnet "tester"]
- :len 2)
- erc-server-process (erc-networks-tests--create-live-proc)))
-
- (with-current-buffer
- (get-buffer-create (elt ["#b" "#b@foonet/tester"] (random 2)))
- (erc-mode)
- (setq erc-network 'barnet
- erc-server-current-nick "tester"
- erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "barnet/tester"))
- erc-networks--id (buffer-local-value 'erc-networks--id
- (get-buffer "barnet/tester"))
- erc--target (erc--target-from-string "#b")))
-
- (with-temp-buffer
- (setq erc-networks--id (make-erc-networks--id-qualifying))
- (erc-networks--shrink-ids-and-buffer-names))
-
- (should (equal (mapcar #'buffer-name (erc-buffer-list))
- '("foonet" "#a" "barnet" "#b")))
-
- (erc-networks-tests--clean-bufs))
-
-(defun erc-networks--shrink-ids-and-buffer-names--hook-outstanding-common ()
-
- (with-current-buffer (get-buffer-create "foonet/tester")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'foonet/tester
- :parts [foonet "tester"]
- :len 2)
- erc-server-process (erc-networks-tests--create-live-proc)))
-
- (with-current-buffer (get-buffer-create "#a@foonet/tester")
- (erc-mode)
- (setq erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "foonet/tester"))
- erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (buffer-local-value 'erc-networks--id
- (get-buffer "foonet/tester"))
- erc--target (erc--target-from-string "#a")))
-
- (with-current-buffer (get-buffer-create "barnet/tester")
- (erc-mode)
- (setq erc-network 'barnet
- erc-server-current-nick "tester"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'barnet/tester
- :parts [barnet "tester"]
- :len 2)
- erc-server-process (erc-networks-tests--create-live-proc)))
-
- (with-current-buffer (get-buffer-create "barnet/dummy")
- (erc-mode)
- (setq erc-network 'barnet
- erc-server-current-nick "dummy"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'barnet/dummy
- :parts [barnet "dummy"]
- :len 2)
- erc-server-process (erc-networks-tests--create-live-proc)))
-
- (with-current-buffer (get-buffer-create "#a@barnet/tester")
- (erc-mode)
- (setq erc-network 'barnet
- erc-server-current-nick "tester"
- erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "barnet/tester"))
- erc-networks--id (buffer-local-value 'erc-networks--id
- (get-buffer "barnet/tester"))
- erc--target (erc--target-from-string "#a"))))
-
-(ert-deftest erc-networks--shrink-ids-and-buffer-names--hook-outstanding-srv ()
- (erc-networks--shrink-ids-and-buffer-names--hook-outstanding-common)
- (with-current-buffer (get-buffer-create "foonet/dummy")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "dummy"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'foonet/dummy
- :parts [foonet "dummy"]
- :len 2)
- erc-server-process (erc-networks-tests--create-live-proc))
- (kill-buffer))
-
- (should (equal (mapcar #'buffer-name (erc-buffer-list))
- '("foonet"
- "#a@foonet"
- "barnet/tester"
- "barnet/dummy"
- "#a@barnet/tester")))
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--shrink-ids-and-buffer-names--hook-outstanding-tgt ()
- (erc-networks--shrink-ids-and-buffer-names--hook-outstanding-common)
- (with-current-buffer (get-buffer-create "#a@foonet/dummy")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "dummy"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'foonet/dummy
- :parts [foonet "dummy"]
- :len 2)
- erc--target (erc--target-from-string "#a")
- erc-server-process (with-temp-buffer
- (erc-networks-tests--create-dead-proc))))
-
- (with-current-buffer "#a@foonet/dummy" (kill-buffer))
-
- ;; Identical to *-server variant above
- (should (equal (mapcar #'buffer-name (erc-buffer-list))
- '("foonet"
- "#a@foonet"
- "barnet/tester"
- "barnet/dummy"
- "#a@barnet/tester")))
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks-rename-surviving-target-buffer--shrink ()
- (erc-networks--shrink-ids-and-buffer-names--hook-outstanding-common)
-
- ;; This buffer isn't "#a@foonet" (yet) because the shrink-ids hook
- ;; hasn't run. However, when it's the rename hook runs, its network
- ;; id *is* "foonet", not "foonet/tester".
- (with-current-buffer "#a@foonet/tester" (kill-buffer))
-
- (should (equal (mapcar #'buffer-name (erc-buffer-list))
- '("foonet"
- "barnet/tester"
- "barnet/dummy"
- "#a")))
-
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--shrink-ids-and-buffer-names--server ()
-
- (with-current-buffer (get-buffer-create "foonet/tester")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'foonet/tester
- :parts [foonet "tester"]
- :len 2)
- erc-server-process (erc-networks-tests--create-live-proc)))
-
- (with-current-buffer (get-buffer-create "foonet/dummy")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "dummy"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'foonet/dummy
- :parts [foonet "dummy"]
- :len 2)
- erc-server-process (erc-networks-tests--create-dead-proc))
- (kill-buffer))
-
- (should (equal (mapcar #'buffer-name (erc-buffer-list)) '("foonet")))
-
- (erc-networks-tests--clean-bufs))
-
-(defun erc-networks--shrink-ids-and-buffer-names--hook-collapse (check)
-
- (with-current-buffer (get-buffer-create "foonet/tester")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'foonet/tester
- :parts [foonet "tester"]
- :len 2)
- erc-server-process (erc-networks-tests--create-live-proc)))
-
- (with-current-buffer (get-buffer-create "#a@foonet/tester")
- (erc-mode)
- (setq erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "foonet/tester"))
- erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (buffer-local-value 'erc-networks--id
- (get-buffer "foonet/tester"))
- erc--target (erc--target-from-string "#a")))
-
- (with-current-buffer (get-buffer-create "barnet/tester")
- (erc-mode)
- (setq erc-network 'barnet
- erc-server-current-nick "tester"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'barnet/tester
- :parts [barnet "tester"]
- :len 2)
- erc-server-process (erc-networks-tests--create-live-proc)))
-
- (with-current-buffer (get-buffer-create "#b@foonet/tester")
- (erc-mode)
- (setq erc-network 'barnet
- erc-server-current-nick "tester"
- erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "barnet/tester"))
- erc-networks--id (buffer-local-value 'erc-networks--id
- (get-buffer "barnet/tester"))
- erc--target (erc--target-from-string "#b")))
-
- (funcall check)
-
- (should (equal (mapcar #'buffer-name (erc-buffer-list))
- '("foonet" "#a" "barnet" "#b")))
-
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--shrink-ids-and-buffer-names--hook-collapse-server ()
- (erc-networks--shrink-ids-and-buffer-names--hook-collapse
- (lambda ()
- (with-current-buffer (get-buffer-create "foonet/dummy")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "dummy"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'foonet/dummy
- :parts [foonet "dummy"]
- :len 2)
- erc-server-process (erc-networks-tests--create-live-proc))
- (kill-buffer)))))
-
-(ert-deftest erc-networks--shrink-ids-and-buffer-names--hook-collapse-target ()
- (erc-networks--shrink-ids-and-buffer-names--hook-collapse
- (lambda ()
- (with-current-buffer (get-buffer-create "#a@foonet/dummy")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "dummy"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'foonet/dummy
- :parts [foonet "dummy"]
- :len 2)
- erc--target (erc--target-from-string "#a")
- erc-server-process (with-temp-buffer
- (erc-networks-tests--create-dead-proc)))
- (kill-buffer)))))
-
-;; FIXME this test is old and may describe impossible states:
-;; leftover identities being qual-equal but not eq (implies
-;; `erc-networks--reclaim-orphaned-target-buffers' is somehow broken).
-;;
-;; Otherwise, the point of this test is to show that server process
-;; identity does not impact the hunt for duplicates.
-
-(defun erc-tests--prep-erc-networks--reconcile-buffer-names--duplicates (start)
-
- (with-current-buffer (get-buffer-create "foonet")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create nil)
- erc-server-process (funcall start)))
-
- (with-current-buffer (get-buffer-create "#chan") ; prior session
- (erc-mode)
- (setq erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "foonet"))
- erc--target (erc--target-from-string "#chan")
- erc-networks--id (erc-networks--id-create nil)))
-
- (ert-info ("Conflicts not recognized as ERC buffers and not renamed")
- (get-buffer-create "#chan@foonet")
- (should (equal (erc-networks-tests--bufnames "#chan")
- '("#chan" "#chan@foonet"))))
-
- ;; These are dupes (not "collisions")
-
- (with-current-buffer "#chan@foonet" ; same proc
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan")
- erc-network 'foonet
- erc-server-current-nick "tester"
- erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "foonet"))
- erc-networks--id (erc-networks--id-create nil)))
-
- (with-current-buffer (get-buffer-create "#chan@foonet<dead>")
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan")
- erc-server-process (erc-networks-tests--create-dead-proc)
- erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create nil)))
-
- (with-current-buffer (get-buffer-create "#chan@foonet<live>")
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan")
- erc-server-process (erc-networks-tests--create-live-proc)
- erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create nil)))
-
- (let ((created (list (get-buffer "#chan@foonet<live>")
- (get-buffer "#chan@foonet<dead>")
- (get-buffer "#chan@foonet"))))
-
- (with-current-buffer "foonet"
- (should (string= (erc-networks--reconcile-buffer-names
- (erc--target-from-string "#chan") erc-networks--id)
- "#chan")))
-
- (ert-info ("All buffers considered dupes renamed")
- (should (equal (erc-networks-tests--bufnames "#chan")
- '("#chan" "#chan<2>" "#chan<3>" "#chan<4>"))))
-
- (ert-info ("All buffers renamed from newest to oldest")
- (should (equal created (list (get-buffer "#chan<2>")
- (get-buffer "#chan<3>")
- (get-buffer "#chan<4>"))))))
-
- (erc-networks-tests--clean-bufs))
-
-(defun erc-tests--prep-erc-networks--reconcile-buffer-names--dupes-given (go)
-
- ;; The connection's network is discovered before target buffers are
- ;; created. This shows that the network doesn't matter when only
- ;; "given" IDs are present.
- (with-current-buffer (get-buffer-create "oofnet")
- (erc-mode)
- (setq erc-networks--id (erc-networks--id-create 'oofnet)
- erc-network 'foonet
- erc-server-current-nick "tester"
- erc-server-process (funcall go)))
-
- (with-current-buffer (get-buffer-create "#chan") ; prior session
- (erc-mode)
- (setq erc-networks--id (erc-networks--id-create 'oofnet)
- erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "oofnet"))
- erc--target (erc--target-from-string "#chan")))
-
- (with-current-buffer (get-buffer-create "#chan@oofnet") ;dupe/not collision
- (erc-mode)
- (setq erc-networks--id (erc-networks--id-create 'oofnet)
- erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "oofnet"))
- erc--target (erc--target-from-string "#chan")))
-
- (with-current-buffer "oofnet"
- (should (string= (erc-networks--reconcile-buffer-names
- (erc--target-from-string "#chan") erc-networks--id)
- "#chan")))
-
- (ert-info ("All buffers matching target and network renamed")
- (should (equal (erc-networks-tests--bufnames "#chan")
- '("#chan" "#chan<2>"))))
-
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--reconcile-buffer-names--duplicates ()
- (ert-info ("Process live, no error")
- (erc-tests--prep-erc-networks--reconcile-buffer-names--duplicates
- #'erc-networks-tests--create-live-proc))
-
- (ert-info ("Process live, no error, given ID")
- (erc-tests--prep-erc-networks--reconcile-buffer-names--dupes-given
- #'erc-networks-tests--create-live-proc))
-
- (ert-info ("Process dead")
- (erc-tests--prep-erc-networks--reconcile-buffer-names--duplicates
- #'erc-networks-tests--create-dead-proc))
-
- (ert-info ("Process dead, given ID")
- (erc-tests--prep-erc-networks--reconcile-buffer-names--dupes-given
- #'erc-networks-tests--create-dead-proc)))
-
-(defun erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf (check)
- (let ((foonet-proc (with-temp-buffer
- (erc-networks-tests--create-dead-proc))))
- (with-current-buffer (get-buffer-create "barnet")
- (erc-mode)
- (setq erc-network 'barnet
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create nil)
- erc-server-process (erc-networks-tests--create-dead-proc)))
-
- ;; Different proc and not "qual-equal" (different elts)
- (with-current-buffer (get-buffer-create "#chan")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create nil)
- erc--target (erc--target-from-string "#chan")
- erc-server-process foonet-proc))
- (funcall check)
- (erc-networks-tests--clean-bufs)))
-
-(ert-deftest erc-networks--reconcile-buffer-names--no-server-buf ()
- (ert-info ("Existing #chan buffer respected")
- (erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf
- (lambda ()
- (with-current-buffer "barnet"
- (should (string= (erc-networks--reconcile-buffer-names
- (erc--target-from-string "#chan") erc-networks--id)
- "#chan@barnet")))
- (ert-info ("Existing #chan buffer found and renamed")
- (should (equal (erc-networks-tests--bufnames "#chan")
- '("#chan@foonet")))))))
-
- (ert-info ("Existing #chan buffer")
- (erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf
- (lambda ()
- (with-current-buffer (get-buffer-create "foonet")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create nil)
- erc-server-process (erc-networks-tests--create-dead-proc))
- (should (string= (erc-networks--reconcile-buffer-names
- (erc--target-from-string "#chan") erc-networks--id)
- "#chan")))
- (ert-info ("Nothing renamed")
- (should (equal (erc-networks-tests--bufnames "#chan") '("#chan")))))))
-
- (ert-info ("Existing #chan@foonet and #chan@barnet buffers")
- (erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf
- (lambda ()
- (with-current-buffer "#chan"
- (rename-buffer "#chan@foonet"))
- (should-not (get-buffer "#chan@barnet"))
- (with-current-buffer (get-buffer-create "#chan@barnet")
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan")
- erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "barnet"))
- erc-networks--id (erc-networks--id-create nil)))
- (with-current-buffer (get-buffer-create "foonet")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "tester"
- erc-server-process (erc-networks-tests--create-live-proc)
- erc-networks--id (erc-networks--id-create nil))
- (set-process-query-on-exit-flag erc-server-process nil)
- (should (string= (erc-networks--reconcile-buffer-names
- (erc--target-from-string "#chan") erc-networks--id)
- "#chan@foonet")))
- (ert-info ("Nothing renamed")
- (should (equal (erc-networks-tests--bufnames "#chan")
- '("#chan@barnet" "#chan@foonet"))))))))
-
-(defun erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf-given
- (check)
- (let ((oofnet-proc (with-temp-buffer
- (erc-networks-tests--create-dead-proc))))
-
- (with-current-buffer (get-buffer-create "rabnet")
- (erc-mode)
- ;; Again, given name preempts network lookup (unrealistic but
- ;; highlights priorities)
- (setq erc-networks--id (erc-networks--id-create 'rabnet)
- erc-network 'barnet
- erc-server-current-nick "tester"
- erc-server-process (erc-networks-tests--create-dead-proc)))
-
- ;; Identity is not "qual-equal" to above
- (with-current-buffer (get-buffer-create "#chan")
- (erc-mode)
- (setq erc-networks--id (erc-networks--id-create 'oofnet)
- erc-network 'foonet
- erc--target (erc--target-from-string "#chan")
- erc-server-process oofnet-proc))
- (funcall check)
- (erc-networks-tests--clean-bufs)))
-
-(ert-deftest erc-networks--reconcile-buffer-names--no-server-buf-given ()
-
- (ert-info ("Existing #chan buffer respected")
- (erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf-given
- (lambda ()
- (with-current-buffer "rabnet"
- (should (string= (erc-networks--reconcile-buffer-names
- (erc--target-from-string "#chan") erc-networks--id)
- "#chan@rabnet")))
-
- (ert-info ("Existing #chan buffer found and renamed")
- (should (equal (erc-networks-tests--bufnames "#chan")
- '("#chan@oofnet")))))))
-
- (ert-info ("Existing #chan@oofnet and #chan@rabnet buffers")
- (erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf-given
- (lambda ()
- ;; #chan has already been uniquified (but not grown)
- (with-current-buffer "#chan" (rename-buffer "#chan@oofnet"))
- (should-not (get-buffer "#chan@rabnet"))
-
- (with-current-buffer (get-buffer-create "#chan@rabnet")
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan")
- erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "rabnet"))
- erc-networks--id (buffer-local-value 'erc-networks--id
- (get-buffer "rabnet"))))
-
- (with-current-buffer (get-buffer-create "oofnet")
- (erc-mode)
- (setq erc-network 'oofnet
- erc-server-current-nick "tester"
- erc-server-process (erc-networks-tests--create-live-proc)
- erc-networks--id (erc-networks--id-create 'oofnet)) ; given
- (set-process-query-on-exit-flag erc-server-process nil)
- (should (string= (erc-networks--reconcile-buffer-names
- (erc--target-from-string "#chan") erc-networks--id)
- "#chan@oofnet")))
-
- (ert-info ("Nothing renamed")
- (should (equal (erc-networks-tests--bufnames "#chan")
- '("#chan@oofnet" "#chan@rabnet"))))))))
-
-;; This shows a corner case where a user explicitly assigns a "given"
-;; ID via `erc-tls' but later connects again without one. It would
-;; actually probably be better if the given identity were to win and
-;; the derived one got an <n>-suffix.
-;;
-;; If we just compared net identities, the two would match, but they
-;; don't here because one has a given name and the other a
-;; discovered/assembled one; so they are *not* qual-equal.
-(ert-deftest erc-networks--reconcile-buffer-names--no-srv-buf-given-mismatch ()
- ;; Existing #chan buffer *not* respected
- (erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf-given
- (lambda ()
- (with-current-buffer (get-buffer-create "oofnet")
- (erc-mode)
- (setq erc-network 'oofnet
- erc-server-current-nick "tester"
- erc-server-process (erc-networks-tests--create-dead-proc)
- erc-networks--id (erc-networks--id-create nil)) ; derived
- (should (string= (erc-networks--reconcile-buffer-names
- (erc--target-from-string "#chan") erc-networks--id)
- "#chan@oofnet")))
-
- (ert-info ("Collision renamed but not grown (because it's a given)")
- ;; Original chan uniquified and moved out of the way
- (should (equal (erc-networks-tests--bufnames "#chan")
- '("#chan@oofnet<2>")))))))
-
-(defun erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net (check)
-
- (with-current-buffer (get-buffer-create "foonet")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "tester"
- erc-server-process (erc-networks-tests--create-dead-proc)
- erc-networks--id (erc-networks--id-create nil))) ; derived
-
- (with-current-buffer (get-buffer-create "barnet")
- (erc-mode)
- (setq erc-network 'barnet
- erc-server-current-nick "tester"
- erc-server-process (erc-networks-tests--create-dead-proc)
- erc-networks--id (erc-networks--id-create nil))) ; derived
-
- (with-current-buffer
- (get-buffer-create (elt ["#chan" "#chan@foonet"] (random 2)))
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan"))
- (cl-multiple-value-setq (erc-server-process erc-networks--id)
- (with-current-buffer "foonet"
- (list erc-server-process erc-networks--id))))
-
- (with-current-buffer (get-buffer-create "#chan@barnet")
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan"))
- (cl-multiple-value-setq (erc-server-process erc-networks--id)
- (with-current-buffer "barnet"
- (list erc-server-process erc-networks--id))))
-
- (funcall check)
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--reconcile-buffer-names--multi-net ()
- (ert-info ("Same network rename")
- (erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net
- (lambda ()
- (with-current-buffer "foonet"
- (let ((result (erc-networks--reconcile-buffer-names
- (erc--target-from-string "#chan") erc-networks--id)))
- (should (string= result "#chan@foonet"))))
-
- (should (equal (erc-networks-tests--bufnames "#chan")
- '("#chan@barnet" "#chan@foonet"))))))
-
- (ert-info ("Same network keep name")
- (erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net
- (lambda ()
- (with-current-buffer "barnet"
- (let ((result (erc-networks--reconcile-buffer-names
- (erc--target-from-string "#chan") erc-networks--id)))
- (should (string= result "#chan@barnet"))))
-
- (should (equal (erc-networks-tests--bufnames "#chan")
- '("#chan@barnet" "#chan@foonet")))))))
-
-(defun erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-given
- (check)
-
- (with-current-buffer (get-buffer-create "oofnet")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create 'oofnet) ; one given
- erc-server-process (erc-networks-tests--create-dead-proc)))
-
- (with-current-buffer (get-buffer-create "rabnet")
- (erc-mode)
- (setq erc-network 'barnet
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create 'rabnet) ; another given
- erc-server-process (erc-networks-tests--create-dead-proc)))
-
- (with-current-buffer (get-buffer-create (elt ["chan" "#chan@oofnet"]
- (random 2)))
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan"))
- (cl-multiple-value-setq (erc-server-process erc-networks--id)
- (with-current-buffer "oofnet"
- (list erc-server-process erc-networks--id))))
-
- (with-current-buffer (get-buffer-create "#chan@barnet")
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan"))
- (cl-multiple-value-setq (erc-server-process erc-networks--id)
- (with-current-buffer "rabnet"
- (list erc-server-process erc-networks--id))))
-
- (funcall check)
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--reconcile-buffer-names--multi-net-given ()
- (ert-info ("Same network rename")
- (erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-given
- (lambda ()
- (with-current-buffer "oofnet"
- (let ((result (erc-networks--reconcile-buffer-names
- (erc--target-from-string "#chan") erc-networks--id)))
- (should (string= result "#chan@oofnet"))))
-
- (should (equal (erc-networks-tests--bufnames "#chan")
- '("#chan@oofnet" "#chan@rabnet"))))))
-
- (ert-info ("Same network keep name")
- (erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-given
- (lambda ()
- (with-current-buffer "rabnet"
- (let ((result (erc-networks--reconcile-buffer-names
- (erc--target-from-string "#chan") erc-networks--id)))
- (should (string= result "#chan@rabnet"))))
-
- (should (equal (erc-networks-tests--bufnames "#chan")
- '("#chan@oofnet" "#chan@rabnet")))))))
-
-(defun erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-mixed
- (check)
-
- (with-current-buffer (get-buffer-create "foonet")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create nil) ; one derived
- erc-server-process (erc-networks-tests--create-dead-proc)))
-
- (with-current-buffer (get-buffer-create "my-conn")
- (erc-mode)
- (setq erc-network 'barnet
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create 'my-conn) ; one given
- erc-server-process (erc-networks-tests--create-dead-proc)))
-
- (with-current-buffer (get-buffer-create (elt ["#chan" "#chan@foonet"]
- (random 2)))
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan"))
- (cl-multiple-value-setq (erc-server-process erc-networks--id)
- (with-current-buffer "foonet"
- (list erc-server-process erc-networks--id))))
-
- (with-current-buffer (get-buffer-create "#chan@my-conn")
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan"))
- (cl-multiple-value-setq (erc-server-process erc-networks--id)
- (with-current-buffer "my-conn"
- (list erc-server-process erc-networks--id))))
-
- (funcall check)
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--reconcile-buffer-names--multi-net-existing ()
-
- (ert-info ("Buf name derived from network")
- (erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-mixed
- (lambda ()
- (with-current-buffer "foonet"
- (let ((result (erc-networks--reconcile-buffer-names
- (erc--target-from-string "#chan") erc-networks--id)))
- (should (string= result "#chan@foonet"))))
-
- (should (equal (erc-networks-tests--bufnames "#chan")
- '("#chan@foonet" "#chan@my-conn"))))))
-
- (ert-info ("Buf name given")
- (erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-mixed
- (lambda ()
- (with-current-buffer "my-conn"
- (let ((result (erc-networks--reconcile-buffer-names
- (erc--target-from-string "#chan") erc-networks--id)))
- (should (string= result "#chan@my-conn"))))
-
- (should (equal (erc-networks-tests--bufnames "#chan")
- '("#chan@foonet" "#chan@my-conn")))))))
-
-(ert-deftest erc-networks--reconcile-buffer-names--multi-net-suffixed ()
- ;; Two networks, same channel. One network has two connections.
- ;; When the same channel is joined on the latter under a different
- ;; nick, all buffer names involving that network are suffixed with
- ;; the network identity.
-
- (with-current-buffer (get-buffer-create "foonet/bob")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "bob"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'foonet/bob
- :parts [foonet "bob"]
- :len 2)
- erc-server-process (erc-networks-tests--create-live-proc)))
-
- (with-current-buffer (get-buffer-create
- (elt ["#chan@foonet" "#chan@foonet/bob"] (random 2)))
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan")
- erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "foonet/bob"))
- erc-networks--id (buffer-local-value 'erc-networks--id
- (get-buffer "foonet/bob"))))
-
- (with-current-buffer (get-buffer-create "barnet")
- (erc-mode)
- (setq erc-network 'barnet
- erc-server-current-nick (elt ["alice" "bob"] (random 2))
- erc-networks--id (erc-networks--id-create 'barnet)
- erc-server-process (erc-networks-tests--create-live-proc)))
-
- (with-current-buffer (get-buffer-create "#chan@barnet")
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan")
- erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "barnet"))
- erc-networks--id (buffer-local-value 'erc-networks--id
- (get-buffer "barnet"))))
-
- (with-current-buffer (get-buffer-create "foonet/alice")
- (erc-mode)
- (setq erc-network 'foonet
- erc-server-current-nick "alice"
- erc-networks--id (make-erc-networks--id-qualifying
- :symbol 'foonet/alice
- :parts [foonet "alice"]
- :len 2)
- erc-server-process (erc-networks-tests--create-live-proc)))
-
- (with-current-buffer "foonet/alice"
- (let ((result (erc-networks--reconcile-buffer-names
- (erc--target-from-string "#chan") erc-networks--id)))
- (should (string= result "#chan@foonet/alice"))))
-
- (should (equal (erc-networks-tests--bufnames "#chan")
- '("#chan@barnet" "#chan@foonet/bob")))
-
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--reconcile-buffer-names--local ()
- (with-current-buffer (get-buffer-create "DALnet")
- (erc-mode)
- (setq erc-network 'DALnet
- erc-server-announced-name "elysium.ga.us.dal.net"
- erc-server-process (erc-networks-tests--create-dead-proc)
- erc--isupport-params (make-hash-table)
- erc-networks--id (erc-networks--id-create nil))
- (puthash 'CHANTYPES '("&#") erc--isupport-params))
-
- (ert-info ("Local chan buffer from older, disconnected identity")
- (with-current-buffer (get-buffer-create "&chan")
- (erc-mode)
- ;; Cheat here because localp is determined on identity init
- (setq erc--target (with-current-buffer "DALnet"
- (erc--target-from-string "&chan"))
- erc-network 'DALnet
- erc-server-announced-name "twisted.ma.us.dal.net"
- erc-server-process (erc-networks-tests--create-dead-proc)
- erc-networks--id (erc-networks--id-create nil))))
-
- (ert-info ("Local channels renamed using network server names")
- (with-current-buffer "DALnet"
- (let ((result (erc-networks--reconcile-buffer-names
- (erc--target-from-string "&chan") erc-networks--id)))
- (should (string= result "&chan@elysium.ga.us.dal.net")))))
-
- (should (get-buffer "&chan@twisted.ma.us.dal.net"))
- (should-not (get-buffer "&chan"))
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--set-name ()
- (with-current-buffer (get-buffer-create "localhost:6667")
- (let (erc-server-announced-name
- (erc--isupport-params (make-hash-table))
- erc-network
- erc-quit-hook
- (erc-server-process (erc-networks-tests--create-live-proc))
- calls)
- (erc-mode)
-
- (cl-letf (((symbol-function 'erc--route-insertion)
- (lambda (&rest r) (ignore (push r calls)))))
-
- (ert-info ("Signals when `erc-server-announced-name' unset")
- (should-error (erc-networks--set-name nil (make-erc-response)))
- (should-not calls))
-
- (ert-info ("Signals when table empty and NETWORK param unset")
- (setq erc-server-announced-name "irc.fake.gnu.org")
- (should (eq 'error (erc-networks--set-name nil (make-erc-response))))
- (should (string-match-p (rx "*** Failed") (car (pop calls)))))))
-
- (erc-networks-tests--clean-bufs)))
-
-(ert-deftest erc-networks--ensure-announced ()
- (with-current-buffer (get-buffer-create "localhost:6667")
- (should (local-variable-if-set-p 'erc-server-announced-name))
- (let (erc-insert-modify-hook
- (erc-server-process (erc-networks-tests--create-live-proc))
- (parsed (make-erc-response
- :unparsed ":irc.barnet.org 422 tester :MOTD File is missing"
- :sender "irc.barnet.org"
- :command "422"
- :command-args '("tester" "MOTD File is missing")
- :contents "MOTD File is missing")))
-
- (erc-mode) ; boilerplate displayable start (needs `erc-server-process')
- (erc--initialize-markers (point) nil)
-
- (erc-networks--ensure-announced erc-server-process parsed)
- (goto-char (point-min))
- (search-forward "Failed")
- (should (string= erc-server-announced-name "irc.barnet.org")))
- (when noninteractive (kill-buffer))))
-
-(ert-deftest erc-networks--rename-server-buffer--no-existing--orphan ()
- (with-current-buffer (get-buffer-create "#chan")
- (erc-mode)
- (setq erc-network 'FooNet
- erc-server-current-nick "tester"
- erc--target (erc--target-from-string "#chan")
- erc-networks--id (erc-networks--id-create nil)))
-
- (with-current-buffer (get-buffer-create "irc.foonet.org")
- (erc-mode)
- (erc--initialize-markers (point) nil)
- (setq erc-network 'FooNet
- erc-server-current-nick "tester"
- erc-server-process (erc-networks-tests--create-live-proc)
- erc-networks--id (erc-networks--id-create nil))
- (should-not (erc-networks--rename-server-buffer erc-server-process))
- (should (string= (buffer-name) "FooNet")))
-
- (ert-info ("Channel buffer reassociated")
- (erc-server-process-alive "#chan")
- (with-current-buffer "#chan"
- (should erc-server-connected)
- (erc-with-server-buffer
- (should (string= (buffer-name) "FooNet")))))
-
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--rename-server-buffer--existing--reuse ()
- (let* ((old-buf (get-buffer-create "FooNet"))
- (old-proc (erc-networks-tests--create-dead-proc old-buf)))
-
- (with-current-buffer old-buf
- (erc-mode)
- (insert "*** Old buf")
- (erc--initialize-markers (point) nil)
- (setq erc-network 'FooNet
- erc-server-current-nick "tester"
- erc-server-process old-proc
- erc-networks--id (erc-networks--id-create nil)))
-
- (with-current-buffer (get-buffer-create "#chan")
- (erc-mode)
- (setq erc-network 'FooNet
- erc-server-process old-proc
- erc-networks--id (erc-networks--id-create nil)
- erc--target (erc--target-from-string "#chan")))
-
- (ert-info ("New buffer steals name, content")
- (with-current-buffer (get-buffer-create "irc.foonet.org")
- (erc-mode)
- (erc--initialize-markers (point) nil)
- (setq erc-network 'FooNet
- erc-server-current-nick "tester"
- erc-server-process (erc-networks-tests--create-live-proc)
- erc-networks--id (erc-networks--id-create nil))
- (should-not (erc-networks--rename-server-buffer erc-server-process))
- (should (string= (buffer-name) "FooNet"))
- (goto-char (point-min))
- (should (search-forward "Old buf"))))
-
- (ert-info ("Channel buffer reassociated")
- (erc-server-process-alive "#chan")
- (with-current-buffer "#chan"
- (should erc-server-connected)
- (should-not (eq erc-server-process old-proc))
- (erc-with-server-buffer
- (should (string= (buffer-name) "FooNet")))))
-
- (ert-info ("Original buffer killed off")
- (should-not (buffer-live-p old-buf))))
-
- (erc-networks-tests--clean-bufs))
-
-;; This is for compatibility with pre-28.1 behavior. Basically, we're
-;; trying to match the behavior bug for bug. All buffers were always
-;; suffixed and never reassociated. 28.1 introduced a regression that
-;; reversed the latter, but we've reverted that.
-
-(ert-deftest erc-networks--rename-server-buffer--existing--noreuse ()
- (with-suppressed-warnings ((obsolete erc-reuse-buffers))
- (should erc-reuse-buffers) ; default
- (let* ((old-buf (get-buffer-create "irc.foonet.org:6697/irc.foonet.org"))
- (old-proc (erc-networks-tests--create-dead-proc old-buf))
- erc-reuse-buffers)
- (with-current-buffer old-buf
- (erc-mode)
- (erc--initialize-markers (point) nil)
- (insert "*** Old buf")
- (setq erc-network 'FooNet
- erc-server-current-nick "tester"
- erc-server-process old-proc
- erc-networks--id (erc-networks--id-create nil)))
- (with-current-buffer (get-buffer-create "#chan")
- (erc-mode)
- (setq erc-network 'FooNet
- erc-server-process old-proc
- erc-networks--id (buffer-local-value 'erc-networks--id old-buf)
- erc--target (erc--target-from-string "#chan"))
- (rename-buffer (erc-networks--construct-target-buffer-name erc--target)))
-
- (ert-info ("Server buffer uniquely renamed")
- (with-current-buffer
- (get-buffer-create "irc.foonet.org:6697/irc.foonet.org<2>")
- (erc-mode)
- (setq erc-network 'FooNet
- erc-server-current-nick "tester"
- erc-server-process (erc-networks-tests--create-live-proc)
- erc-networks--id (erc-networks--id-create nil))
- (should-not (erc-networks--rename-server-buffer erc-server-process))
- (should (string= (buffer-name)
- "irc.foonet.org:6697/irc.foonet.org<2>"))
- (goto-char (point-min))
- (should-not (search-forward "Old buf" nil t))))
-
- (ert-info ("Channel buffer not reassociated")
- (should-not
- (erc-server-process-alive
- (should (get-buffer "#chan/irc.foonet.org"))))
- (with-current-buffer "#chan/irc.foonet.org"
- (should-not erc-server-connected)
- (should (eq erc-server-process old-proc))
- (erc-with-server-buffer
- (should (string= (buffer-name)
- "irc.foonet.org:6697/irc.foonet.org")))))
-
- (ert-info ("Old buffer still around")
- (should (buffer-live-p old-buf)))))
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--rename-server-buffer--reconnecting ()
- (let* ((old-buf (get-buffer-create "FooNet"))
- (old-proc (erc-networks-tests--create-dead-proc old-buf)))
-
- (with-current-buffer old-buf
- (erc-mode)
- (erc--initialize-markers (point) nil)
- (insert "*** Old buf")
- (setq erc-network 'FooNet
- erc-server-current-nick "tester"
- erc-server-process old-proc
- erc-networks--id (erc-networks--id-create nil)))
-
- (with-current-buffer (get-buffer-create "#chan")
- (erc-mode)
- (setq erc-network 'FooNet
- erc-server-process old-proc
- erc--target (erc--target-from-string "#chan")
- erc-networks--id (erc-networks--id-create nil)))
-
- (ert-info ("No new buffer")
- (with-current-buffer old-buf
- (setq erc-server-process (erc-networks-tests--create-live-proc))
- (should-not (erc-networks--rename-server-buffer erc-server-process))
- (should (string= (buffer-name) "FooNet"))
- (goto-char (point-min))
- (should (search-forward "Old buf"))))
-
- (ert-info ("Channel buffer updated with live proc")
- (erc-server-process-alive "#chan")
- (with-current-buffer "#chan"
- (should erc-server-connected)
- (should-not (eq erc-server-process old-proc))
- (erc-with-server-buffer
- (should (string= (buffer-name) "FooNet"))))))
-
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--rename-server-buffer--id ()
- (let* ((old-buf (get-buffer-create "MySession"))
- (old-proc (erc-networks-tests--create-dead-proc old-buf)))
-
- (with-current-buffer old-buf
- (erc-mode)
- (erc--initialize-markers (point) nil)
- (insert "*** Old buf")
- (setq erc-network 'FooNet
- erc-networks--id (erc-networks--id-create 'MySession)
- erc-server-process old-proc))
-
- (with-current-buffer (get-buffer-create "#chan")
- (erc-mode)
- (setq erc-network 'FooNet
- erc-networks--id (erc-networks--id-create 'MySession)
- erc-server-process old-proc
- erc--target (erc--target-from-string "#chan")))
-
- (ert-info ("No new buffer")
- (with-current-buffer old-buf
- (setq erc-server-process (erc-networks-tests--create-live-proc))
- (should-not (erc-networks--rename-server-buffer erc-server-process))
- (should (string= (buffer-name) "MySession"))
- (goto-char (point-min))
- (should (search-forward "Old buf"))))
-
- (ert-info ("Channel buffer updated with live proc")
- (erc-server-process-alive "#chan")
- (with-current-buffer "#chan"
- (should erc-server-connected)
- (should-not (eq erc-server-process old-proc))
- (erc-with-server-buffer
- (should (string= (buffer-name) "MySession"))))))
-
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--rename-server-buffer--existing--live ()
- (let* (erc-kill-server-hook
- erc-insert-modify-hook
- (old-buf (get-buffer-create "FooNet"))
- ;;
- old-proc) ; live
-
- (with-current-buffer old-buf
- (erc-mode)
- (setq old-proc (erc-networks-tests--create-live-proc))
- (erc--initialize-markers (point) nil)
- (insert "*** Old buf")
- (setq erc-network 'FooNet
- erc-server-current-nick "tester"
- erc-server-process old-proc
- erc-networks--id (erc-networks--id-create nil))
- (should (erc-server-process-alive)))
-
- (with-current-buffer (get-buffer-create "#chan")
- (erc-mode)
- (setq erc-network 'FooNet
- erc-server-process old-proc
- erc-networks--id (erc-networks--id-create nil)
- erc-server-connected t
- erc--target (erc--target-from-string "#chan")))
-
- (ert-info ("New buffer rejected, abandoned, not killed")
- (with-current-buffer (get-buffer-create "irc.foonet.org")
- (erc-mode)
- (erc--initialize-markers (point) nil)
- (setq erc-network 'FooNet
- erc-server-current-nick "tester"
- erc-server-process (erc-networks-tests--create-live-proc)
- erc-networks--id (erc-networks--id-create nil))
- (set-process-sentinel erc-server-process #'ignore)
- (erc-display-message nil 'notice (current-buffer) "notice")
- (with-silent-modifications
- (should-not (erc-networks--rename-server-buffer erc-server-process)))
- (should (eq erc-active-buffer old-buf))
- (should-not (erc-server-process-alive))
- (should (string= (buffer-name) "irc.foonet.org"))
- (goto-char (point-min))
- (search-forward "still connected")))
-
- (ert-info ("Channel buffer updated with live proc")
- (should (erc-server-process-alive "#chan"))
- (with-current-buffer "#chan"
- (should erc-server-connected)
- (should (erc-server-buffer-live-p))
- (should (eq erc-server-process old-proc))
- (should (buffer-live-p (process-buffer erc-server-process)))
- (with-current-buffer (process-buffer erc-server-process)
- (should (eq (current-buffer) (get-buffer "FooNet")))
- (should (eq (current-buffer) old-buf))))))
-
- (should (get-buffer "FooNet"))
- (should (get-buffer "irc.foonet.org"))
-
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--rename-server-buffer--local-match ()
- (let* ((old-buf (get-buffer-create "FooNet"))
- (old-proc (erc-networks-tests--create-dead-proc old-buf)))
-
- (with-current-buffer old-buf
- (erc-mode)
- (insert "*** Old buf")
- (erc--initialize-markers (point) nil)
- (setq erc-network 'FooNet
- erc-server-current-nick "tester"
- erc-server-announced-name "us-east.foonet.org"
- erc-server-process old-proc
- erc--isupport-params (make-hash-table)
- erc-networks--id (erc-networks--id-create nil))
- (puthash 'CHANTYPES '("&#") erc--isupport-params))
-
- (with-current-buffer (get-buffer-create "&chan")
- (erc-mode)
- (setq erc-network 'FooNet
- erc-server-process old-proc
- erc-server-announced-name "us-east.foonet.org"
- erc--target (erc--target-from-string "&chan")
- erc-networks--id (erc-networks--id-create nil)))
-
- (ert-info ("New server buffer steals name, content")
- (with-current-buffer (get-buffer-create "irc.foonet.org")
- (erc-mode)
- (erc--initialize-markers (point) nil)
- (setq erc-network 'FooNet
- erc-server-current-nick "tester"
- erc-server-announced-name "us-east.foonet.org"
- erc-server-process (erc-networks-tests--create-live-proc)
- erc--isupport-params (make-hash-table)
- erc-networks--id (erc-networks--id-create nil))
- (puthash 'CHANTYPES '("&#") erc--isupport-params)
- (should-not (erc-networks--rename-server-buffer erc-server-process))
- (should (string= (buffer-name) "FooNet"))
- (goto-char (point-min))
- (should (search-forward "Old buf"))))
-
- (ert-info ("Channel buffer reassociated when &local server matches")
- (should (erc-server-process-alive "&chan"))
- (with-current-buffer "&chan"
- (should erc-server-connected)
- (should-not (eq erc-server-process old-proc))
- (erc-with-server-buffer
- (should (string= (buffer-name) "FooNet")))))
-
- (ert-info ("Original buffer killed off")
- (should-not (buffer-live-p old-buf)))
-
- (erc-networks-tests--clean-bufs)))
-
-(ert-deftest erc-networks--rename-server-buffer--local-nomatch ()
- (let* ((old-buf (get-buffer-create "FooNet"))
- (old-proc (erc-networks-tests--create-dead-proc old-buf)))
-
- (with-current-buffer old-buf
- (erc-mode)
- (insert "*** Old buf")
- (erc--initialize-markers (point) nil)
- (setq erc-network 'FooNet
- erc-server-current-nick "tester"
- erc-server-announced-name "us-west.foonet.org"
- erc-server-process old-proc
- erc--isupport-params (make-hash-table)
- erc-networks--id (erc-networks--id-create nil))
- (puthash 'CHANTYPES '("&#") erc--isupport-params))
-
- (with-current-buffer (get-buffer-create "&chan")
- (erc-mode)
- (setq erc-network 'FooNet
- erc-server-process old-proc
- erc-server-announced-name "us-west.foonet.org" ; west
- erc--target (erc--target-from-string "&chan")
- erc-networks--id (erc-networks--id-create nil)))
-
- (ert-info ("New server buffer steals name, content")
- (with-current-buffer (get-buffer-create "irc.foonet.org")
- (erc-mode)
- (erc--initialize-markers (point) nil)
- (setq erc-network 'FooNet
- erc-server-current-nick "tester"
- erc-server-announced-name "us-east.foonet.org" ; east
- erc-server-process (erc-networks-tests--create-live-proc)
- erc--isupport-params (make-hash-table)
- erc-networks--id (erc-networks--id-create nil))
-
- (puthash 'CHANTYPES '("&#") erc--isupport-params)
- (should-not (erc-networks--rename-server-buffer erc-server-process))
- (should (string= (buffer-name) "FooNet"))
- (goto-char (point-min))
- (should (search-forward "Old buf"))))
-
- (ert-info ("Channel buffer now orphaned even though network matches")
- (should-not (erc-server-process-alive "&chan"))
- (with-current-buffer "&chan"
- (should-not erc-server-connected)
- (should (eq erc-server-process old-proc))
- (erc-with-server-buffer
- (should (string= (buffer-name) "FooNet")))))
-
- (ert-info ("Original buffer killed off")
- (should-not (buffer-live-p old-buf)))
-
- (erc-networks-tests--clean-bufs)))
-
-(ert-deftest erc-networks--update-server-identity--double-existing ()
- (with-temp-buffer
- (erc-mode)
- (setq erc-networks--id (make-erc-networks--id-qualifying
- :parts [foonet "bob"] :len 1))
-
- (with-current-buffer (get-buffer-create "#chan@foonet/bob")
- (erc-mode)
- (setq erc-networks--id (make-erc-networks--id-qualifying
- :parts [foonet "bob"] :len 2)))
- (with-current-buffer (get-buffer-create "foonet/alice")
- (erc-mode)
- (setq erc-networks--id
- (make-erc-networks--id-qualifying :parts [foonet "alice"] :len 2)))
-
- (ert-info ("Adopt equivalent identity")
- (should (eq (erc-networks--update-server-identity)
- (buffer-local-value 'erc-networks--id
- (get-buffer "#chan@foonet/bob")))))
-
- (ert-info ("Ignore non-matches")
- (should-not (erc-networks--update-server-identity))
- (should (eq erc-networks--id
- (buffer-local-value 'erc-networks--id
- (get-buffer "#chan@foonet/bob"))))))
-
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--update-server-identity--double-new ()
- (with-temp-buffer
- (erc-mode)
- (setq erc-networks--id (make-erc-networks--id-qualifying
- :parts [foonet "bob"] :len 1))
-
- (with-current-buffer (get-buffer-create "foonet/alice")
- (erc-mode)
- (setq erc-networks--id
- (make-erc-networks--id-qualifying :parts [foonet "alice"] :len 2)))
- (with-current-buffer (get-buffer-create "#chan@foonet/alice")
- (erc-mode)
- (setq erc-networks--id (buffer-local-value 'erc-networks--id
- (get-buffer "foonet/alice"))))
-
- (ert-info ("Evolve identity to prevent ambiguity")
- (should-not (erc-networks--update-server-identity))
- (should (= (erc-networks--id-qualifying-len erc-networks--id) 2))
- (should (eq (erc-networks--id-symbol erc-networks--id) 'foonet/bob))))
-
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--update-server-identity--double-bounded ()
- (with-temp-buffer
- (erc-mode)
- (setq erc-networks--id (make-erc-networks--id-qualifying
- :parts [foonet "bob"] :len 1))
-
- (with-current-buffer (get-buffer-create "foonet/alice/home")
- (erc-mode)
- (setq erc-networks--id (make-erc-networks--id-qualifying
- :parts [foonet "alice" home] :len 3)))
- (with-current-buffer (get-buffer-create "#chan@foonet/alice/home")
- (erc-mode)
- (setq erc-networks--id
- (buffer-local-value 'erc-networks--id
- (get-buffer "foonet/alice/home"))))
-
- (ert-info ("Evolve identity to prevent ambiguity")
- (should-not (erc-networks--update-server-identity))
- (should (= (erc-networks--id-qualifying-len erc-networks--id) 2))
- (should (eq (erc-networks--id-symbol erc-networks--id) 'foonet/bob))))
-
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--update-server-identity--double-even ()
- (with-temp-buffer
- (erc-mode)
- (setq erc-networks--id
- (make-erc-networks--id-qualifying :parts [foonet "bob"] :len 1))
-
- (with-current-buffer (get-buffer-create "foonet")
- (erc-mode)
- (setq erc-networks--id
- (make-erc-networks--id-qualifying :parts [foonet "alice"] :len 1)))
- (with-current-buffer (get-buffer-create "#chan")
- (erc-mode)
- (setq erc--target (erc--target-from-string "#chan")
- erc-networks--id (buffer-local-value 'erc-networks--id
- (get-buffer "foonet"))))
-
- (ert-info ("Evolve identity to prevent ambiguity")
- (should-not (erc-networks--update-server-identity))
- (should (= (erc-networks--id-qualifying-len erc-networks--id) 2))
- (should (eq (erc-networks--id-symbol erc-networks--id) 'foonet/bob)))
-
- (ert-info ("Collision renamed")
- (with-current-buffer "foonet/alice"
- (should (eq (erc-networks--id-symbol erc-networks--id) 'foonet/alice)))
-
- (with-current-buffer "#chan@foonet/alice"
- (should (eq (erc-networks--id-symbol erc-networks--id)
- 'foonet/alice)))))
-
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--update-server-identity--triple-new ()
- (with-temp-buffer
- (erc-mode)
- (setq erc-networks--id
- (make-erc-networks--id-qualifying :parts [foonet "bob" home] :len 1))
-
- (with-current-buffer (get-buffer-create "foonet/bob/office")
- (erc-mode)
- (setq erc-networks--id
- (make-erc-networks--id-qualifying :parts [foonet "bob" office]
- :len 3)))
- (with-current-buffer (get-buffer-create "#chan@foonet/bob/office")
- (erc-mode)
- (setq erc-networks--id
- (buffer-local-value 'erc-networks--id
- (get-buffer "foonet/bob/office"))))
-
- (ert-info ("Extend our identity's canonical ID so that it's unique")
- (should-not (erc-networks--update-server-identity))
- (should (= (erc-networks--id-qualifying-len erc-networks--id) 3))))
-
- (erc-networks-tests--clean-bufs))
-
-(ert-deftest erc-networks--determine ()
- (should (eq (erc-networks--determine "irc.libera.chat") 'Libera.Chat))
- (should (eq (erc-networks--determine "irc.oftc.net") 'OFTC))
- (should (eq (erc-networks--determine "irc.dal.net") 'DALnet))
-
- (let ((erc-server-announced-name "zirconium.libera.chat"))
- (should (eq (erc-networks--determine) 'Libera.Chat)))
- (let ((erc-server-announced-name "weber.oftc.net"))
- (should (eq (erc-networks--determine) 'OFTC)))
- (let ((erc-server-announced-name "redemption.ix.us.dal.net"))
- (should (eq (erc-networks--determine) 'DALnet)))
-
- ;; Failure
- (let ((erc-server-announced-name "irc-us2.alphachat.net"))
- (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))))))
-
-(ert-deftest erc-networks--examine-targets ()
- (with-current-buffer (erc-tests-common-make-server-buf "foonet")
- (erc--open-target "#chan")
- (erc--open-target "#spam"))
-
- (with-current-buffer (erc-tests-common-make-server-buf "barnet")
- (with-current-buffer (erc--open-target "*query")
- (setq erc-networks--id nil))
- (with-current-buffer (erc--open-target "#chan")
- (let ((calls ())
- (snap (lambda (parameter)
- (list parameter
- (erc-target)
- (erc-networks--id-symbol erc-networks--id)))))
-
- ;; Search for "#chan" dupes among targets of all servers.
- (should (equal
- (erc-networks--examine-targets erc-networks--id erc--target
- (lambda () (push (funcall snap 'ON-DUPE) calls))
- (lambda () (push (funcall snap 'ON-COLL) calls)))
- (list (get-buffer "#chan@foonet")
- (get-buffer "#chan@barnet"))))
-
- (should (equal (pop calls) '(ON-DUPE "#chan" barnet)))
- (should (equal (pop calls) '(ON-COLL "#chan" foonet)))
- (should-not calls)
- (should-not (get-buffer "#chan"))
- (should (get-buffer "#chan@barnet"))
- (should (get-buffer "#chan@foonet"))
-
- ;; Search for "*query" dupes among targets of all servers.
- (should (equal (erc-networks--examine-targets erc-networks--id
- (buffer-local-value 'erc--target
- (get-buffer "*query"))
- (lambda () (push (funcall snap 'ON-DUPE) calls))
- (lambda () (push (funcall snap 'ON-COLL) calls)))
- (list (get-buffer "*query"))))
-
- (should (equal (pop calls) '(ON-DUPE "*query" barnet)))
- (should-not calls)))
-
- (goto-char (point-min))
- (should (search-forward "Missing network session" nil t)))
-
- (erc-tests-common-kill-buffers))
-
-;;; erc-networks-tests.el ends here
+++ /dev/null
-;;; erc-nicks-tests.el --- Tests for erc-nicks -*- lexical-binding:t -*-
-
-;; Copyright (C) 2023-2025 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 'erc-nicks)
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-tests-common)))
-
-;; 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 2) ; skip Inherit:...
- (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-culled-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-culled-pool '(erc-nicks-invert) '("white")))
- (should (equal (pop erc-nicks--colors-rejects) "white")) ; too close
- (should-not
- (erc-nicks--create-culled-pool '(erc-nicks-cap-contrast) '("black")))
- (should (equal (pop erc-nicks--colors-rejects) "black")) ; too far
- (should-not
- (erc-nicks--create-culled-pool '(erc-nicks-ensaturate) '("white")))
- (should (equal (pop erc-nicks--colors-rejects) "white")) ; lacks color
- (should-not
- (erc-nicks--create-culled-pool '(erc-nicks-ensaturate) '("red")))
- (should (equal (pop erc-nicks--colors-rejects) "red")) ; too much color
-
- ;; Safe
- (should (equal (erc-nicks--create-culled-pool '(erc-nicks-invert)
- '("black"))
- '("black")))
- (should (equal (erc-nicks--create-culled-pool '(erc-nicks-add-contrast)
- '("black"))
- '("black")))
- (should (equal (erc-nicks--create-culled-pool '(erc-nicks-cap-contrast)
- '("white"))
- '("white")))
- (let ((erc-nicks-saturation-range '(0.5 . 1.0)))
- (should (equal (erc-nicks--create-culled-pool '(erc-nicks-ensaturate)
- '("green"))
- '("green"))))
- (let ((erc-nicks-saturation-range '(0.0 . 0.5)))
- (should (equal (erc-nicks--create-culled-pool '(erc-nicks-ensaturate)
- '("gray"))
- '("gray"))))
- (unless noninteractive
- (should (equal (erc-nicks--create-culled-pool '(erc-nicks-ensaturate)
- '("firebrick"))
- '("firebrick"))))
- (should (equal erc-nicks--colors-rejects '(t)))))
-
-(ert-deftest erc-nicks--create-coerced-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")
- (num-colors (length (defined-colors)))
- ;;
- (erc-nicks--colors-rejects '(t)))
-
- ;; Deduplication.
- (when (= 8 num-colors)
- (should (equal (erc-nicks--create-coerced-pool '(erc-nicks-ensaturate)
- '("#ee0000" "#f80000"))
- '("red")))
- (should (equal (pop erc-nicks--colors-rejects) "#f80000")))
-
- ;; "Coercion" in Xterm.
- (unless noninteractive
- (when (= 665 num-colors)
- (pcase-dolist (`(,adjustments ,candidates ,result)
- '(((erc-nicks-invert) ("white") ("gray10"))
- ((erc-nicks-cap-contrast) ("black") ("gray20"))
- ((erc-nicks-ensaturate) ("white") ("lavenderblush2"))
- ((erc-nicks-ensaturate) ("red") ("firebrick"))))
- (should (equal (erc-nicks--create-coerced-pool adjustments
- candidates)
- result)))))
-
- (should (equal erc-nicks--colors-rejects '(t)))))
-
-(declare-function erc-track-modified-channels "erc-track" ())
-
-(defun erc-nicks-tests--track-faces (test)
- (require 'erc-track)
- (defvar erc-modified-channels-alist)
- (defvar erc-track--normal-faces)
-
- (erc-tests-common-make-server-buf)
- (erc-track-mode +1)
- (erc-nicks-mode +1)
-
- (let ((erc-modules (cons 'nicks erc-modules))
- ;; Pretend these faces were added in response-handling during
- ;; insertion modification by buttonizing hooks. See
- ;; `erc-nicks--highlight-button'.
- (add-face (lambda (face)
- (erc-nicks--remember-face-for-track ; speaker
- (list face 'erc-nick-default-face))
- (erc-nicks--remember-face-for-track ; mention
- (list face 'erc-default-face))))
- ;;
- bob-face alice-face assert-result)
-
- (with-current-buffer (erc--open-target "#chan")
- (should erc-nicks-mode)
- (should (setq bob-face (erc-nicks--get-face "bob" "bob@foonet")))
- (should (setq alice-face (erc-nicks--get-face "alice" "alice@foonet")))
-
- (erc-tests-common-track-modified-channels-sans-setup
-
- (lambda (set-faces)
-
- (setq assert-result ; fixture binds `erc-modified-channels-alist'
- (lambda (result)
- (should (equal (alist-get (current-buffer)
- erc-modified-channels-alist)
- result))))
-
- (funcall test set-faces assert-result add-face
- bob-face alice-face)))))
-
- (erc-tests-common-kill-buffers))
-
-(ert-deftest erc-nicks-track-faces/prioritize ()
- :tags (and (null (getenv "CI")) '(:unstable))
-
- (should (eq erc-nicks-track-faces 'prioritize))
- (erc-nicks-tests--track-faces
- (lambda (set-faces assert-result add-face bob-face alice-face)
-
- (defvar erc-track--alt-normals-function)
- (should erc-track--alt-normals-function)
-
- (funcall add-face bob-face)
- (funcall add-face alice-face)
-
- ;; Simulate a JOIN.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (funcall assert-result '(1 . erc-notice-face))
-
- ;; Someone speaks, and the mode-line changes to a `nicks' owned
- ;; composite face for the speaker.
- (funcall set-faces `(erc-timestamp-face
- (,bob-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (funcall assert-result `(2 ,bob-face erc-nick-default-face))
-
- ;; That same someone speaks, and the mode-line indicator changes to
- ;; another "normal" face in the message body.
- (funcall set-faces `(erc-timestamp-face
- (,bob-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (funcall assert-result '(3 . erc-default-face))
-
- ;; And yet again, which results in the indicator going back to one.
- (funcall set-faces `(erc-timestamp-face
- (,bob-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (funcall assert-result `(4 ,bob-face erc-nick-default-face))
-
- ;; Now the same person mentions another server user, resulting in a
- ;; change to *that* `nicks' owned face because it appears later in
- ;; the message content (timestamp is last).
- (funcall set-faces `(erc-timestamp-face
- (,alice-face erc-default-face)
- (,bob-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (funcall assert-result `(5 ,alice-face erc-default-face))
-
- ;; The mentioned user replies, mentioning the mentioner. But
- ;; instead of the normal "normals" processing preferring the ranked
- ;; `erc-default-face', the `erc-nicks-track-faces' logic kicks in
- ;; via `erc-track--alt-normals-function' and provides a `nicks'
- ;; owned replacement.
- (funcall set-faces `(erc-timestamp-face
- (,bob-face erc-default-face)
- (,alice-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (funcall assert-result `(6 ,bob-face erc-default-face))
-
- ;; Finally, another notice arrives.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (funcall assert-result '(7 . erc-notice-face)))))
-
-(ert-deftest erc-nicks-track-faces/defer ()
- (when (< emacs-major-version 28)
- (ert-skip "Possible intermittent failures on 27"))
-
- (should (eq erc-nicks-track-faces 'prioritize))
- (let ((erc-nicks-track-faces 'defer))
- (erc-nicks-tests--track-faces
- (lambda (set-faces assert-result add-face bob-face alice-face)
-
- (funcall add-face bob-face)
- (funcall add-face alice-face)
-
- ;; Simulate a JOIN.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (funcall assert-result '(1 . erc-notice-face))
-
- ;; Someone speaks, and the mode-line indicator changes to the
- ;; highest ranked face in the message. (All `nicks' owned faces
- ;; are unranked).
- (funcall set-faces `(erc-timestamp-face
- (,bob-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (funcall assert-result `(2 . erc-default-face))
-
- ;; That same someone speaks, and the mode-line indicator changes
- ;; to a `nicks' owned face. It first reaches for the highest
- ;; ranked face in the message but then applies the "normals"
- ;; rules, resulting in a promoted alternate.
- (funcall set-faces `(erc-timestamp-face
- (,bob-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (funcall assert-result `(3 ,bob-face erc-nick-default-face))
-
- ;; And yet again, which results in the indicator going back to one.
- (funcall set-faces `(erc-timestamp-face
- (,bob-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (funcall assert-result '(4 . erc-default-face))
-
- ;; The same person mentions another server user, resulting in a
- ;; change to that `nicks' owned face because the logic from
- ;; 3. again applies.
- (funcall set-faces `(erc-timestamp-face
- (,alice-face erc-default-face)
- (,bob-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (funcall assert-result `(5 ,alice-face erc-default-face))
-
- ;; The mentioned user replies, mentioning the mentioner.
- ;; However, the `nicks' module does not intercede in the decision
- ;; making to overrule the ranked nominee.
- (funcall set-faces `(erc-timestamp-face
- (,bob-face erc-default-face)
- (,alice-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (funcall assert-result '(6 . erc-default-face))
-
- ;; Finally, another notice arrives.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (funcall assert-result '(7 . erc-notice-face))))))
-
-(ert-deftest erc-nicks-track-faces/nil ()
- (should (eq erc-nicks-track-faces 'prioritize))
- (let (erc-nicks-track-faces)
- (erc-nicks-tests--track-faces
- (lambda (set-faces assert-result _ bob-face alice-face)
-
- (defvar erc-track--face-reject-function)
- (should erc-track--face-reject-function)
-
- ;; Simulate a JOIN.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (funcall assert-result '(1 . erc-notice-face))
-
- ;; Someone speaks, and the mode-line indicator changes to the
- ;; only ranked face in the message.
- (funcall set-faces `(erc-timestamp-face
- (,bob-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (funcall assert-result `(2 . erc-default-face))
-
- ;; That same someone speaks, and since no other "normals" exist
- ;; in the message, the indicator is not updated.
- (funcall set-faces `(erc-timestamp-face
- (,bob-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (funcall assert-result '(3 . erc-default-face))
-
- ;; Now the same person mentions another server user, but the same
- ;; logic applies, and the indicator is not updated.
- (funcall set-faces `(erc-timestamp-face
- (,alice-face erc-default-face)
- (,bob-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (funcall assert-result `(4 . erc-default-face))
-
- ;; Finally, another notice arrives.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (funcall assert-result '(5 . erc-notice-face))))))
-
-(ert-deftest erc-nicks-track-faces/t ()
- (should (eq erc-nicks-track-faces 'prioritize))
- (let ((erc-nicks-track-faces t))
- (erc-nicks-tests--track-faces
- (lambda (set-faces assert-result add-face bob-face alice-face)
-
- (defvar erc-track--alt-normals-function)
- (should erc-track--alt-normals-function)
-
- (funcall add-face bob-face)
- (funcall add-face alice-face)
-
- ;; Simulate a JOIN.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (funcall assert-result '(1 . erc-notice-face))
-
- ;; Someone speaks, and the mode-line indicator changes to that
- ;; someone's `nicks'-owned face.
- (funcall set-faces `(erc-timestamp-face
- (,bob-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (funcall assert-result `(2 ,bob-face erc-nick-default-face))
-
- ;; That same someone speaks, and though one other "normal" exists
- ;; in the message, `erc-default-face', no update occurs.
- (funcall set-faces `(erc-timestamp-face
- (,bob-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (funcall assert-result `(3 ,bob-face erc-nick-default-face))
-
- ;; Another server user speaks, mentioning the previous speaker,
- ;; and the indicator is updated to reflect the new speaker.
- (funcall set-faces `(erc-timestamp-face
- (,bob-face erc-default-face) ; bob:
- (,alice-face erc-nick-default-face) ; <alice>
- erc-default-face))
- (erc-track-modified-channels)
- (funcall assert-result `(4 ,alice-face erc-nick-default-face))
-
- ;; Finally, another notice arrives.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (funcall assert-result '(5 . erc-notice-face))))))
-
-;;; erc-nicks-tests.el ends here
+++ /dev/null
-;;; erc-notify-tests.el --- Tests for erc-notify -*- lexical-binding:t -*-
-
-;; Copyright (C) 2024-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-;;
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; GNU Emacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;; Code:
-(require 'erc-notify)
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-tests-common)))
-
-
-;;;; Module `querypoll'
-
-(ert-deftest erc--querypoll-compute-period ()
- (should (equal (mapcar (lambda (i)
- (/ (round (* 100 (erc--querypoll-compute-period i)))
- 100.0))
- (number-sequence 0 10))
- '(11.0 10.05 9.19 8.41 7.7 7.07 6.49 5.97 5.49 5.07 4.68))))
-
-(declare-function ring-insert "ring" (ring item))
-
-(ert-deftest erc--querypoll-target-in-chan-p ()
- (erc-tests-common-make-server-buf)
- (with-current-buffer (erc--open-target "#chan")
- (erc-update-current-channel-member "bob" "bob" 'addp))
-
- (with-current-buffer (erc--open-target "bob")
- (should (erc--querypoll-target-in-chan-p (current-buffer))))
-
- (with-current-buffer (erc--open-target "alice")
- (should-not (erc--querypoll-target-in-chan-p (current-buffer))))
-
- (when noninteractive
- (erc-tests-common-kill-buffers)))
-
-(ert-deftest erc--querypoll-get-length ()
- (erc-tests-common-make-server-buf)
- (with-current-buffer (erc--open-target "#chan")
- (erc-update-current-channel-member "bob" "bob" 'addp))
-
- (let ((ring (make-ring 5)))
- (ring-insert ring (with-current-buffer (erc--open-target "bob")))
- (should (= 0 (erc--querypoll-get-length ring)))
- (ring-insert ring (with-current-buffer (erc--open-target "alice")))
- (should (= 1 (erc--querypoll-get-length ring))))
-
- (when noninteractive
- (erc-tests-common-kill-buffers)))
-
-(ert-deftest erc--querypoll-get-next ()
- (erc-tests-common-make-server-buf)
- (with-current-buffer (erc--open-target "#chan")
- (erc-update-current-channel-member "bob" "bob" 'addp)
- (erc-update-current-channel-member "alice" "alice" 'addp))
-
- (let ((ring (make-ring 5)))
- (ring-insert ring (with-current-buffer (erc--open-target "bob")))
- (ring-insert ring (with-current-buffer (erc--open-target "dummy")))
- (ring-insert ring (with-current-buffer (erc--open-target "alice")))
- (ring-insert ring (with-current-buffer (erc--open-target "tester")))
- (kill-buffer (get-buffer "dummy"))
-
- (should (eq (get-buffer "tester") (erc--querypoll-get-next ring))))
-
- (when noninteractive
- (erc-tests-common-kill-buffers)))
-
-;;; erc-notify-tests.el ends here
+++ /dev/null
-;;; erc-sasl-tests.el --- Tests for erc-sasl. -*- lexical-binding:t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-;;
-;; This file is part of GNU Emacs.
-;;
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-;;
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'ert-x)
-(require 'erc-sasl)
-
-(ert-deftest erc-sasl--mechanism-offered-p ()
- (let ((erc-sasl--options '((mechanism . external))))
- (should (erc-sasl--mechanism-offered-p "foo,external"))
- (should (erc-sasl--mechanism-offered-p "external,bar"))
- (should (erc-sasl--mechanism-offered-p "foo,external,bar"))
- (should-not (erc-sasl--mechanism-offered-p "fooexternal"))
- (should-not (erc-sasl--mechanism-offered-p "externalbar"))))
-
-(ert-deftest erc-sasl--read-password--basic ()
- (ert-info ("Explicit erc-sasl-password")
- (let ((erc-sasl--options '((password . "foo"))))
- (should (string= (erc-sasl--read-password nil) "foo"))))
-
- (ert-info ("Explicit session password")
- (let ((erc-session-password "foo")
- (erc-sasl--options '((password . :password))))
- (should (string= (erc-sasl--read-password nil) "foo"))))
-
- (ert-info ("Prompt when no authfn and :password resolves to nil")
- (let ((erc-session-password nil)
- (erc-sasl--options
- '((password . :password) (user . :user) (authfn))))
- (should (string= (ert-simulate-keys "bar\r"
- (erc-sasl--read-password "?"))
- "bar"))))
-
- (ert-info ("Prompt when auth-source fails and `erc-session-password' null")
- (should-not erc-session-password)
- (let ((erc-sasl--options '((password) (authfn . ignore))))
- (should (string= (ert-simulate-keys "baz\r"
- (erc-sasl--read-password "pwd:"))
- "baz")))))
-
-;; This mainly tests `erc-sasl-auth-source-password-as-host'.
-
-(ert-deftest erc-sasl--read-password--auth-source ()
- (ert-with-temp-file netrc-file
- :text (string-join
- (list
- ;; If you swap these first 2 lines, *1 below fails
- "machine FSF.chat port 6697 user bob password sesame"
- "machine GNU/chat port 6697 user bob password spam"
- "machine MyHost port irc password 123")
- "\n")
- (let* ((auth-sources (list netrc-file))
- (erc-session-server "irc.gnu.org")
- (erc-session-port 6697)
- (erc-networks--id (erc-networks--id-create nil))
- erc-server-announced-name ; too early
- auth-source-do-cache
- ;;
- (fn #'erc-sasl-auth-source-password-as-host)
- calls)
-
- (advice-add 'erc-auth-source-search :before
- (lambda (&rest r) (push r calls))
- '((name . erc-sasl--read-password--auth-source)))
-
- (ert-info ("Symbol as password specifies machine")
- (let ((erc-sasl--options
- `((user . "bob") (password . FSF.chat) (authfn . ,fn))))
- (should (string= (erc-sasl--read-password nil) "sesame"))
- (should (equal (pop calls) '(:user "bob" :host "FSF.chat")))))
-
- (ert-info (":password as password resolved to machine")
- (let ((erc-session-password "FSF.chat")
- (erc-sasl--options
- `((user . "bob") (password . :password) (authfn . ,fn))))
- (should (string= (erc-sasl--read-password nil) "sesame"))
- (should (equal (pop calls) '(:user "bob" :host "FSF.chat")))))
-
- (ert-info (":user resolved to `erc-session-username'") ; *1
- (let ((erc-session-username "bob")
- (erc-sasl--options `((user . :user) (password) (authfn . ,fn)))
- (erc-networks--id (erc-networks--id-create 'GNU/chat)))
- (should (string= (erc-sasl--read-password nil) "spam"))
- (should (equal (pop calls) '(:user "bob")))))
-
- (ert-info (":user resolved to current nick") ; *1
- (let ((erc-server-current-nick "bob")
- (erc-sasl--options `((user . :nick) (password) (authfn . ,fn)))
- (erc-networks--id (erc-networks--id-create 'GNU/chat)))
- (should (string= (erc-sasl--read-password nil) "spam"))
- (should (equal (pop calls) '(:user "bob")))))
-
- (ert-info ("Symbol as password, entry lacks user field")
- (let ((erc-server-current-nick "fake")
- (erc-sasl--options
- `((user . :nick) (password . MyHost) (authfn . ,fn)))
- (erc-networks--id (erc-networks--id-create 'GNU/chat)))
- (should (string= (erc-sasl--read-password nil) "123"))
- (should (equal (pop calls) '(:user "fake" :host "MyHost")))))
-
- (advice-remove 'erc-auth-source-search
- 'erc-sasl--read-password--auth-source))))
-
-(ert-deftest erc-sasl-create-client--plain ()
- (let* ((erc-session-password "password123")
- (erc-session-username "tester")
- (erc-sasl--options '((user . :user) (password . :password)))
- (erc-session-port 1667)
- (erc-session-server "localhost")
- (client (erc-sasl--create-client 'plain))
- (result (sasl-next-step client nil)))
- (should (equal (format "%S" [erc-sasl--plain-response
- "\0tester\0password123"])
- (format "%S" result)))
- (should (string= (sasl-step-data result) "\0tester\0password123"))
- (should-not (sasl-next-step client result)))
- (should (equal (assoc-default "PLAIN" sasl-mechanism-alist) '(sasl-plain))))
-
-(ert-deftest erc-sasl-create-client--external ()
- (let* ((erc-server-current-nick "tester")
- (erc-sasl--options '((user . :nick) (password . :password)))
- (client (erc-sasl--create-client 'external)) ; unused ^
- (result (sasl-next-step client nil)))
- (should (equal (format "%S" [ignore nil]) (format "%S" result)))
- (should-not (sasl-step-data result))
- (should-not (sasl-next-step client result)))
- (should-not (member "EXTERNAL" sasl-mechanisms))
- (should-not (assoc-default "EXTERNAL" sasl-mechanism-alist)))
-
-(ert-deftest erc-sasl-create-client--scram-sha-1 ()
- (let* ((erc-sasl--options '((user . "jilles") (password . "sesame")
- (authzid . "jilles")))
- (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" ""))
- (sasl-unique-id-function (lambda () (pop mock-rvs)))
- (client (erc-sasl--create-client 'scram-sha-1))
- (step (sasl-next-step client nil)))
- (ert-info ("Client's initial request")
- (let ((req "n,a=jilles,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs"))
- (should (equal (format "%S"
- `[erc-compat--29-sasl-scram-client-first-message
- ,req])
- (format "%S" step)))
- (should (string= (sasl-step-data step) req))))
- (ert-info ("Server's initial response")
- (let ((resp (concat "r=c5RqLCZy0L4fGkKAZ0hujFBsXQoKcivqCw9iDZPSpb,"
- "s=5mJO6d4rjCnsBU1X,"
- "i=4096"))
- (req (concat "c=bixhPWppbGxlcyw=,"
- "r=c5RqLCZy0L4fGkKAZ0hujFBsXQoKcivqCw9iDZPSpb,"
- "p=OVUhgPu8wEm2cDoVLfaHzVUYPWU=")))
- (sasl-step-set-data step resp)
- (setq step (sasl-next-step client step))
- (should (equal (format "%S"
- `[erc-sasl--scram-sha-1-client-final-message
- ,req])
- (format "%S" step)))
- (should (string= (sasl-step-data step) req))))
- (ert-info ("Server's final message")
- (let ((resp "v=ZWR23c9MJir0ZgfGf5jEtLOn6Ng="))
- (sasl-step-set-data step resp)
- (setq step (sasl-next-step client step))
- (should-not (sasl-step-data step)))))
- (should (eq sasl-unique-id-function #'sasl-unique-id-function)))
-
-(ert-deftest erc-sasl-create-client--scram-sha-256 ()
- (unless (featurep 'sasl-scram-sha256)
- (ert-skip "Emacs lacks sasl-scram-sha256"))
- (let* ((erc-server-current-nick "jilles")
- (erc-session-password "sesame")
- (erc-sasl--options '((user . :nick) (password . :password)
- (authzid . "jilles")))
- (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" ""))
- (sasl-unique-id-function (lambda () (pop mock-rvs)))
- (client (erc-sasl--create-client 'scram-sha-256))
- (step (sasl-next-step client nil)))
- (ert-info ("Client's initial request")
- (let ((req "n,a=jilles,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs"))
- (should (equal (format "%S"
- `[erc-compat--29-sasl-scram-client-first-message
- ,req])
- (format "%S" step)))
- (should (string= (sasl-step-data step) req))))
- (ert-info ("Server's initial response")
- (let ((resp (concat
- "r=c5RqLCZy0L4fGkKAZ0hujFBse697140729d8445fb95ec94ceacb14b3,"
- "s=MTk2M2VkMzM5ZmU0NDRiYmI0MzIyOGVhN2YwNzYwNmI=,"
- "i=4096"))
- (req (concat
- "c=bixhPWppbGxlcyw=,"
- "r=c5RqLCZy0L4fGkKAZ0hujFBse697140729d8445fb95ec94ceacb14b3,"
- "p=1vDesVBzJmv0lX0Ae1kHFtdVHkC6j4gISKVqaR45HFg=")))
- (sasl-step-set-data step resp)
- (setq step (sasl-next-step client step))
- (should (equal (format "%S"
- `[erc-sasl--scram-sha-256-client-final-message
- ,req])
- (format "%S" step)))
- (should (string= (sasl-step-data step) req))))
- (ert-info ("Server's final message")
- (let ((resp "v=gUePTYSZN9xgcE06KSyKO9fUmSwH26qifoapXyEs75s="))
- (sasl-step-set-data step resp)
- (setq step (sasl-next-step client step))
- (should-not (sasl-step-data step)))))
- (should (eq sasl-unique-id-function #'sasl-unique-id-function)))
-
-(ert-deftest erc-sasl-create-client--scram-sha-256--no-authzid ()
- (unless (featurep 'sasl-scram-sha256)
- (ert-skip "Emacs lacks sasl-scram-sha256"))
- (let* ((erc-server-current-nick "jilles")
- (erc-session-password "sesame")
- (erc-sasl--options '((user . :nick) (password . :password) (authzid)))
- (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" ""))
- (sasl-unique-id-function (lambda () (pop mock-rvs)))
- (client (erc-sasl--create-client 'scram-sha-256))
- (step (sasl-next-step client nil)))
- (ert-info ("Client's initial request")
- (let ((req "n,,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs"))
- (should (equal (format "%S"
- `[erc-compat--29-sasl-scram-client-first-message
- ,req])
- (format "%S" step)))
- (should (string= (sasl-step-data step) req))))
- (ert-info ("Server's initial response")
- (let ((resp (concat
- "r=c5RqLCZy0L4fGkKAZ0hujFBsd4067f0afdb54c3dbd4fe645b84cae37,"
- "s=ZTg1MmE1YmFhZGI1NDcyMjk3NzYwZmRjZDM3Y2I1OTM=,"
- "i=4096"))
- (req (concat
- "c=biws,"
- "r=c5RqLCZy0L4fGkKAZ0hujFBsd4067f0afdb54c3dbd4fe645b84cae37,"
- "p=LP4sjJrjJKp5qTsARyZCppXpKLu4FMM284hNESPvGhI=")))
- (sasl-step-set-data step resp)
- (setq step (sasl-next-step client step))
- (should (equal (format "%S"
- `[erc-sasl--scram-sha-256-client-final-message
- ,req])
- (format "%S" step)))
- (should (string= (sasl-step-data step) req))))
- (ert-info ("Server's final message")
- (let ((resp "v=847WXfnmReGyE1qlq1And6R4bPBNROTZ7EMS/QrJtUM="))
- (sasl-step-set-data step resp)
- (setq step (sasl-next-step client step))
- (should-not (sasl-step-data step)))))
- (should (eq sasl-unique-id-function #'sasl-unique-id-function)))
-
-(ert-deftest erc-sasl-create-client--scram-sha-512--no-authzid ()
- (unless (featurep 'sasl-scram-sha256)
- (ert-skip "Emacs lacks sasl-scram-sha512"))
- (let* ((erc-server-current-nick "jilles")
- (erc-session-password "sesame")
- (erc-sasl--options '((user . :nick) (password . :password) (authzid)))
- (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" ""))
- (sasl-unique-id-function (lambda () (pop mock-rvs)))
- (client (erc-sasl--create-client 'scram-sha-512))
- (step (sasl-next-step client nil)))
- (ert-info ("Client's initial request")
- (let ((req "n,,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs"))
- (should (equal (format "%S"
- `[erc-compat--29-sasl-scram-client-first-message
- ,req])
- (format "%S" step)))
- (should (string= (sasl-step-data step) req))))
- (ert-info ("Server's initial response")
- (let ((resp (concat
- "r=c5RqLCZy0L4fGkKAZ0hujFBs54c592745ce14e559fcc3f27b15464f6,"
- "s=YzMzOWZiY2U0YzcwNDA0M2I4ZGE2M2ZjOTBjODExZTM=,"
- "i=4096"))
- (req (concat
- "c=biws,"
- "r=c5RqLCZy0L4fGkKAZ0hujFBs54c592745ce14e559fcc3f27b15464f6,"
- "p=vMBb9tKxFAfBtel087/GLbo4objAIYr1wM+mFv/jYLKXE"
- "NUF0vynm81qQbywQE5ScqFFdAfwYMZq/lj4s0V1OA==")))
- (sasl-step-set-data step resp)
- (setq step (sasl-next-step client step))
- (should (equal (format
- "%S" `[erc-sasl--scram-sha-512-client-final-message
- ,req])
- (format "%S" step)))
- (should (string= (sasl-step-data step) req))))
- (ert-info ("Server's final message")
- (let ((resp (concat "v=Va7NIvt8wCdhvxnv+bZriSxGoto6On5EVnRHO/ece8zs0"
- "qpQassdqir1Zlwh3e3EmBq+kcSy+ClNCsbzBpXe/w==")))
- (sasl-step-set-data step resp)
- (setq step (sasl-next-step client step))
- (should-not (sasl-step-data step)))))
- (should (eq sasl-unique-id-function #'sasl-unique-id-function)))
-
-(defconst erc-sasl-tests-ecdsa-key-file "
------BEGIN EC PARAMETERS-----
-BggqhkjOPQMBBw==
------END EC PARAMETERS-----
------BEGIN EC PRIVATE KEY-----
-MHcCAQEEIIJueQ3W2IrGbe9wKdOI75yGS7PYZSj6W4tg854hlsvmoAoGCCqGSM49
-AwEHoUQDQgAEAZmaVhNSMmV5r8FXPvKuMnqDKyIA9pDHN5TNMfiF3mMeikGgK10W
-IRX9cyi2wdYg9mUUYyh9GKdBCYHGUJAiCA==
------END EC PRIVATE KEY-----
-")
-
-(ert-deftest erc-sasl-create-client-ecdsa ()
- :tags '(:unstable)
- ;; This is currently useless because it just roundtrips shelling out
- ;; to pkeyutl.
- (ert-skip "Placeholder for manual debugging")
- (unless (executable-find "openssl")
- (ert-skip "System lacks openssl"))
-
- (ert-with-temp-file keyfile
- :prefix "ecdsa_key"
- :suffix ".pem"
- :text erc-sasl-tests-ecdsa-key-file
-
- (erc-mode)
- (erc--initialize-markers (point) nil)
- (setq erc-server-process (make-process :name "sleep"
- :buffer (current-buffer)
- :command '("sleep" "1")
- :noquery t)
- erc-session-username "jilles")
- (let ((erc-sasl-mechanism 'ecdsa-nist256p-challenge)
- (erc-sasl-password keyfile))
- (erc-sasl-mode +1))
-
- (let* ((client (erc-sasl--state-client erc-sasl--state))
- (step (sasl-next-step client nil)))
- (ert-info ("Client's initial request")
- (should (equal (format "%S" [erc-sasl--ecdsa-first "jilles"])
- (format "%S" step)))
- (should (string= (sasl-step-data step) "jilles")))
- (ert-info ("Server's initial response")
- (let ((resp (concat "\0\1\2\3\4\5\6\7\10\11\12\13\14\15\16\17\20"
- "\21\22\23\24\25\26\27\30\31\32\33\34\35\36\37")))
- (sasl-step-set-data step resp)
- (setq step (sasl-next-step client step))
- (ert-with-temp-file sigfile
- :prefix "ecdsa_sig"
- :suffix ".sig"
- :text (sasl-step-data step)
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert resp)
- (let ((ec (call-process-region
- (point-min) (point-max)
- "openssl" 'delete t nil "pkeyutl"
- "-inkey" keyfile "-sigfile" sigfile
- "-verify")))
- (unless (zerop ec)
- (message "%s" (buffer-string)))
- (should (zerop ec)))))))
- (should-not (sasl-next-step client step)))))
-
-;;; erc-sasl-tests.el ends here
+++ /dev/null
-;;; erc-scenarios-auth-source.el --- auth-source scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 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:
-
-;; For practical reasons (mainly lack of imagination), this file
-;; contains tests for both server-password and NickServ contexts.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(eval-when-compile (require 'erc-join)
- (require 'erc-services))
-
-(defun erc-scenarios-common--auth-source (id dialog &rest rest)
- (push "machine GNU.chat port %d user \"#chan\" password spam" rest)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/auth-source")
- (dumb-server (erc-d-run "localhost" t dialog))
- (port (process-contact dumb-server :service))
- (ents `(,@(mapcar (lambda (fmt) (format fmt port)) rest)
- "machine MyHost port irc password 123"))
- (netrc-file (make-temp-file "auth-source-test" nil nil
- (string-join ents "\n")))
- (auth-sources (list netrc-file))
- (auth-source-do-cache nil)
- (erc-port (and (eq erc-port 'test) (number-to-string port)))
- (erc-scenarios-common-extra-teardown (lambda ()
- (delete-file netrc-file)))
- ;; With a `cl-defun', a keyword's presence prevents the default
- ;; init form from being evaluated, even if its value is nil.
- (args `( :server "127.0.0.1"
- ,@(and (null erc-port) (list :port port))
- :nick "tester"
- :full-name "tester"
- :id ,id)))
-
- (ert-info ("Connect")
- (with-current-buffer (apply #'erc args)
- (should (string= (buffer-name) (if id
- (symbol-name id)
- (format "127.0.0.1:%d" port))))
- (erc-d-t-wait-for 10 (eq erc-network 'FooNet))))))
-
-(ert-deftest erc-scenarios-base-auth-source-server--dialed ()
- :tags '(:expensive-test)
- (let ((erc-port 'test))
- (erc-scenarios-common--auth-source
- nil 'foonet
- "machine GNU.chat port %d user tester password fake"
- "machine FooNet port %d user tester password fake"
- "machine 127.0.0.1 port \"%s\" user tester password changeme" ; correct
- "machine 127.0.0.1 port %d user imposter password fake")))
-
-(ert-deftest erc-scenarios-base-auth-source-server--netid ()
- :tags '(:expensive-test)
- (erc-scenarios-common--auth-source
- 'MySession 'foonet
- "machine MySession port %d user tester password changeme"
- "machine 127.0.0.1 port %d user tester password fake"
- "machine FooNet port %d user tester password fake"))
-
-(ert-deftest erc-scenarios-base-auth-source-server--netid-custom ()
- :tags '(:expensive-test)
- (let ((erc-auth-source-server-function
- (lambda (&rest _) (erc-auth-source-search :host "MyHost"))))
- (erc-scenarios-common--auth-source
- 'MySession 'foonet
- "machine 127.0.0.1 port %d user tester password fake"
- "machine MyHost port %d user tester password changeme"
- "machine MySession port %d user tester password fake")))
-
-(ert-deftest erc-scenarios-base-auth-source-server--nopass ()
- :tags '(:expensive-test)
- (let (erc-auth-source-server-function)
- (erc-scenarios-common--auth-source nil 'nopass)))
-
-(ert-deftest erc-scenarios-base-auth-source-server--nopass-netid ()
- :tags '(:expensive-test)
- (let (erc-auth-source-server-function)
- (erc-scenarios-common--auth-source 'MySession 'nopass)))
-
-;; Identify via auth source with no initial password
-
-(defun erc-scenarios-common--services-auth-source (&rest rest)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "services/auth-source")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'libera))
- (port (process-contact dumb-server :service))
- (ents `(,@(mapcar (lambda (fmt) (format fmt port)) rest)
- "machine MyHost port irc password 123"))
- (netrc-file (make-temp-file "auth-source-test" nil nil
- (string-join ents "\n")))
- (auth-sources (list netrc-file))
- (auth-source-do-cache nil)
- (erc-modules (cons 'services erc-modules))
- (erc-use-auth-source-for-nickserv-password t) ; do consult for NickServ
- (expect (erc-d-t-make-expecter))
- (erc-scenarios-common-extra-teardown (lambda ()
- (delete-file netrc-file))))
-
- (cl-letf (((symbol-function 'read-passwd)
- (lambda (&rest _) (error "Unexpected read-passwd call"))))
- (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)))
- (erc-d-t-wait-for 8 (eq erc-network 'Libera.Chat))
- (funcall expect 3 "This nickname is registered.")
- (funcall expect 3 "You are now identified")
- (funcall expect 3 "Last login from")
- (erc-cmd-QUIT ""))))
-
- (erc-services-mode -1)
-
- (should-not (memq 'services erc-modules))))
-
-;; These tests are about authenticating to nick services
-
-(ert-deftest erc-scenarios-services-auth-source--network ()
- :tags '(:expensive-test)
- ;; Skip consulting auth-source for the server password (PASS).
- (let (erc-auth-source-server-function)
- (erc-scenarios-common--services-auth-source
- "machine 127.0.0.1 port %d user tester password spam"
- "machine zirconium.libera.chat port %d user tester password fake"
- "machine Libera.Chat port %d user tester password changeme")))
-
-(ert-deftest erc-scenarios-services-auth-source--network-connect-lookup ()
- :tags '(:expensive-test)
- ;; Do consult auth-source for the server password (and find nothing)
- (erc-scenarios-common--services-auth-source
- "machine zirconium.libera.chat port %d user tester password fake"
- "machine Libera.Chat port %d user tester password changeme"))
-
-(ert-deftest erc-scenarios-services-auth-source--announced ()
- :tags '(:expensive-test)
- (let (erc-auth-source-server-function)
- (erc-scenarios-common--services-auth-source
- "machine 127.0.0.1 port %d user tester password spam"
- "machine zirconium.libera.chat port %d user tester password changeme")))
-
-(ert-deftest erc-scenarios-services-auth-source--dialed ()
- :tags '(:expensive-test)
- ;; Support legacy host -> domain name
- ;; (likely most common in real configs)
- (let (erc-auth-source-server-function)
- (erc-scenarios-common--services-auth-source
- "machine 127.0.0.1 port %d user tester password changeme")))
-
-(ert-deftest erc-scenarios-services-auth-source--custom ()
- :tags '(:expensive-test)
- (let (erc-auth-source-server-function
- (erc-auth-source-services-function
- (lambda (&rest _) (erc-auth-source-search :host "MyAccount"))))
- (erc-scenarios-common--services-auth-source
- "machine zirconium.libera.chat port %d user tester password spam"
- "machine MyAccount port %d user tester password changeme"
- "machine 127.0.0.1 port %d user tester password fake")))
-
-;;; erc-scenarios-auth-source.el ends here
+++ /dev/null
-;;; erc-scenarios-base-association-nick.el --- base assoc scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(eval-when-compile (require 'erc-join))
-
-;; You register a new nick in a dedicated query buffer, disconnect,
-;; and log back in, but your nick is not granted (maybe you just
-;; turned off SASL). In any case, ERC obtains a backticked version.
-;; You open a query buffer for NickServ, and ERC gives you the
-;; existing one. And after you identify, all buffers retain their
-;; names, although your net ID has changed internally.
-;;
-;; If ERC had instead failed (or intentionally refused) to make the
-;; association, you would find yourself with a new NickServ buffer
-;; named with a suffix reflecting the new net ID (based on the
-;; backticked nick), for example, NickServ@foonet/tester`. And the
-;; original (disconnected) NickServ buffer would also receive a suffix
-;; with *its* net-ID, e.g., NickServ@foonet/tester. Upon identifying
-;; yourself, you'd see ERC merge both buffers along with their server
-;; buffers. While this alternate behavior might more accurately
-;; reflect reality, it introduces significant inconvenience. For a
-;; clearer example, see the original version of this file introduced
-;; by "Add user-oriented test scenarios for ERC".
-
-(ert-deftest erc-scenarios-base-association-nick-bumped ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/assoc/bumped")
- (dumb-server (erc-d-run "localhost" t 'renicked 'again))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- (erc-server-flood-penalty 0.5)
- (erc-server-flood-margin 30))
-
- (ert-info ("Connect to foonet with nick tester")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :full-name "tester")
- (erc-scenarios-common-assert-initial-buf-name nil port)
- (erc-d-t-wait-for 5 (eq erc-network 'foonet))))
-
- (ert-info ("Create an account for tester and quit")
- (with-current-buffer "foonet"
- (funcall expect 3 "debug mode")
-
- (erc-cmd-QUERY "NickServ")
- (with-current-buffer "NickServ"
- (erc-scenarios-common-say "REGISTER changeme")
- (funcall expect 5 "Account created")
- (funcall expect 1 "You're now logged in as tester"))
-
- (with-current-buffer "foonet"
- (erc-cmd-QUIT "")
- (erc-d-t-wait-for 4 (not (erc-server-process-alive)))
- (funcall expect 5 "ERC finished"))))
-
- (with-current-buffer "foonet"
- (erc-cmd-RECONNECT)
- (funcall expect 10 "User modes for tester`"))
-
- (ert-info ("Server buffer reassociated with new nick")
- (should-not (get-buffer "foonet/tester`")))
-
- (ert-info ("Ask NickServ to change nick")
- (with-current-buffer "foonet"
- (funcall expect 3 "debug mode")
- (erc-cmd-QUERY "NickServ"))
-
- (ert-info ( "NickServ buffer reassociated")
- (should-not (get-buffer "NickServ@foonet/tester`"))
- (should-not (get-buffer "NickServ@foonet/tester")))
-
- (with-current-buffer "NickServ" ; new one
- (erc-scenarios-common-say "IDENTIFY tester changeme")
- (funcall expect 5 "You're now logged in as tester")))
-
- (ert-info ("Still just one NickServ buffer")
- (should-not (cdr (erc-scenarios-common-buflist "NickServ"))))
-
- (ert-info ("As well as one server buffer")
- (should (not (get-buffer "foonet/tester`")))
- (should (not (get-buffer "foonet/tester")))
- (should (get-buffer "foonet")))))
-
-;; A less common variant is when your bouncer switches to an alternate
-;; nick while you're disconnected, and upon reconnecting, you get
-;; a new nick.
-
-(ert-deftest erc-scenarios-base-association-nick-bumped-mandated-renick ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/assoc/bumped")
- (dumb-server (erc-d-run "localhost" t 'foisted 'refoisted))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- (erc-server-flood-penalty 0.5)
- (erc-server-flood-margin 30))
-
- (ert-info ("Connect to foonet with nick tester")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :full-name "tester")
- (erc-scenarios-common-assert-initial-buf-name nil port)
- (erc-d-t-wait-for 5 (eq erc-network 'foonet))))
-
- (ert-info ("Greet bob and quit")
- (with-current-buffer "foonet"
- (funcall expect 3 "debug mode")
-
- (erc-cmd-QUERY "bob")
- (with-current-buffer "bob"
- (erc-scenarios-common-say "hi")
- (funcall expect 5 "hola")
- (funcall expect 1 "how r u?"))
-
- (with-current-buffer "foonet"
- (erc-cmd-QUIT "")
- (erc-d-t-wait-for 4 (not (erc-server-process-alive)))
- (funcall expect 5 "ERC finished"))))
-
- ;; Since we use reconnect, a new buffer won't be created
- ;; TODO add variant with clean `erc' invocation
- (with-current-buffer "foonet"
- (erc-cmd-RECONNECT)
- (funcall expect 10 "User modes for dummy"))
-
- (ert-info ("Server-initiated renick associated correctly")
- (with-current-buffer "foonet"
- (funcall expect 15 "debug mode")
- (should-not (get-buffer "foonet/dummy"))
- (should-not (get-buffer "foonet/tester")))
-
- (ert-info ("Old query reassociated")
- (should (get-buffer "bob"))
- (should-not (get-buffer "bob@foonet/tester"))
- (should-not (get-buffer "bob@foonet/dummy")))
-
- (with-current-buffer "foonet"
- (erc-cmd-NICK "tester")
- (funcall expect 5 "You're now logged in as tester")))
-
- (ert-info ("Ours is still the only bob buffer that remains")
- (should-not (cdr (erc-scenarios-common-buflist "bob"))))
-
- (ert-info ("Visible network ID still truncated to one component")
- (should (not (get-buffer "foonet/tester")))
- (should (not (get-buffer "foonet/dummy"))))))
-
-;;; erc-scenarios-base-association-nick.el ends here
+++ /dev/null
-;;; erc-scenarios-base-association-query.el --- assoc query scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(eval-when-compile (require 'erc-join))
-
-
-;; Non-ERC buffers exist whose names match the nicknames of query
-;; targets, both newly arriving and outgoing. No target buffers yet
-;; exist for these, so new ones are created that feature a net-ID
-;; @suffix.
-
-(ert-deftest erc-scenarios-base-association-existing-non-erc-buffer ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/assoc/queries")
- (dumb-server (erc-d-run "localhost" t 'non-erc))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- (nitwit (with-current-buffer (get-buffer-create "nitwit")
- (prin1 (ert-test-name (ert-running-test)) (current-buffer))
- (current-buffer))) ; these are killed on completion by macro
- (dummy (with-current-buffer (get-buffer-create "dummy")
- (prin1 (ert-test-name (ert-running-test)) (current-buffer))
- (current-buffer)))
- (erc-server-flood-penalty 0.1))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :full-name "tester")
- (erc-scenarios-common-assert-initial-buf-name nil port)
- (erc-d-t-wait-for 5 (eq erc-network 'foonet))
- (funcall expect 15 "debug mode")))
-
- (ert-info ("Nick dummy queries us")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "dummy@foonet"))
- (should (erc-query-buffer-p))
- (funcall expect 5 "hi")
-
- (ert-info ("We query nick nitwit")
- (with-current-buffer (erc-cmd-QUERY "nitwit")
- (should (equal (buffer-name) "nitwit@foonet"))
- (erc-scenarios-common-say "hola")
- (funcall expect 5 "ciao")))
-
- (erc-scenarios-common-say "howdy")
- (funcall expect 5 "bye")
- (erc-cmd-QUIT "")))))
-
-;; Someone sending you a PM has the same name as the network (bug#59976)
-
-(ert-deftest erc-scenarios-base-association-some-nick-is-network ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/assoc/queries")
- (dumb-server (erc-d-run "localhost" t 'netnick))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- (erc-server-flood-penalty 0.5))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :full-name "tester")
- (erc-scenarios-common-assert-initial-buf-name nil port)
- (erc-d-t-wait-for 5 (eq erc-network 'foonet))))
-
- (ert-info ("Join common channel as nick foonet")
- (with-current-buffer "foonet"
- (funcall expect 15 "debug mode")
- (erc-cmd-JOIN "#chan"))
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 5 "welcome")))
-
- (ert-info ("Nick foonet PMs us")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet@foonet"))
- (should (erc-query-buffer-p))
- (funcall expect 5 "hi")))))
-
-;;; erc-scenarios-base-association-query.el ends here
+++ /dev/null
-;;; erc-scenarios-base-association-samenet.el --- assoc samenet scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 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)))
-
-(declare-function erc-network-name "erc-networks")
-(declare-function erc-network "erc-networks")
-(defvar erc-autojoin-channels-alist)
-(defvar erc-network)
-
-;; One network, two simultaneous connections, no IDs.
-;; Reassociates on reconnect with and without server buffer.
-
-(defun erc-scenarios-common--base-association-samenet (after)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/assoc/samenet")
- (dumb-server (erc-d-run "localhost" t 'tester 'chester 'tester2))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- (erc-server-flood-penalty 0.5)
- (erc-server-flood-margin 30))
-
- (ert-info ("Connect to foonet with nick tester")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "changeme"
- :full-name "tester")
- (erc-scenarios-common-assert-initial-buf-name nil port)
- (erc-d-t-wait-for 5 (eq erc-network 'foonet))))
-
- (ert-info ("Connect to foonet with nick chester")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "chester"
- :password "changeme"
- :full-name "chester")
- (erc-scenarios-common-assert-initial-buf-name nil port)))
-
- (erc-d-t-wait-for 3 "Dialed Buflist is Empty"
- (not (erc-scenarios-common-buflist "127.0.0.1")))
-
- (with-current-buffer "foonet/tester"
- (funcall expect 3 "debug mode")
- (erc-cmd-JOIN "#chan"))
-
- (erc-d-t-wait-for 10 (get-buffer "#chan@foonet/tester"))
- (with-current-buffer "foonet/chester" (funcall expect 3 "debug mode"))
- (erc-d-t-wait-for 10 (get-buffer "#chan@foonet/chester"))
-
- (ert-info ("Nick tester sees other nick chester in channel")
- (with-current-buffer "#chan@foonet/tester"
- (funcall expect 5 "chester")
- (funcall expect 5 "find the forester")
- (erc-cmd-QUIT "")))
-
- (ert-info ("Nick chester sees other nick tester in same channel")
- (with-current-buffer "#chan@foonet/chester"
- (funcall expect 5 "tester")
- (funcall expect 5 "find the forester")))
-
- (funcall after expect)))
-
-(ert-deftest erc-scenarios-base-association-samenet--reconnect-one ()
- :tags '(:expensive-test)
- (erc-scenarios-common--base-association-samenet
- (lambda (expect)
-
- (ert-info ("Connection tester reconnects")
- (with-current-buffer "foonet/tester"
- (erc-d-t-wait-for 10 (not (erc-server-process-alive)))
- (funcall expect 10 "*** ERC finished")
- (erc-cmd-RECONNECT)
- (funcall expect 5 "debug mode")))
-
- (ert-info ("Reassociated to same channel")
- (with-current-buffer "#chan@foonet/tester"
- (funcall expect 5 "chester")
- (funcall expect 5 "welcome again")
- (erc-cmd-QUIT "")))
-
- (with-current-buffer "#chan@foonet/chester"
- (funcall expect 5 "tester")
- (funcall expect 5 "welcome again")
- (funcall expect 5 "welcome again")
- (erc-cmd-QUIT "")))))
-
-(ert-deftest erc-scenarios-base-association-samenet--new-buffer ()
- :tags '(:expensive-test)
- (erc-scenarios-common--base-association-samenet
- (lambda (expect)
-
- (ert-info ("Tester kills buffer and connects from scratch")
-
- (let (port)
- (with-current-buffer "foonet/tester"
- (erc-d-t-wait-for 10 (not (erc-server-process-alive)))
- (funcall expect 10 "*** ERC finished")
- (setq port erc-session-port)
- (kill-buffer))
-
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "changeme"
- :full-name "tester")
-
- (erc-d-t-wait-for 5 (eq erc-network 'foonet)))))
-
- (with-current-buffer "foonet/tester" (funcall expect 3 "debug mode"))
-
- (ert-info ("Reassociated to same channel")
- (with-current-buffer "#chan@foonet/tester"
- (funcall expect 5 "chester")
- (funcall expect 5 "welcome again")
- (erc-cmd-QUIT "")))
-
- (with-current-buffer "#chan@foonet/chester"
- (funcall expect 5 "tester")
- (funcall expect 5 "welcome again")
- (funcall expect 5 "welcome again")
- (erc-cmd-QUIT "")))))
-
-;;; erc-scenarios-base-association-samenet.el ends here
+++ /dev/null
-;;; erc-scenarios-base-association.el --- base assoc scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 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)))
-
-(declare-function erc-network-name "erc-networks")
-(declare-function erc-network "erc-networks")
-(declare-function erc-track-get-active-buffer "erc-track" (arg))
-(defvar erc-autojoin-channels-alist)
-(defvar erc-track-mode)
-(defvar erc-network)
-
-;; Two networks, same channel name, no confusion (no bouncer). Some
-;; of this draws from bug#47522 "foil-in-server-buf". It shows that
-;; disambiguation-related changes added for bug#48598 are not specific
-;; to bouncers.
-
-(defun erc-scenarios-common--base-association-multi-net (second-join)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/assoc/multi-net")
- (erc-server-flood-penalty 0.1)
- (dumb-server-foonet-buffer (get-buffer-create "*server-foonet*"))
- (dumb-server-barnet-buffer (get-buffer-create "*server-barnet*"))
- (dumb-server-foonet (erc-d-run "localhost" t "server-foonet" 'foonet))
- (dumb-server-barnet (erc-d-run "localhost" t "server-barnet" 'barnet))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to foonet, join #chan")
- (with-current-buffer
- (erc :server "127.0.0.1"
- :port (process-contact dumb-server-foonet :service)
- :nick "tester"
- :password "changeme"
- :full-name "tester")
- (funcall expect 3 "debug mode")
- (erc-cmd-JOIN "#chan")))
-
- (erc-d-t-wait-for 2 (get-buffer "#chan"))
-
- (ert-info ("Connect to barnet, join #chan")
- (with-current-buffer
- (erc :server "127.0.0.1"
- :port (process-contact dumb-server-barnet :service)
- :nick "tester"
- :password "changeme"
- :full-name "tester")
- (funcall expect 5 "debug mode")))
-
- (funcall second-join)
-
- (erc-d-t-wait-for 3 (get-buffer "#chan@barnet"))
-
- (erc-d-t-wait-for 2 "Buf #chan now #chan@foonet"
- (and (get-buffer "#chan@foonet") (not (get-buffer "#chan"))))
-
- (ert-info ("All #chan@foonet output consumed")
- (with-current-buffer "#chan@foonet"
- (funcall expect 3 "bob")
- (funcall expect 3 "was created on")
- (funcall expect 10 "prosperous")))
-
- (ert-info ("All #chan@barnet output consumed")
- (with-current-buffer "#chan@barnet"
- (funcall expect 3 "mike")
- (funcall expect 3 "was created on")
- (funcall expect 20 "ingenuous")))))
-
-(ert-deftest erc-scenarios-base-association-multi-net--baseline ()
- :tags '(:expensive-test)
- (erc-scenarios-common--base-association-multi-net
- (lambda () (with-current-buffer "barnet" (erc-cmd-JOIN "#chan")))))
-
-;; The /join command only targets the current buffer's process. This
-;; recasts scenario bug#48598 "ambiguous-join" (which was based on
-;; bug#47522) to show that issuing superfluous /join commands
-;; (apparently fairly common) is benign.
-
-(ert-deftest erc-scenarios-base-association-multi-net--ambiguous-join ()
- :tags '(:expensive-test)
- (erc-scenarios-common--base-association-multi-net
- (lambda ()
- (ert-info ("Nonsensical JOIN attempts silently dropped.")
- (with-current-buffer "foonet" (erc-cmd-JOIN "#chan"))
- (sit-for 0.1)
- (with-current-buffer "#chan" (erc-cmd-JOIN "#chan"))
- (sit-for 0.1)
- (erc-d-t-wait-for 2 (get-buffer "#chan"))
- (erc-d-t-wait-for 1 "Only one #chan buffer exists"
- (should (equal (erc-scenarios-common-buflist "#chan")
- (list (get-buffer "#chan")))))
- (with-current-buffer "*server-barnet*"
- (erc-d-t-absent-for 0.1 "JOIN"))
- (with-current-buffer "barnet" (erc-cmd-JOIN "#chan"))))))
-
-;; Playback for same channel on two networks routed correctly.
-;; Originally from Bug#48598: 28.0.50; buffer-naming collisions
-;; involving bouncers in ERC.
-
-(ert-deftest erc-scenarios-base-association-bouncer-history ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/assoc/bouncer-history")
- (erc-d-t-cleanup-sleep-secs 1)
- (dumb-server (erc-d-run "localhost" t 'foonet 'barnet))
- (port (process-contact dumb-server :service))
- (erc-server-flood-penalty 0.5)
- (expect (erc-d-t-make-expecter))
- erc-autojoin-channels-alist
- erc-server-buffer-foo erc-server-process-foo
- erc-server-buffer-bar erc-server-process-bar)
-
- (ert-info ("Connect to foonet")
- (with-current-buffer
- (setq erc-server-buffer-foo (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester"))
- (setq erc-server-process-foo erc-server-process)
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (funcall expect 5 "foonet")))
-
- (erc-d-t-wait-for 5 (get-buffer "#chan"))
-
- (ert-info ("Connect to barnet")
- (with-current-buffer
- (setq erc-server-buffer-bar (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "barnet:changeme"
- :full-name "tester"))
- (setq erc-server-process-bar erc-server-process)
- (erc-d-t-wait-for 5 "Temporary name assigned"
- (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (funcall expect 5 "barnet")))
-
- (ert-info ("Server buffers are unique")
- (should-not (eq erc-server-buffer-foo erc-server-buffer-bar)))
-
- (ert-info ("Networks correctly determined and adopted as buffer names")
- (with-current-buffer erc-server-buffer-foo
- (erc-d-t-wait-for 3 "network name foonet becomes buffer name"
- (and (eq (erc-network) 'foonet) (string= (buffer-name) "foonet"))))
- (with-current-buffer erc-server-buffer-bar
- (erc-d-t-wait-for 3 "network name barnet becomes buffer name"
- (and (eq (erc-network) 'barnet) (string= (buffer-name) "barnet")))))
-
- (erc-d-t-wait-for 5 (get-buffer "#chan@barnet"))
-
- (ert-info ("Two channel buffers created, original #chan renamed")
- (should (= 4 (length (erc-buffer-list))))
- (should (equal (list (get-buffer "#chan@barnet")
- (get-buffer "#chan@foonet"))
- (erc-scenarios-common-buflist "#chan"))))
-
- (ert-info ("#chan@foonet is exclusive, no cross-contamination")
- (with-current-buffer "#chan@foonet"
- (erc-d-t-search-for 1 "<bob>")
- (erc-d-t-absent-for 0.1 "<joe>")
- (should (eq erc-server-process erc-server-process-foo))))
-
- (ert-info ("#chan@barnet is exclusive, no cross-contamination")
- (with-current-buffer "#chan@barnet"
- (erc-d-t-search-for 1 "<joe>")
- (erc-d-t-absent-for 0.1 "<bob>")
- (should (eq erc-server-process erc-server-process-bar))))
-
- (ert-info ("All output sent")
- (with-current-buffer "#chan@foonet"
- (erc-d-t-search-for 10 "please your lordship"))
- (with-current-buffer "#chan@barnet"
- (erc-d-t-search-for 10 "I'll bid adieu")))))
-
-;; Some modules may need to perform housekeeping when a newly
-;; connected server buffer is deemed a duplicate after its persistent
-;; network context is discovered on MOTD end. One such module is
-;; `track', which needs to rid its list of modified channels of the
-;; buffer being killed. Without this, a user may encounter an
-;; "Attempt to display deleted buffer" error when they try switching
-;; to it.
-
-(ert-deftest erc-scenarios-networks-merge-server-track ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "networks/merge-server")
- (dumb-server (erc-d-run "localhost" t 'track 'track))
- (port (process-contact dumb-server :service))
- (erc-server-flood-penalty 0.1)
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (should erc-track-mode)
- (funcall expect 5 "changed mode for tester")
- (erc-cmd-JOIN "#chan")))
-
- (ert-info ("Join channel and quit")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 5 "The hour that fools should ask")
- (erc-cmd-QUIT ""))
- (with-current-buffer "FooNet"
- (funcall expect 5 "finished")))
-
- (ert-info ("Reconnect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (funcall expect 5 "changed mode for tester")))
-
- (with-current-buffer "#chan"
- (funcall expect 5 "The hour that fools should ask")
- ;; Simulate the old `erc-track-switch-buffer'
- (switch-to-buffer (erc-track-get-active-buffer 1))
- (erc-d-t-wait-for 10 (eq (get-buffer "FooNet") (current-buffer)))
- (erc-cmd-QUIT ""))))
-
-;;; erc-scenarios-base-association.el ends here
+++ /dev/null
-;;; erc-scenarios-base-attach.el --- Reattach scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; See also: `erc-scenarios-base-channel-buffer-revival'.
-;;
-;; ERC 5.5 silently dropped support for the ancient option
-;; `erc-query-on-unjoined-chan-privmsg' because the tangled logic in
-;; and around the function `erc-auto-query' made it difficult to
-;; divine its purpose.
-;;
-;; Based on the name, it was thought this option likely involved
-;; controlling the creation of query buffers for unsolicited messages
-;; from users with whom you don't share a common channel. However,
-;; additional spelunking has recently revealed that it was instead
-;; meant to service a feature offered by most bouncers that sends
-;; PRIVMSGs directed at a channel you're no longer in and that you
-;; haven't received a(nother) JOIN message for. IOW, this is meant to
-;; support the following sequence of events:
-;;
-;; 1. /detach #chan
-;; 2. kill buffer #chan or reconnect in new Emacs session
-;; 3. /playbuffer #chan
-;;
-;; Note that the above slash commands are bouncer-specific aliases.
-;;
-;; Interested users can find more info by looking at this change set
-;; from the ancient CVS repo:
-;;
-;; Author: Mario Lang <mlang@delysid.org>
-;; AuthorDate: Mon Nov 26 18:33:19 2001 +0000
-;;
-;; * new function erc-BBDB-NICK to handle nickname annotation ...
-;; * Applied antifuchs/mhp patches, the latest on erc-help, unmodified
-;; * New variable: erc-reuse-buffers default to t.
-;; * Modified erc-generate-new-buffer-name to use it. it checks if
-;; server and port are the same, then one can assume that's the same
-;; channel/query target again.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(ert-deftest erc-scenarios-base-attach--ensure-target-buffer--enabled ()
- :tags '(:expensive-test)
- (should erc-ensure-target-buffer-on-privmsg)
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/channel-buffer-revival")
- (dumb-server (erc-d-run "localhost" t 'reattach))
- (port (process-contact dumb-server :service))
- (erc-server-flood-penalty 0.1)
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "tester@vanilla/foonet:changeme"
- :full-name "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
- (erc-cmd-MSG "*status playbuffer #chan"))
-
- (ert-info ("Playback appears in buffer #chan")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 10 "Buffer Playback...")
- (funcall expect 10 "Was I a child")
- (funcall expect 10 "Thou counterfeit'st most lively")
- (funcall expect 10 "Playback Complete")))
-
- (with-current-buffer "foonet"
- (erc-cmd-MSG "*status attach #chan"))
-
- (ert-info ("Live output from #chan after more playback")
- (with-current-buffer "#chan"
- (funcall expect 10 "Buffer Playback...")
- (funcall expect 10 "With what it loathes")
- (funcall expect 10 "Not by his breath")
- (funcall expect 10 "Playback Complete")
- (funcall expect 10 "Ay, and the captain")
- (erc-scenarios-common-say "bob: hi")
- (funcall expect 10 "Pawn me to this")))))
-
-(ert-deftest erc-scenarios-base-attach--ensure-target-buffer--disabled ()
- :tags '(:expensive-test)
- (should erc-ensure-target-buffer-on-privmsg)
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/channel-buffer-revival")
- (dumb-server (erc-d-run "localhost" t 'reattach))
- (port (process-contact dumb-server :service))
- (erc-server-flood-penalty 0.1)
- (erc-ensure-target-buffer-on-privmsg nil) ; off
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "tester@vanilla/foonet:changeme"
- :full-name "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
- (erc-cmd-MSG "*status playbuffer #chan")
- (ert-info ("Playback appears in buffer server buffer")
- (erc-d-t-ensure-for -1 (not (get-buffer "#chan")))
- (funcall expect 10 "Buffer Playback...")
- (funcall expect 10 "Was I a child")
- (funcall expect 10 "Thou counterfeit'st most lively")
- (funcall expect 10 "Playback Complete"))
- (should-not (get-buffer "#chan"))
- (erc-cmd-MSG "*status attach #chan"))
-
- (ert-info ("Buffer #chan joined")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 10 "Buffer Playback...")
- (funcall expect 10 "With what it loathes")
- (funcall expect 10 "Not by his breath")
- (funcall expect 10 "Playback Complete")
- (funcall expect 10 "Ay, and the captain")
- (erc-scenarios-common-say "bob: hi")
- (funcall expect 10 "Pawn me to this")))))
-
-
-;; We omit the `enabled' case for queries because it's the default for
-;; this option and already covered many times over by other tests in
-;; this directory.
-
-(ert-deftest erc-scenarios-base-attach--ensure-target-buffer--disabled-query ()
- :tags '(:expensive-test)
- (should erc-ensure-target-buffer-on-privmsg)
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/assoc/queries")
- (dumb-server (erc-d-run "localhost" t 'non-erc))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- (erc-ensure-target-buffer-on-privmsg nil)
- (erc-server-flood-penalty 0.1))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :full-name "tester")
- (erc-scenarios-common-assert-initial-buf-name nil port)
- (erc-d-t-wait-for 5 (eq erc-network 'foonet))
- (funcall expect 15 "debug mode")))
-
- (ert-info ("User dummy's greeting appears in server buffer")
- (erc-d-t-wait-for -1 (get-buffer "dummy"))
- (with-current-buffer "foonet"
- (funcall expect 5 "hi")
-
- (ert-info ("Option being nil doesn't queries we create")
- (with-current-buffer (erc-cmd-QUERY "nitwit")
- (should (equal (buffer-name) "nitwit"))
- (erc-scenarios-common-say "hola")
- (funcall expect 5 "ciao")))
-
- (erc-scenarios-common-say "howdy")
- (funcall expect 5 "no target")
- (erc-cmd-MSG "dummy howdy")
- (funcall expect 5 "bye")
- (erc-cmd-QUIT "")))))
-
-;;; erc-scenarios-base-attach.el ends here
+++ /dev/null
-;;; erc-scenarios-base-auto-recon.el --- auto-recon scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 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)))
-
-;; This tests `erc-server-delayed-check-reconnect', which is called by
-;; `erc-server-prefer-check-reconnect' (the default value of
-;; `erc-server-reconnect-function' as of ERC 5.6.1).
-
-(defun erc-scenarios-base-auto-recon--get-unused-port ()
- (let ((server (make-network-process :name "*erc-scenarios-base-auto-recon*"
- :host "localhost"
- :service t
- :server t)))
- (delete-process server)
- (process-contact server :service)))
-
-;; This demos one possible flavor of intermittent service.
-;; It may end up needing to be marked :unstable.
-
-(ert-deftest erc-scenarios-base-auto-recon-unavailable ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-server-flood-penalty 0.1)
- (port (erc-scenarios-base-auto-recon--get-unused-port))
- (erc--server-reconnect-timeout-scale-function (lambda (_) 1))
- (erc-server-auto-reconnect t)
- (expect (erc-d-t-make-expecter))
- (erc-scenarios-common-dialog "base/reconnect")
- (dumb-server nil))
-
- (ert-info ("Dialing fails: nobody home")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :full-name "tester")
- (erc-d-t-wait-for 10 (not (erc-server-process-alive)))
- (erc-d-t-wait-for 10 erc--server-reconnect-timer)
- (funcall expect 10 "Opening connection")
- (funcall expect 10 "failed")
-
- (ert-info ("Reconnect function freezes attempts at 1")
- (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))
- (funcall expect 10 "nobody home")
- (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))
- (funcall expect 10 "nobody home"))))
-
- (ert-info ("Service appears")
- (setq dumb-server (erc-d-run "localhost" port
- 'just-eof 'unexpected-disconnect))
- (with-current-buffer (format "127.0.0.1:%d" port)
- (funcall expect 10 "server is in debug mode")
- (should (equal (buffer-name) "FooNet"))))
-
- (ert-info ("Service interrupted, reconnect starts again")
- (with-current-buffer "FooNet"
- (funcall expect 10 "failed")
- (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))))
-
- (ert-info ("Service restored")
- (delete-process dumb-server)
- (setq dumb-server (erc-d-run "localhost" port
- 'just-eof 'unexpected-disconnect))
- (with-current-buffer "FooNet"
- (funcall expect 10 "server is in debug mode")))
-
- (ert-info ("Service interrupted a third time, reconnect starts yet again")
- (with-current-buffer "FooNet"
- (funcall expect 10 "failed")
- (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))
- (erc-cmd-RECONNECT "cancel")
- (funcall expect 10 "canceled")))))
-
-;; Here, a listener accepts but doesn't respond to any messages.
-
-(ert-deftest erc-scenarios-base-auto-recon-no-proto ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-server-flood-penalty 0.1)
- (erc-scenarios-common-dialog "base/reconnect")
- (erc-d-auto-pong nil)
- (erc-d-tmpl-vars
- `((cookie . ,(lambda (a) (funcall a :set (funcall a :match 1))))))
- (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect))
- (port (process-contact dumb-server :service))
- (erc--server-reconnect-timeout-scale-function (lambda (_) 1))
- (erc--server-reconnect-timeout-check 0.5)
- (erc-server-auto-reconnect t)
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Session succeeds but cut short")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :full-name "tester")
- (funcall expect 10 "server is in debug mode")
- (should (equal (buffer-name) "FooNet"))
- (erc-d-t-wait-for 10 erc--server-reconnect-timer)
- (delete-process dumb-server)
- (funcall expect 10 "failed")
-
- (ert-info ("Reconnect function freezes attempts at 1")
- (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))
- (funcall expect 10 "nobody home")
- (funcall expect 10 "timed out while dialing")
- (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))
- (funcall expect 10 "nobody home"))))
-
- (ert-info ("Service restored")
- (setq dumb-server (erc-d-run "localhost" port
- 'just-ping
- 'unexpected-disconnect))
- (with-current-buffer "FooNet"
- (funcall expect 30 "server is in debug mode")))
-
- (ert-info ("Service interrupted again, reconnect starts again")
- (with-current-buffer "FooNet"
- (funcall expect 10 "failed")
- (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))
- (erc-cmd-RECONNECT "cancel")
- (funcall expect 10 "canceled")))))
-
-;;; erc-scenarios-base-auto-recon.el ends here
+++ /dev/null
-;;; erc-scenarios-base-buffer-display.el --- Buffer display scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(eval-when-compile (require 'erc-join))
-
-;; These first couple `erc-auto-reconnect-display' tests used to live
-;; in erc-scenarios-base-reconnect but have since been renamed. Note
-;; that these are somewhat difficult to reason about because the user
-;; joins a second channel after reconnecting, and the first is
-;; controlled by `autojoin'.
-
-(defun erc-scenarios-base-buffer-display--reconnect-common
- (assert-server assert-chan assert-rest)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/reconnect")
- (dumb-server (erc-d-run "localhost" t 'options 'options-again))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- (erc-server-flood-penalty 0.1)
- (erc-server-reconnect-function #'erc-server-delayed-reconnect)
- (erc-server-auto-reconnect t)
- erc-autojoin-channels-alist)
-
- (should (memq 'autojoin erc-modules))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "changeme"
- :full-name "tester")
- (funcall assert-server expect)
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (funcall expect 10 "debug mode")))
-
- (ert-info ("Wait for some output in channels")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall assert-chan expect)
- (funcall expect 10 "welcome")
- (funcall expect 10 "welcome")))
-
- (ert-info ("Server buffer shows connection failed")
- (with-current-buffer "FooNet"
- (funcall expect 10 "Connection failed! Re-establishing")))
-
- (should (equal erc-autojoin-channels-alist '((FooNet "#chan"))))
- (delete-other-windows)
- (pop-to-buffer-same-window "*Messages*")
-
- (ert-info ("Wait for auto reconnect")
- (with-current-buffer "FooNet" (funcall expect 10 "still in debug mode")))
-
- (ert-info ("Lone window still shows messages buffer")
- (should (eq (window-buffer) (messages-buffer)))
- (should (frame-root-window-p (selected-window))))
-
- (funcall assert-rest expect)
-
- (ert-info ("Wait for activity to recommence in both channels")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 10 "forest of Arden"))
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))
- (funcall expect 10 "her elves come here anon")))))
-
-;; Interactively issuing a slash command resets the auto-reconnect
-;; count, making ERC ignore the option `erc-auto-reconnect-display'
-;; when next displaying a newly set up buffer. In the case of a
-;; /JOIN, the option `erc-interactive-display' takes precedence.
-(ert-deftest erc-scenarios-base-buffer-display--defwin-recbury-intbuf ()
- :tags '(:expensive-test)
- (should (eq erc-buffer-display 'bury))
- (should (eq erc-interactive-display 'window))
- (should-not erc-auto-reconnect-display)
-
- (let ((erc-buffer-display 'window) ; defwin
- (erc-interactive-display 'buffer) ; intbuf
- (erc-auto-reconnect-display 'bury)) ; recbury
-
- (erc-scenarios-base-buffer-display--reconnect-common
-
- (lambda (_)
- (ert-info ("New server buffer appears in a selected split")
- (should (eq (window-buffer) (current-buffer)))
- (should-not (frame-root-window-p (selected-window)))))
-
- (lambda (_)
- (ert-info ("New channel buffer appears in other window")
- (should (eq (window-buffer) (current-buffer))) ; selected
- (should (equal (get-buffer "FooNet") (window-buffer (next-window))))))
-
- (lambda (expect)
- ;; If we /JOIN #spam now, we'll cancel the auto-reconnect
- ;; timer, and "#chan" may well pop up in a split before we can
- ;; verify that the lone window displays #spam (a race, IOW).
- (ert-info ("Autojoined channel #chan buried on JOIN")
- (with-current-buffer "#chan"
- (funcall expect 10 "You have joined channel #chan"))
- (should (frame-root-window-p (selected-window)))
- (should (eq (window-buffer) (messages-buffer))))
-
- (with-current-buffer "FooNet" (erc-scenarios-common-say "/JOIN #spam"))
-
- (ert-info ("A /JOIN ignores `erc-auto-reconnect-display'")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))
- (should (eq (window-buffer) (get-buffer "#spam")))
- ;; Option `erc-interactive-display' being `buffer' means
- ;; Emacs reuses the selected window (no split).
- (should (frame-root-window-p (selected-window)))))))))
-
-(ert-deftest erc-scenarios-base-buffer-display--defwino-recbury-intbuf ()
- :tags '(:expensive-test)
- (should (eq erc-buffer-display 'bury))
- (should (eq erc-interactive-display 'window))
- (should-not erc-auto-reconnect-display)
-
- (let ((erc-buffer-display 'window-noselect) ; defwino
- (erc-auto-reconnect-display 'bury)
- (erc-interactive-display 'buffer))
- (erc-scenarios-base-buffer-display--reconnect-common
-
- (lambda (_)
- ;; Selected window shows some non-ERC buffer. New server
- ;; buffer appears in another window (other side of split).
- (should-not (frame-root-window-p (selected-window)))
- (should-not (eq (window-buffer) (current-buffer)))
- (with-current-buffer (window-buffer)
- (should-not (derived-mode-p 'erc-mode)))
- (should (eq (current-buffer) (window-buffer (next-window)))))
-
- (lambda (_)
- (should-not (frame-root-window-p (selected-window)))
- ;; Current split likely shows scratch.
- (with-current-buffer (window-buffer)
- (should-not (derived-mode-p 'erc-mode)))
- (should (eq (current-buffer) (window-buffer (next-window)))))
-
- (lambda (_)
- ;; A JOIN command sent from lisp code is "non-interactive" and
- ;; doesn't reset the auto-reconnect count, so ERC treats the
- ;; response as possibly server-initiated or otherwise the
- ;; result of an autojoin and continues to favor
- ;; `erc-auto-reconnect-display'.
- (ert-info ("Join chan non-interactively and open a /QUERY")
- (with-current-buffer "FooNet"
- (erc-cmd-JOIN "#spam") ; "non-interactive" according to ERC
- (erc-scenarios-common-say "/QUERY bob") ; resets count
- (should (eq (window-buffer) (get-buffer "bob")))
- (should (frame-root-window-p (selected-window)))))
-
- ;; The /QUERY above resets the count, and `erc-buffer-display'
- ;; again decides how #spam is displayed.
- (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))) ; noselect
- (should (eq (current-buffer) (window-buffer (next-window))))))))))
-
-(ert-deftest erc-scenarios-base-buffer-display--count-reset-timeout ()
- :tags '(:expensive-test)
- (should (eq erc-buffer-display 'bury))
- (should (eq erc-interactive-display 'window))
- (should (eq erc-auto-reconnect-display-timeout 10))
- (should-not erc-auto-reconnect-display)
-
- (let ((erc-buffer-display 'window-noselect)
- (erc-auto-reconnect-display 'bury)
- (erc-interactive-display 'buffer)
- (erc-auto-reconnect-display-timeout 0.5))
- (erc-scenarios-base-buffer-display--reconnect-common
- #'ignore #'ignore ; These two are identical to the previous test.
-
- (lambda (_)
- (with-current-buffer "FooNet"
- (erc-d-t-wait-for 1 erc--server-reconnect-display-timer))
-
- ;; A non-interactive JOIN command doesn't signal that we're
- ;; done auto-reconnecting.
- (ert-info ("Join channel #spam non-interactively")
- (with-current-buffer "FooNet"
- (erc-d-t-wait-for 1 (null erc--server-reconnect-display-timer))
- (erc-cmd-JOIN "#spam"))) ; not processed as a /JOIN
-
- (ert-info ("Option `erc-auto-reconnect-display' ignored w/o timer")
- (should (eq (window-buffer) (messages-buffer)))
- (erc-d-t-wait-for 10 (get-buffer "#spam"))
- ;; 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 (get-buffer "#spam") (window-buffer (next-window)))))))))
-
-;; This shows that the option `erc-interactive-display' overrides
-;; `erc-join-buffer' during cold opens and interactive /JOINs.
-
-(ert-deftest erc-scenarios-base-buffer-display--interactive-default ()
- :tags '(:expensive-test)
- (should (eq erc-join-buffer 'bury))
- (should (eq erc-interactive-display 'window))
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "join/legacy")
- (dumb-server (erc-d-run "localhost" t 'foonet))
- (port (process-contact dumb-server :service))
- (url (format "tester:changeme@127.0.0.1:%d\r\r" port))
- (expect (erc-d-t-make-expecter))
- (erc-server-flood-penalty 0.1)
- (erc-server-auto-reconnect t)
- (erc-user-full-name "tester"))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (let (inhibit-interaction)
- (ert-simulate-keys url
- (call-interactively #'erc)))
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
-
- (erc-d-t-wait-for 10 "Server buffer shown"
- (eq (window-buffer) (current-buffer)))
- (funcall expect 10 "debug mode")
- (erc-scenarios-common-say "/JOIN #chan")))
-
- (ert-info ("Wait for output in #chan")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 10 "welcome")
- (erc-d-t-ensure-for 3 "Channel #chan shown"
- (eq (window-buffer) (current-buffer)))
- (funcall expect 10 "be prosperous")))))
-
-;;; erc-scenarios-base-buffer-display.el ends here
+++ /dev/null
-;;; erc-scenarios-base-chan-modes.el --- Channel mode scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 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)))
-
-;; This asserts that a bug present in ERC 5.4+ is now absent.
-;; Previously, ERC would attempt to parse a nullary channel mode as if
-;; it were a status prefix update, which led to a wrong-type error.
-;; This test does not address similar collisions with unary modes,
-;; such as "MODE +q foo!*@*", but it should.
-(ert-deftest erc-scenarios-base-chan-modes--plus-q ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/modes")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'chan-changed))
- (erc-modules (cons 'fill-wrap erc-modules))
- (erc-autojoin-channels-alist '((Libera.Chat "#chan")))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to Libera.Chat")
- (with-current-buffer (erc :server "127.0.0.1"
- :port (process-contact dumb-server :service)
- :nick "tester"
- :full-name "tester")
- (funcall expect 5 "changed mode")))
-
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (should-not erc-channel-key)
- (should-not erc-channel-user-limit)
-
- (ert-info ("Receive notice that mode has changed")
- (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t")))
- (erc-scenarios-common-say "ready before")
- (funcall expect 10 "<Chad> before")
- (funcall expect 10 " has changed mode for #chan to +Qu")
- (erc-d-t-wait-for 10 (equal erc-channel-modes '("Q" "n" "t" "u"))))
-
- (ert-info ("Key stored locally")
- (erc-scenarios-common-say "ready key")
- (funcall expect 10 "<Chad> doing key")
- (funcall expect 10 " has changed mode for #chan to +k hunter2")
- (should (equal erc-channel-key "hunter2")))
-
- (ert-info ("Limit stored locally")
- (erc-scenarios-common-say "ready limit")
- (funcall expect 10 "<Chad> doing limit")
- (funcall expect 10 " has changed mode for #chan to +l 3")
- (erc-d-t-wait-for 10 (eql erc-channel-user-limit 3))
- (should (equal erc-channel-modes '("Q" "n" "t" "u"))))
-
- (ert-info ("Modes removed and local state deletion succeeds")
- (erc-scenarios-common-say "ready drop")
- (funcall expect 10 "<Chad> dropping")
- (funcall expect 10 " has changed mode for #chan to -lu")
- (funcall expect 10 " has changed mode for #chan to -Qk *")
- (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t"))))
-
- (should-not erc-channel-key)
- (should-not erc-channel-user-limit)
- (funcall expect 10 "<Chad> after"))))
-
-;; This asserts proper recognition of nonstandard prefixes advertised
-;; via the "PREFIX=" ISUPPORT parameter. Note that without the IRCv3
-;; `multi-prefix' extension, we can't easily sync a user's channel
-;; membership status on receipt of a 352/353 by parsing the "flags"
-;; parameter because even though servers remember multiple prefixes,
-;; they only ever return the one with the highest rank. For example,
-;; if on receipt of a 352, we were to "update" someone we believe to
-;; be @+ by changing them to a to @, we'd be guilty of willful
-;; munging. And if they later lose that @, we'd then see them as null
-;; when in fact they're still +. However, we *could* use a single
-;; degenerate prefix to "validate" an existing record to ensure
-;; correctness of our processing logic, but it's unclear how such a
-;; discrepancy ought to be handled beyond asking the user to file a
-;; bug.
-(ert-deftest erc-scenarios-base-chan-modes--speaker-status ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/modes")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'speaker-status))
- (erc-show-speaker-membership-status t)
- (erc-autojoin-channels-alist '(("." "#chan")))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port (process-contact dumb-server :service)
- :nick "tester"
- :user "tester")
- (funcall expect 5 "Here on foonet, we provide services")))
-
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
-
- (ert-info ("Prefixes printed correctly in 353")
- (funcall expect 10 "chan: +alice @fsbot -bob !foop"))
-
- (ert-info ("Speakers honor option `erc-show-speaker-membership-status'")
- (funcall expect 10 "<-bob> alice: Of that which hath")
- (funcall expect 10 "<+alice> Hie you, make haste")
- (funcall expect 10 "<!foop> hi"))
-
- (ert-info ("Status conferred and rescinded")
- (funcall expect 10 "*** foop (user@netadmin.example.net) has changed ")
- (funcall expect 10 "mode for #chan to +v bob")
- (funcall expect 10 "<+bob> alice: Fair as a text B")
- (funcall expect 10 "<+alice> bob: Even as Apemantus")
- (funcall expect 10 "mode for #chan to -v bob")
- (funcall expect 10 "<-bob> alice: That's the way")
- (funcall expect 10 "<+alice> Give it the beasts"))
-
- ;; If it had instead overwritten it, our two states would be
- ;; out of sync. (See comment above.)
- (ert-info ("/WHO output confirms server shadowed V status")
- (erc-scenarios-common-say "/who #chan")
- (funcall expect 10 '(: "bob" (+ " ") "H-"))
- (funcall expect 10 "<-bob> alice: Remains in danger")
- (erc-cmd-QUIT "")))))
-
-;;; erc-scenarios-base-chan-modes.el ends here
+++ /dev/null
-;;; erc-scenarios-base-compat-rename-bouncer.el --- Compat-rename scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(eval-when-compile (require 'erc-join))
-
-;; Ensure deprecated option still respected when old default value
-;; explicitly set ("respected" in the sense of having names reflect
-;; dialed TCP endpoints with possible uniquifiers but without any of
-;; the old issues, pre-bug#48598).
-
-(defun erc-scenarios-common--base-compat-no-rename-bouncer (dialogs auto more)
- (erc-scenarios-common-with-cleanup
- ;; These actually *are* (assigned-)network-id related because
- ;; our kludge assigns one after the fact.
- ((erc-scenarios-common-dialog "base/netid/bouncer")
- (erc-d-t-cleanup-sleep-secs 1)
- (erc-server-flood-penalty 0.1)
- (dumb-server (apply #'erc-d-run "localhost" t dialogs))
- (port (process-contact dumb-server :service))
- (chan-buf-foo (format "#chan@127.0.0.1:%d" port))
- (chan-buf-bar (format "#chan@127.0.0.1:%d<2>" port))
- (expect (erc-d-t-make-expecter))
- (erc-server-reconnect-function #'erc-server-delayed-reconnect)
- (erc-server-auto-reconnect auto)
- erc-server-buffer-foo erc-server-process-foo
- erc-server-buffer-bar erc-server-process-bar)
-
- (ert-info ("Connect to foonet")
- (with-current-buffer
- (setq erc-server-buffer-foo (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester"
- :id nil))
- (setq erc-server-process-foo erc-server-process)
- (erc-d-t-wait-for 3 (eq (erc-network) 'foonet))
- (erc-d-t-wait-for 3 "Final buffer name determined"
- (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (funcall expect 5 "foonet")))
-
- (ert-info ("Join #chan@foonet")
- (with-current-buffer erc-server-buffer-foo (erc-cmd-JOIN "#chan"))
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (funcall expect 5 "<alice>")))
-
- (ert-info ("Connect to barnet")
- (with-current-buffer
- (setq erc-server-buffer-bar (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "barnet:changeme"
- :full-name "tester"
- :id nil))
- (setq erc-server-process-bar erc-server-process)
- (erc-d-t-wait-for 3 (eq (erc-network) 'barnet))
- (erc-d-t-wait-for 3 "Final buffer name determined"
- (string= (buffer-name) (format "127.0.0.1:%d<2>" port)))
- (funcall expect 5 "barnet")))
-
- (ert-info ("Server buffers are unique, no names based on IPs")
- (should-not (eq erc-server-buffer-foo erc-server-buffer-bar))
- (should (equal (erc-scenarios-common-buflist "127.0.0.1")
- (list (get-buffer (format "127.0.0.1:%d<2>" port))
- (get-buffer (format "127.0.0.1:%d" port))))))
-
- (ert-info ("Join #chan@barnet")
- (with-current-buffer erc-server-buffer-bar (erc-cmd-JOIN "#chan")))
-
- (erc-d-t-wait-for 5 "Exactly 2 #chan-prefixed buffers exist"
- (equal (list (get-buffer chan-buf-bar)
- (get-buffer chan-buf-foo))
- (erc-scenarios-common-buflist "#chan")))
-
- (ert-info ("#chan@127.0.0.1:$port is exclusive to foonet")
- (with-current-buffer chan-buf-foo
- (erc-d-t-search-for 1 "<bob>")
- (erc-d-t-absent-for 0.1 "<joe>")
- (should (eq erc-server-process erc-server-process-foo))
- (erc-d-t-search-for 10 "ape is dead")
- (erc-d-t-wait-for 5 (not (erc-server-process-alive)))))
-
- (ert-info ("#chan@127.0.0.1:$port<2> is exclusive to barnet")
- (with-current-buffer chan-buf-bar
- (erc-d-t-search-for 1 "<joe>")
- (erc-d-t-absent-for 0.1 "<bob>")
- (should (eq erc-server-process erc-server-process-bar))
- (erc-d-t-search-for 10 "joe: It is a rupture")
- (erc-d-t-wait-for 5 (not (erc-server-process-alive)))))
-
- (when more (funcall more))))
-
-(ert-deftest erc-scenarios-base-compat-no-rename-bouncer--basic ()
- :tags '(:expensive-test)
- (with-suppressed-warnings ((obsolete erc-rename-buffers))
- (let (erc-rename-buffers)
- (erc-scenarios-common--base-compat-no-rename-bouncer
- '(foonet barnet) nil nil))))
-
-(ert-deftest erc-scenarios-base-compat-no-rename-bouncer--reconnect ()
- :tags '(:expensive-test)
- (let ((erc-d-tmpl-vars '((token . (group (| "barnet" "foonet")))))
- (erc-d-match-handlers
- (list :pass #'erc-scenarios-common--clash-rename-pass-handler))
- (dialogs '(foonet-drop barnet-drop stub-again stub-again
- foonet-again barnet-again))
- (after
- (lambda ()
- (pcase-let* ((`(,barnet ,foonet)
- (erc-scenarios-common-buflist "127.0.0.1"))
- (port (process-contact (with-current-buffer foonet
- erc-server-process)
- :service)))
-
- (ert-info ("Sanity check: barnet retains uniquifying suffix")
- (should (string-suffix-p "<2>" (buffer-name barnet))))
-
- ;; Simulate disconnection and `erc-server-auto-reconnect'
- (ert-info ("Reconnect to foonet and barnet back-to-back")
- (with-current-buffer foonet
- (erc-d-t-wait-for 5 (erc-server-process-alive)))
- (with-current-buffer barnet
- (erc-d-t-wait-for 5 (erc-server-process-alive))))
-
- (ert-info ("#chan@127.0.0.1:<port> is exclusive to foonet")
- (with-current-buffer (format "#chan@127.0.0.1:%d" port)
- (erc-d-t-search-for 1 "<alice>")
- (erc-d-t-absent-for 0.1 "<joe>")
- (erc-d-t-search-for 10 "please your lordship")))
-
- (ert-info ("#chan@barnet is exclusive to barnet")
- (with-current-buffer (format "#chan@127.0.0.1:%d<2>" port)
- (erc-d-t-search-for 1 "<joe>")
- (erc-d-t-absent-for 0.1 "<bob>")
- (erc-d-t-search-for 1 "much in private")))
-
- ;; Ordering deterministic here even though not so for reconnect
- (should (equal (list barnet foonet)
- (erc-scenarios-common-buflist "127.0.0.1")))
- (should (equal (list
- (get-buffer (format "#chan@127.0.0.1:%d<2>" port))
- (get-buffer (format "#chan@127.0.0.1:%d" port)))
- (erc-scenarios-common-buflist "#chan")))))))
-
- (with-suppressed-warnings ((obsolete erc-rename-buffers))
- (let (erc-rename-buffers)
- (erc-scenarios-common--base-compat-no-rename-bouncer dialogs
- 'auto after)))))
-
-;;; erc-scenarios-base-compat-rename-bouncer.el ends here
+++ /dev/null
-;;; erc-scenarios-base-kill-on-part.el --- killing buffers on part -*- lexical-binding: t -*-
-
-;; Copyright (C) 2024-2025 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)))
-
-;; Assert channel buffer is killed when `erc-kill-buffer-on-part' is
-;; enabled and a user issues a /part. Also assert that code in
-;; `erc-kill-channel-hook' can detect when `erc-response-PART' is
-;; killing a buffer on behalf of that option.
-(ert-deftest erc-scenarios-base-kill-on-part--enabled ()
- :tags '(:expensive-test)
- (should-not erc-kill-buffer-on-part)
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/reuse-buffers/channel")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'foonet))
- (port (process-contact dumb-server :service))
- (erc-kill-buffer-on-part t)
- (calls nil)
- (erc-part-hook (lambda (b) (push (buffer-name b) calls)))
- (erc-kill-channel-hook
- (cons (lambda () (push erc-killing-buffer-on-part-p calls))
- erc-kill-channel-hook))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester")
- (funcall expect 10 "This server is in debug mode")))
-
- (with-current-buffer (erc-d-t-wait-for 20 (get-buffer "#chan"))
- (funcall expect 10 "<alice> bob: Whilst I can shake")
- (erc-scenarios-common-say "/part"))
-
- (erc-d-t-wait-for 20 (null (get-buffer "#chan")))
- (should (equal calls '(t "#chan")))))
-
-;; When `erc-kill-buffer-on-part' is non-nil, and the parted buffer has
-;; already been killed, don't kill the server buffer. Bug#70840
-(ert-deftest erc-scenarios-base-kill-on-part--enabled/killed ()
- :tags '(:expensive-test)
- (should-not erc-kill-buffer-on-part)
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/reuse-buffers/channel")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'foonet))
- (port (process-contact dumb-server :service))
- (erc-kill-buffer-on-part t)
- (calls nil)
- (erc-part-hook (lambda (b) (push b calls)))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester")
- (funcall expect 10 "This server is in debug mode")))
-
- (with-current-buffer (erc-d-t-wait-for 20 (get-buffer "#chan"))
- (funcall expect 10 "<alice> bob: Whilst I can shake")
- (kill-buffer))
-
- (erc-d-t-wait-for 20 (null (get-buffer "#chan")))
- (erc-d-t-wait-for 10 (equal calls '(nil)))
- (erc-d-t-ensure-for 0.1 (get-buffer "foonet"))))
-
-;;; erc-scenarios-base-kill-on-part.el ends here
+++ /dev/null
-;;; erc-scenarios-base-local-module-modes.el --- More local-mod ERC tests -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; A local module doubles as a minor mode whose mode variable and
-;; associated local data can withstand service disruptions.
-;; Unfortunately, the current implementation is too unwieldy to be
-;; made public because it doesn't perform any of the boiler plate
-;; needed to save and restore buffer-local and "network-local" copies
-;; of user options. Ultimately, a user-friendly framework must fill
-;; this void if third-party local modules are ever to become
-;; practical.
-;;
-;; The following tests all use `sasl' because, as of ERC 5.5, it's the
-;; only local module.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(require 'erc-sasl)
-
-;; After quitting a session for which `sasl' is enabled, you
-;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
-;; using an alternate nickname. You again disconnect and reconnect,
-;; this time immediately, and the mode stays disabled. Finally, you
-;; once again disconnect, toggle the mode back on, and reconnect. You
-;; are authenticated successfully, just like in the initial session.
-;;
-;; This is meant to show that a user's local mode settings persist
-;; between sessions. It also happens to show (in round four, below)
-;; that a server renicking a user on 001 after a 903 is handled just
-;; like a user-initiated renick, although this is not the main thrust.
-
-(ert-deftest erc-scenarios-base-local-module-modes--reconnect ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/local-modules")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (expect (erc-d-t-make-expecter))
- (server-buffer-name (format "127.0.0.1:%d" port)))
-
- (ert-info ("Round one, initial authentication succeeds as expected")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) server-buffer-name))
- (funcall expect 10 "You are now logged in as tester"))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-JOIN "#chan")
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 20 "She is Lavinia, therefore must"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round two, nick rejected, alternate granted")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode off, reconnect")
- (erc-sasl-mode -1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Some enigma, some riddle"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round three, send alternate nick initially")
- (with-current-buffer "foonet"
-
- (ert-info ("Keep mode off, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Let our reciprocal vows be remembered."))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round four, authenticated successfully again")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode on, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-sasl-mode +1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
-
- (erc-cmd-QUIT "")))))
-
-;; In contrast to the mode-persistence test above, this one
-;; demonstrates that a user reinvoking an entry point declares their
-;; intention to reset local-module state for the server buffer.
-;; Whether a local-module's state variable is also reset in target
-;; buffers up to the module. That is, by default, they're left alone.
-
-(ert-deftest erc-scenarios-base-local-module-modes--entrypoint ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/local-modules")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'first 'first))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (expect (erc-d-t-make-expecter))
- (server-buffer-name (format "127.0.0.1:%d" port)))
-
- (ert-info ("Round one, initial authentication succeeds as expected")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) server-buffer-name))
- (funcall expect 10 "You are now logged in as tester"))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-JOIN "#chan")
-
- (ert-info ("Toggle local-module off in target buffer")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 20 "She is Lavinia, therefore must")
- (erc-sasl-mode -1)))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")
-
- (ert-info ("Toggle mode off")
- (erc-sasl-mode -1)
- (should (local-variable-p 'erc-sasl-mode)))))
-
- (ert-info ("Reconnecting via entry point discards `erc-sasl-mode' value.")
- ;; If you were to /RECONNECT here, no PASS changeme would be
- ;; sent instead of CAP SASL, resulting in a failure.
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) server-buffer-name))
- (funcall expect 10 "You are now logged in as tester")
-
- (erc-d-t-wait-for 10 (equal (buffer-name) "foonet"))
- (funcall expect 10 "User modes for tester")
- (should erc-sasl-mode)) ; obviously
-
- ;; No other foonet buffer exists, e.g., foonet<2>
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
-
- (ert-info ("Target buffer retains local-module state")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 20 "She is Lavinia, therefore must")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-cmd-QUIT ""))))))
-
-;;; erc-scenarios-base-local-module-modes.el ends here
+++ /dev/null
-;;; erc-scenarios-base-local-modules.el --- Local-module tests for ERC -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; A local module doubles as a minor mode whose mode variable and
-;; associated local data can withstand service disruptions.
-;; Unfortunately, the current implementation is too unwieldy to be
-;; promoted publicly because it doesn't perform any of the boiler
-;; plate needed to save and restore buffer-local and "network-local"
-;; copies of user options. Ultimately, a user-friendly framework must
-;; fill this void if third-party local modules are ever to become
-;; practical.
-;;
-;; The following tests all use `sasl' because, as of ERC 5.5, it's the
-;; only connection-oriented local module. A fictitious
-;; target-oriented module is defined below for testing purposes.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(require 'erc-sasl)
-
-;; This asserts that a local module's options and its inclusion in
-;; (and absence from) `erc-update-modules' can be let-bound.
-
-(ert-deftest erc-scenarios-base-local-modules--reconnect-let ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "sasl")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'plain 'plain))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect with options let-bound")
- (with-current-buffer
- ;; This won't work unless the library is already loaded
- (let ((erc-modules (cons 'sasl erc-modules))
- (erc-sasl-mechanism 'plain)
- (erc-sasl-password "password123"))
- (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :full-name "tester"))
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "ExampleOrg"))
-
- (ert-info ("First connection succeeds")
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished"))
-
- (should-not (memq 'sasl erc-modules))
- (erc-d-t-wait-for 10 (not (erc-server-process-alive)))
- (erc-cmd-RECONNECT)
-
- (ert-info ("Second connection succeeds")
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))))
-
-;; For local modules, the twin toggle commands `erc-FOO-enable' and
-;; `erc-FOO-disable' affect all buffers of a connection, whereas
-;; `erc-FOO-mode' continues to operate only on the current buffer.
-
-(ert-deftest erc-scenarios-base-local-modules--toggle-helpers ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/local-modules")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'first 'second 'fourth))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (expect (erc-d-t-make-expecter))
- (server-buffer-name (format "127.0.0.1:%d" port)))
-
- (ert-info ("Initial authentication succeeds as expected")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) server-buffer-name))
- (funcall expect 10 "You are now logged in as tester"))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-JOIN "#chan")
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 20 "She is Lavinia, therefore must"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Explicit disabling affects entire session")
- ;; Even though the mode variable is nil (but locally bound) in
- ;; this target buffer, disabling interactively with
- ;; `erc-sasl-disable', deactivates the module session-wide.
- (with-current-buffer "#chan"
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (should (buffer-local-value 'erc-sasl-mode (get-buffer "foonet")))
- (call-interactively #'erc-sasl-disable)
- (should-not (buffer-local-value 'erc-sasl-mode (get-buffer "foonet")))
- (should-not erc-sasl-mode)
- (erc-cmd-RECONNECT)
- (funcall expect 10 "Some enigma, some riddle")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode)))
-
- (with-current-buffer "foonet"
- (should (local-variable-p 'erc-sasl-mode))
- (should-not erc-sasl-mode)
- (funcall expect 10 "User modes for tester`")
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Enabling works from a target buffer")
- (with-current-buffer "#chan"
- (call-interactively #'erc-sasl-enable)
- (should (local-variable-p 'erc-sasl-mode))
- (should-not erc-sasl-mode)
- (should (buffer-local-value 'erc-sasl-mode (get-buffer "foonet")))
- (erc-cmd-RECONNECT)
- (funcall expect 10 "Well met; good morrow, Titus and Hortensius.")
- (erc-cmd-QUIT ""))
-
- (with-current-buffer "foonet"
- (should (local-variable-p 'erc-sasl-mode))
- (should erc-sasl-mode)
- (funcall expect 10 "User modes for tester")))))
-
-(defvar-local erc-scenarios-base-local-modules--local-var nil)
-
-(define-erc-module -phony-sblm- nil
- "Test module for `erc-scenarios-base-local-modules--var-persistence'."
- ((when-let ((vars (or erc--server-reconnecting erc--target-priors)))
- (should (assq 'erc--phony-sblm--mode vars))
- (setq erc-scenarios-base-local-modules--local-var
- (alist-get 'erc-scenarios-base-local-modules--local-var vars)))
- (setq erc-scenarios-base-local-modules--local-var
- (or erc-scenarios-base-local-modules--local-var
- (if erc--target 100 0))))
- ((kill-local-variable 'erc-scenarios-base-local-modules--local-var))
- 'local)
-
-;; Note: this file has grown too expensive (time-wise) and must be
-;; split up. When that happens, this test should be rewritten without
-;; any time-saving hacks, namely, server-initiated JOINs and an
-;; absence of QUITs. (That said, three connections in under 2 seconds
-;; is pretty nice.)
-
-(ert-deftest erc-scenarios-base-local-modules--var-persistence ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/reconnect")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'options 'options 'options))
- (port (process-contact dumb-server :service))
- (erc-modules (cons '-phony-sblm- (remq 'autojoin erc-modules)))
- (expect (erc-d-t-make-expecter))
- (server-buffer-name (format "127.0.0.1:%d" port)))
-
- (ert-info ("Initial authentication succeeds as expected")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) server-buffer-name)))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "FooNet"))
- (funcall expect 10 "This server is in debug mode")
- (should erc--phony-sblm--mode)
- (should (eql erc-scenarios-base-local-modules--local-var 0))
- (setq erc-scenarios-base-local-modules--local-var 1)))
-
- (ert-info ("Save module's local var in target buffer")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (should (eql erc-scenarios-base-local-modules--local-var 100))
- (setq erc-scenarios-base-local-modules--local-var 101)
- (funcall expect 20 "welcome")))
-
- (with-current-buffer "FooNet" (funcall expect 20 "terminated"))
-
- (ert-info ("Vars reused when mode was left enabled")
- (with-current-buffer "#chan"
- (erc-cmd-RECONNECT)
- (funcall expect 20 "welcome")
- (should (eql erc-scenarios-base-local-modules--local-var 101))
- (erc--phony-sblm--mode -1))
-
- (with-current-buffer "FooNet"
- (funcall expect 10 "User modes for tester")
- (should (eql erc-scenarios-base-local-modules--local-var 1))))
-
- (with-current-buffer "FooNet" (funcall expect 20 "terminated"))
-
- (ert-info ("Local binding gone when mode disabled in target")
- (with-current-buffer "#chan"
- (erc-cmd-RECONNECT)
- (funcall expect 20 "welcome")
- (should-not erc--phony-sblm--mode)
- (should-not erc-scenarios-base-local-modules--local-var))
-
- ;; But value retained in server buffer, where mode is active.
- (with-current-buffer "FooNet"
- (funcall expect 10 "User modes for tester")
- (should (eql erc-scenarios-base-local-modules--local-var 1))))))
-
-;;; erc-scenarios-base-local-modules.el ends here
+++ /dev/null
-;;; erc-scenarios-base-misc-regressions.el --- misc regressions scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(eval-when-compile (require 'erc-join))
-
-(defun erc-scenarios--rebuffed-gapless-pass-handler (dialog exchange)
- (when (eq (erc-d-dialog-name dialog) 'pass-stub)
- (let* ((match (erc-d-exchange-match exchange 1))
- (sym (if (string= match "foonet") 'foonet 'barnet)))
- (should (member match (list "foonet" "barnet")))
- (erc-d-load-replacement-dialog dialog sym 1))))
-
-(ert-deftest erc-scenarios-base-gapless-connect ()
- "Back-to-back entry-point invocations happen successfully.
-Originally from scenario rebuffed/gapless as explained in Bug#48598:
-28.0.50; buffer-naming collisions involving bouncers in ERC."
- :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-d-tmpl-vars '((token . (group (| "barnet" "foonet")))))
- (erc-d-match-handlers
- (list :pass #'erc-scenarios--rebuffed-gapless-pass-handler))
- (dumb-server (erc-d-run "localhost" t
- 'pass-stub 'pass-stub 'barnet 'foonet))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- erc-autojoin-channels-alist
- erc-server-buffer-foo
- erc-server-buffer-bar)
-
- (ert-info ("Connect twice to same endpoint without pausing")
- (setq erc-server-buffer-foo (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester")
- erc-server-buffer-bar (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "barnet:changeme"
- :full-name "tester")))
-
- (ert-info ("Returned server buffers are unique")
- (should-not (eq erc-server-buffer-foo erc-server-buffer-bar)))
-
- (ert-info ("Both connections still alive")
- (should (get-process (format "erc-127.0.0.1-%d" port)))
- (should (get-process (format "erc-127.0.0.1-%d<1>" port))))
-
- (with-current-buffer erc-server-buffer-bar
- (funcall expect 2 "marked as being away"))
-
- (with-current-buffer (erc-d-t-wait-for 20 (get-buffer "#bar"))
- (funcall expect 10 "was created on")
- (funcall expect 10 "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"))))
-
-;; This defends against a regression in `erc-server-PRIVMSG' caused by
-;; the removal of `erc-auto-query'. When an active channel buffer is
-;; killed off and PRIVMSGs arrive targeting it, the buffer should be
-;; recreated. See elsewhere for NOTICE logic, which is more complex.
-
-(ert-deftest erc-scenarios-base-channel-buffer-revival ()
- :tags '(:expensive-test)
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/channel-buffer-revival")
- (dumb-server (erc-d-run "localhost" t 'foonet))
- (port (process-contact dumb-server :service))
- erc-autojoin-channels-alist
- erc-server-buffer-foo)
-
- (ert-info ("Connect to foonet")
- (setq erc-server-buffer-foo (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "changeme"
- :full-name "tester"))
- (with-current-buffer erc-server-buffer-foo
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (ert-info ("Server buffer is unique and temp name is absent")
- (erc-d-t-wait-for 10 (get-buffer "FooNet"))
- (should-not (erc-scenarios-common-buflist "127.0.0.1"))
- (with-current-buffer erc-server-buffer-foo
- (erc-cmd-JOIN "#chan")))
-
- (ert-info ("Channel buffer #chan alive and well")
- (with-current-buffer (erc-d-t-wait-for 8 (get-buffer "#chan"))
- (erc-d-t-search-for 10 "Our queen and all her elves")
- (kill-buffer)))
-
- (should-not (get-buffer "#chan"))
-
- (ert-info ("Channel buffer #chan revived")
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (erc-d-t-search-for 10 "and be prosperous")))))
-
-;;; erc-scenarios-base-misc-regressions.el ends here
+++ /dev/null
-;;; erc-scenarios-base-netid-bouncer-id.el --- net-id bouncer ID scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(ert-deftest erc-scenarios-base-netid-bouncer--id-foo ()
- :tags '(:expensive-test)
- (erc-scenarios-common--base-network-id-bouncer '(:foo-id t) 'foonet 'barnet))
-
-(ert-deftest erc-scenarios-base-netid-bouncer--id-bar ()
- :tags '(:expensive-test)
- (erc-scenarios-common--base-network-id-bouncer '(:bar-id t) 'foonet 'barnet))
-
-;;; erc-scenarios-base-netid-bouncer-id.el ends here
+++ /dev/null
-;;; erc-scenarios-base-netid-bouncer-recon-base.el --- net-id base scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(ert-deftest erc-scenarios-base-netid-bouncer--recon-base ()
- :tags '(:expensive-test)
- (let ((erc-server-reconnect-function #'erc-server-delayed-reconnect))
- (erc-scenarios-common--base-network-id-bouncer--reconnect nil nil)))
-
-;;; erc-scenarios-base-netid-bouncer-recon-base.el ends here
+++ /dev/null
-;;; erc-scenarios-base-netid-bouncer-recon-both.el --- net-id both scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-;;
-;; This file is part of GNU Emacs.
-;;
-;; This program 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.
-;;
-;; This program 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 this program. If not, see
-;; <https://www.gnu.org/licenses/>.
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(require 'erc-scenarios-common)
-
-(ert-deftest erc-scenarios-base-netid-bouncer--recon-both ()
- :tags '(:expensive-test)
- (let ((erc-server-reconnect-function #'erc-server-delayed-reconnect))
- (erc-scenarios-common--base-network-id-bouncer--reconnect 'foo-id
- 'bar-id)))
-
-;;; erc-scenarios-base-netid-bouncer-recon-both.el ends here
+++ /dev/null
-;;; erc-scenarios-base-netid-bouncer-recon-id.el --- recon ID scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(ert-deftest erc-scenarios-base-netid-bouncer--reconnect-id-foo ()
- :tags '(:expensive-test)
- (let ((erc-server-reconnect-function #'erc-server-delayed-reconnect))
- (erc-scenarios-common--base-network-id-bouncer--reconnect 'foo-id nil)))
-
-(ert-deftest erc-scenarios-base-netid-bouncer--reconnect-id-bar ()
- :tags '(:expensive-test)
- (let ((erc-server-reconnect-function #'erc-server-delayed-reconnect))
- (erc-scenarios-common--base-network-id-bouncer--reconnect nil 'bar-id)))
-
-
-;;; erc-scenarios-base-netid-bouncer-recon-id.el ends here
+++ /dev/null
-;;; erc-scenarios-base-netid-bouncer.el --- net-id bouncer scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(ert-deftest erc-scenarios-base-netid-bouncer--base ()
- :tags '(:expensive-test)
- (erc-scenarios-common--base-network-id-bouncer () 'foonet 'barnet))
-
-(ert-deftest erc-scenarios-base-netid-bouncer--both ()
- :tags '(:expensive-test)
- (erc-scenarios-common--base-network-id-bouncer '(:foo-id t :bar-id t)
- 'foonet 'barnet))
-
-;;; erc-scenarios-base-netid-bouncer.el ends here
+++ /dev/null
-;;; erc-scenarios-base-netid-samenet.el --- One-network net-ID scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(eval-when-compile (require 'erc-join))
-
-(cl-defun erc-scenarios-common--base-network-id-same-network
- ((&key nick id server chan
- &aux (nick-a nick) (id-a id) (serv-buf-a server) (chan-buf-a chan))
- (&key nick id server chan
- &aux (nick-b nick) (id-b id) (serv-buf-b server) (chan-buf-b chan)))
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/netid/samenet")
- (dumb-server (erc-d-run "localhost" t 'tester 'chester))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- (erc-server-flood-penalty 0.1)
- (erc-server-flood-margin 30)
- erc-serv-buf-a erc-serv-buf-b)
-
- (when (and id-a (zerop (random 2))) (setq id-a (symbol-name id-a)))
- (when (and id-b (zerop (random 2))) (setq id-b (symbol-name id-b)))
-
- (ert-info ("Connect to foonet with nick tester")
- (with-current-buffer
- (setq erc-serv-buf-a (erc :server "127.0.0.1"
- :port port
- :nick nick-a
- :password "changeme"
- :full-name nick-a
- :id id-a))
- (erc-scenarios-common-assert-initial-buf-name id-a port)
- (erc-d-t-wait-for 5 (eq erc-network 'foonet))))
-
- (ert-info ("Connect to foonet with nick chester")
- (with-current-buffer
- (setq erc-serv-buf-b (erc :server "127.0.0.1"
- :port port
- :nick nick-b
- :password "changeme"
- :full-name nick-b
- :id id-b))
- (erc-scenarios-common-assert-initial-buf-name id-b port)))
-
- (erc-d-t-wait-for 3 (not (erc-scenarios-common-buflist "127.0.0.1")))
-
- (with-current-buffer erc-serv-buf-a
- (should (string= (buffer-name) serv-buf-a))
- (funcall expect 8 "debug mode")
- (erc-cmd-JOIN "#chan"))
-
- (with-current-buffer erc-serv-buf-b
- (should (string= (buffer-name) serv-buf-b))
- (funcall expect 8 "debug mode")
- (erc-cmd-JOIN "#chan"))
-
- (erc-d-t-wait-for 10 (get-buffer chan-buf-a))
- (erc-d-t-wait-for 10 (get-buffer chan-buf-b))
-
- (ert-info ("Greets other nick in same channel")
- (with-current-buffer chan-buf-a
- (funcall expect 5 "chester")
- (funcall expect 5 "find the forester")
- (erc-cmd-MSG "#chan chester: hi")))
-
- (ert-info ("Sees other nick in same channel")
- (with-current-buffer chan-buf-b
- (funcall expect 5 "tester")
- (funcall expect 10 "<tester> chester: hi")
- (funcall expect 5 "This was lofty")
- (erc-cmd-MSG "#chan hi tester")))
-
- (with-current-buffer chan-buf-a
- (funcall expect 5 "To employ you towards")
- (erc-cmd-QUIT ""))
-
- (with-current-buffer chan-buf-b
- (funcall expect 5 "To employ you towards")
- (erc-cmd-QUIT ""))))
-
-(ert-deftest erc-scenarios-base-network-id-same-network--two-ids ()
- :tags '(:expensive-test)
- (erc-scenarios-common--base-network-id-same-network
- (list :nick "tester"
- :id 'tester/foonet
- :server "tester/foonet"
- :chan "#chan@tester/foonet")
- (list :nick "chester"
- :id 'chester/foonet
- :server "chester/foonet"
- :chan "#chan@chester/foonet")))
-
-(ert-deftest erc-scenarios-base-network-id-same-network--one-id-tester ()
- :tags '(:expensive-test)
- (erc-scenarios-common--base-network-id-same-network
- (list :nick "tester"
- :id 'tester/foonet
- :server "tester/foonet"
- :chan "#chan@tester/foonet")
- (list :nick "chester"
- :id nil
- :server "foonet"
- :chan "#chan@foonet")))
-
-(ert-deftest erc-scenarios-base-network-id-same-network--one-id-chester ()
- :tags '(:expensive-test)
- (erc-scenarios-common--base-network-id-same-network
- (list :nick "tester"
- :id nil
- :server "foonet"
- :chan "#chan@foonet")
- (list :nick "chester"
- :id 'chester/foonet
- :server "chester/foonet"
- :chan "#chan@chester/foonet")))
-
-(ert-deftest erc-scenarios-base-network-id-same-network--no-ids ()
- :tags '(:expensive-test)
- (erc-scenarios-common--base-network-id-same-network
- (list :nick "tester"
- :id nil
- :server "foonet/tester"
- :chan "#chan@foonet/tester") ; <- note net before nick
- (list :nick "chester"
- :id nil
- :server "foonet/chester"
- :chan "#chan@foonet/chester")))
-
-;;; erc-scenarios-base-netid-samenet.el ends here
+++ /dev/null
-;;; erc-scenarios-base-query-participants.el --- Query user tables -*- lexical-binding: t -*-
-
-;; Copyright (C) 2024-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(ert-deftest erc-scenarios-base-query-participants/legacy ()
- :tags '(:expensive-test)
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/query-participants")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'legacy))
- (expect (erc-d-t-make-expecter))
- (erc--decouple-query-and-channel-membership-p t)
- (port (process-contact dumb-server :service)))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :full-name "tester")
- (funcall expect 10 "This server is in debug mode")
- (erc-scenarios-common-say "/query bob")))
-
- (ert-info ("Opening query on untracked user bob doesn't create entry.")
- (with-current-buffer "bob"
- (should-not (erc-get-channel-member "bob"))))
-
- (ert-info ("DM from untracked user creates a query entry.")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "dummy"))
- (funcall expect 10 "<dummy> hi")
- (should (erc-get-channel-member "dummy"))
- (should (erc-get-server-user "dummy"))))
-
- (with-current-buffer "foonet"
- (erc-scenarios-common-say "/join #chan"))
-
- (ert-info ("Members in new chan not added to existing query buffers")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 10 "bob ")) ; some user bob is present in #chan
- (with-current-buffer "bob"
- (should-not (erc-get-channel-member "bob"))))
-
- (ert-info ("Opening query on tracked user doesn't create entry")
- ;; And DM'ing them makes no difference.
- (with-current-buffer "#chan"
- (funcall expect 10 " alice") ;; some user alice is present
- (erc-scenarios-common-say "hi channel")
- (funcall expect 10 "<tester> hi channel")
- (erc-scenarios-common-say "/query alice"))
- (with-current-buffer "alice"
- (should-not (erc-get-channel-member "alice"))))
-
- (ert-info ("DM from a tracked user creates entry in preexisting buffer")
- (with-current-buffer "bob"
- (funcall expect 10 "<bob> hi")
- (should (erc-get-channel-member "bob"))))
-
- (ert-info ("Query pal parting channel doesn't remove them from query")
- ;; Identical result if they're kicked: they're removed from the
- ;; server if they have no target buffers remaining, which can't
- ;; be true if a query with them remains.
- (with-current-buffer "#chan"
- (funcall expect 10 "has left")
- (should-not (erc-get-channel-member "dummy"))
- (should (erc-get-server-user "dummy")))
- (with-current-buffer "dummy"
- (should (erc-get-channel-member "dummy"))))
-
- (ert-info ("Query pal quitting channel removes them everywhere")
- (with-current-buffer "#chan"
- (funcall expect 10 "has quit")
- (should-not (erc-get-channel-member "bob"))
- (should-not (erc-get-server-user "bob")))
- (with-current-buffer "bob"
- (should-not (erc-get-channel-member "bob"))))
-
- (ert-info ("Query pal re-joining doesn't repopulate query")
- (with-current-buffer "#chan"
- (erc-scenarios-common-say "bob gone")
- (funcall expect 10 "<alice> bob, welcome back!")
- (should (erc-get-server-user "bob")))
- (with-current-buffer "bob"
- (should-not (erc-get-channel-member "bob"))))
-
- (ert-info ("Parting removes chan members from server unless in some query")
- (with-current-buffer "#chan"
- (erc-scenarios-common-say "/part")
- (funcall expect 10 "you have left")
- (should-not (erc-get-server-user "fsbot"))
- (should-not (erc-get-server-user "alice")) ; she never said anything
- (should-not (erc-get-server-user "bob")) ; missing from query
- (should (erc-get-server-user "dummy"))))))
-
-(ert-deftest erc-scenarios-base-query-participants/coupled ()
- :tags '(:expensive-test)
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/query-participants")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'legacy))
- (expect (erc-d-t-make-expecter))
- (port (process-contact dumb-server :service)))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :full-name "tester")
- (funcall expect 10 "This server is in debug mode")
- (erc-scenarios-common-say "/query bob")))
-
- (ert-info ("Opening query on untracked user bob doesn't create entry.")
- (with-current-buffer "bob"
- (should-not (erc-get-channel-member "bob"))))
-
- (ert-info ("DM from untracked user also doesn't create a query entry.")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "dummy"))
- (funcall expect 10 "<dummy> hi")
- (should-not (erc-get-channel-member "dummy"))
- (should-not (erc-get-server-user "dummy"))))
-
- (with-current-buffer "foonet"
- (erc-scenarios-common-say "/join #chan"))
-
- (ert-info ("Members in new chan added to existing query buffers")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 10 "bob ")) ; bob is present in #chan (353)
- (with-current-buffer "bob"
- (should (erc-get-server-user "bob"))
- ;; Can't assert immediately: must wait until 366 arrives.
- (erc-d-t-wait-for 10 (erc-get-channel-member "bob"))))
-
- (ert-info ("Opening query on tracked user creates entry")
- (with-current-buffer "#chan"
- (funcall expect 10 " alice") ;; alice is present
- (erc-scenarios-common-say "hi channel") ; gate
- (funcall expect 10 "<tester> hi channel")
- (erc-scenarios-common-say "/query alice"))
- (with-current-buffer "alice"
- (should (erc-get-channel-member "alice"))))
-
- ;; Bob says something.
- (with-current-buffer "bob"
- (funcall expect 10 "<bob> hi")
- (should (erc-get-channel-member "bob")))
-
- (ert-info ("Query pal parting channel removes them from query")
- ;; Identical result if they're kicked: they're removed from the
- ;; server AND their target buffers
- (with-current-buffer "#chan"
- (funcall expect 10 "has left")
- (should-not (erc-get-channel-member "dummy"))
- (should-not (erc-get-server-user "dummy")))
- (with-current-buffer "dummy"
- (should-not (erc-get-channel-member "dummy"))))
-
- ;; This is unchanged from legacy behavior.
- (ert-info ("Query pal quitting channel removes them everywhere")
- (with-current-buffer "#chan"
- (funcall expect 10 "has quit")
- (should-not (erc-get-channel-member "bob"))
- (should-not (erc-get-server-user "bob")))
- (with-current-buffer "bob"
- (should-not (erc-get-channel-member "bob"))))
-
- (ert-info ("Query pal re-joining repopulates query")
- (with-current-buffer "#chan"
- (erc-scenarios-common-say "bob gone")
- (funcall expect 10 "<alice> bob, welcome back!")
- (should (erc-get-server-user "bob")))
- (with-current-buffer "bob"
- (should (erc-get-channel-member "bob"))))
-
- (ert-info ("Parting removes chan members from server and queries")
- (with-current-buffer "#chan"
- (erc-scenarios-common-say "/part")
- (funcall expect 10 "you have left")
- (should-not (erc-get-server-user "fsbot"))
- (should-not (erc-get-server-user "alice")) ; she never said anything
- (should-not (erc-get-server-user "bob")) ; missing from query
- (should-not (erc-get-server-user "dummy"))))))
-
-
-;;; erc-scenarios-base-query-participants.el ends here
+++ /dev/null
-;;; erc-scenarios-base-reconnect.el --- Base-reconnect scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(eval-when-compile (require 'erc-join))
-
-;; This ensures we only reconnect `erc-server-reconnect-attempts'
-;; (rather than infinitely many) times, which can easily happen when
-;; tweaking code related to process sentinels in erc-backend.el.
-
-(ert-deftest erc-scenarios-base-reconnect-timer ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/reconnect")
- (dumb-server (erc-d-run "localhost" t 'timer 'timer 'timer-last))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- (erc-server-reconnect-function #'erc-server-delayed-reconnect)
- (erc-server-auto-reconnect t)
- erc-autojoin-channels-alist
- erc-server-buffer)
-
- (ert-info ("Connect to foonet")
- (setq erc-server-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "changeme"
- :full-name "tester"))
- (with-current-buffer erc-server-buffer
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (ert-info ("Server tries to connect thrice (including initial attempt)")
- (with-current-buffer erc-server-buffer
- (dotimes (n 3)
- (ert-info ((format "Attempt %d" n))
- (funcall expect 3 "Opening connection")
- (funcall expect 2 "Password incorrect")
- (funcall expect 2 "Connection failed!")
- (funcall expect 2 "Re-establishing connection")))
- (ert-info ("Prev attempt was final")
- (erc-d-t-absent-for 1 "Opening connection" (point)))))
-
- (ert-info ("Server buffer is unique and temp name is absent")
- (should (equal (list (get-buffer (format "127.0.0.1:%d" port)))
- (erc-scenarios-common-buflist "127.0.0.1"))))))
-
-;; Upon reconnecting, playback for channel and target buffers is
-;; routed correctly. Autojoin is irrelevant here, but for the
-;; skeptical, see `erc-scenarios-common--join-network-id', which
-;; overlaps with this and includes spurious JOINs ignored by the
-;; server.
-
-(ert-deftest erc-scenarios-base-association-reconnect-playback ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/assoc/reconplay")
- (erc-server-flood-penalty 0.1)
- (erc-server-flood-margin 30)
- (dumb-server (erc-d-run "localhost" t 'foonet 'again))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- erc-autojoin-channels-alist
- erc-server-buffer-foo)
-
- (ert-info ("Connect to foonet")
- (setq erc-server-buffer-foo (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "changeme"
- :full-name "tester"))
- (with-current-buffer erc-server-buffer-foo
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (ert-info ("Setup")
-
- (ert-info ("Server buffer is unique and temp name is absent")
- (erc-d-t-wait-for 3 (get-buffer "foonet"))
- (should-not (erc-scenarios-common-buflist "127.0.0.1")))
-
- (ert-info ("Channel buffer #chan playback received")
- (with-current-buffer (erc-d-t-wait-for 8 (get-buffer "#chan"))
- (funcall expect 10 "But purgatory")))
-
- (ert-info ("Ask for help from services or bouncer bot")
- (with-current-buffer erc-server-buffer-foo
- (erc-cmd-MSG "*status help")))
-
- (ert-info ("Help received")
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "*status"))
- (funcall expect 10 "Rehash")))
-
- (ert-info ("#chan convo done")
- (with-current-buffer "#chan"
- (funcall expect 10 "most egregious indignity"))))
-
- ;; KLUDGE (see note above test)
- (should erc-autojoin-channels-alist)
- (setq erc-autojoin-channels-alist nil)
-
- (with-current-buffer erc-server-buffer-foo
- (erc-cmd-QUIT "")
- (erc-d-t-wait-for 4 (not (erc-server-process-alive)))
- (erc-cmd-RECONNECT))
-
- (ert-info ("Channel buffer found and associated")
- (with-current-buffer "#chan"
- (funcall expect 10 "Wilt thou rest damned")))
-
- (ert-info ("Help buffer found and associated")
- (with-current-buffer "*status"
- (erc-scenarios-common-say "help")
- (funcall expect 10 "Restart ZNC")))
-
- (ert-info ("#chan convo done")
- (with-current-buffer "#chan"
- (funcall expect 10 "here comes the lady")))))
-
-
-(ert-deftest erc-scenarios-base-cancel-reconnect ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/reconnect")
- (dumb-server (erc-d-run "localhost" t 'timer 'timer 'timer-last))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- (erc-server-reconnect-function #'erc-server-delayed-reconnect)
- (erc-server-auto-reconnect t)
- erc-autojoin-channels-alist
- erc-server-buffer)
-
- (ert-info ("Connect to foonet")
- (setq erc-server-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "changeme"
- :full-name "tester"))
- (with-current-buffer erc-server-buffer
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (ert-info ("Two connection attempts, all stymied")
- (with-current-buffer erc-server-buffer
- (ert-info ("First two attempts behave normally")
- (dotimes (n 2)
- (ert-info ((format "Initial attempt %d" (1+ n)))
- (funcall expect 3 "Opening connection")
- (funcall expect 2 "Password incorrect")
- (funcall expect 2 "Connection failed!")
- (funcall expect 2 "Re-establishing connection"))))
- (ert-info ("/RECONNECT cancels timer but still attempts to connect")
- (erc-cmd-RECONNECT)
- (funcall expect 2 "Canceled")
- (funcall expect 3 "Opening connection")
- (funcall expect 2 "Password incorrect")
- (funcall expect 10 "Connection failed!")
- (funcall expect 2 "Re-establishing connection"))
- (ert-info ("Explicitly cancel timer")
- (erc-cmd-RECONNECT "cancel")
- (funcall expect 2 "Canceled")
- (erc-d-t-absent-for 1 "Opening connection" (point)))))
-
- (ert-info ("Server buffer is unique and temp name is absent")
- (should (equal (list (get-buffer (format "127.0.0.1:%d" port)))
- (erc-scenarios-common-buflist "127.0.0.1"))))))
-
-;;; erc-scenarios-base-reconnect.el ends here
+++ /dev/null
-;;; erc-scenarios-base-renick.el --- Re-nicking scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(eval-when-compile (require 'erc-join))
-
-;; The server changes your nick just after registration.
-
-(ert-deftest erc-scenarios-base-renick-self-auto ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/renick/self")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'auto))
- (port (process-contact dumb-server :service))
- erc-autojoin-channels-alist
- erc-server-buffer-foo)
-
- (ert-info ("Connect to foonet")
- (setq erc-server-buffer-foo (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester"))
- (with-current-buffer erc-server-buffer-foo
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "foonet"))
- (erc-d-t-search-for 10 "Your new nickname is dummy"))
-
- (ert-info ("Joined by bouncer to #foo, own nick present")
- (with-current-buffer (erc-d-t-wait-for 1 (get-buffer "#foo"))
- (erc-d-t-search-for 10 "dummy")
- (erc-d-t-search-for 10 "On Thursday")))))
-
-;; You change your nickname manually in a server buffer; a message is
-;; printed in channel buffers.
-
-(ert-deftest erc-scenarios-base-renick-self-manual ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/renick/self")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'manual))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- erc-autojoin-channels-alist
- erc-server-buffer-foo)
-
- (ert-info ("Connect to foonet")
- (setq erc-server-buffer-foo (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester"))
- (with-current-buffer erc-server-buffer-foo
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (erc-d-t-wait-for 3 (get-buffer "foonet"))
-
- (ert-info ("Joined by bouncer to #foo, own nick present")
- (with-current-buffer (erc-d-t-wait-for 1 (get-buffer "#foo"))
- (funcall expect 5 "tester")
- (funcall expect 5 "On Thursday")
- (erc-with-server-buffer (erc-cmd-NICK "dummy"))
- (funcall expect 5 "Your new nickname is dummy")
- (funcall expect 5 "<bob> dummy: Hi")
- ;; Regression in which changing a nick would trigger #foo@foonet
- (erc-d-t-ensure-for 0.4 (equal (buffer-name) "#foo"))))))
-
-;; You connect to the same network with two different nicks. You
-;; manually change the first nick at some point, and buffer names are
-;; updated correctly.
-
-(ert-deftest erc-scenarios-base-renick-self-qualified ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/renick/self")
- (dumb-server (erc-d-run "localhost" t 'qual-tester 'qual-chester))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- (erc-server-flood-penalty 0.1)
- (erc-server-flood-margin 30)
- erc-serv-buf-a erc-serv-buf-b)
-
- (ert-info ("Connect to foonet with nick tester")
- (with-current-buffer
- (setq erc-serv-buf-a (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "changeme"
- :full-name "tester"))
- (erc-d-t-wait-for 5 (eq erc-network 'foonet))))
-
- (ert-info ("Connect to foonet with nick chester")
- (with-current-buffer
- (setq erc-serv-buf-b (erc :server "127.0.0.1"
- :port port
- :nick "chester"
- :password "changeme"
- :full-name "chester"))))
-
- (erc-d-t-wait-for 3 "Dialed Buflist is Empty"
- (not (erc-scenarios-common-buflist "127.0.0.1")))
-
- (with-current-buffer "foonet/tester"
- (funcall expect 3 "debug mode")
- (erc-cmd-JOIN "#chan"))
-
- (with-current-buffer "foonet/chester"
- (funcall expect 3 "debug mode")
- (erc-cmd-JOIN "#chan"))
-
- (erc-d-t-wait-for 10 (get-buffer "#chan@foonet/tester"))
- (erc-d-t-wait-for 10 (get-buffer "#chan@foonet/chester"))
-
- (ert-info ("Greets other nick in same channel")
- (with-current-buffer "#chan@foonet/tester"
- (funcall expect 5 "<bob> chester, welcome!")
- (erc-cmd-NICK "dummy")
- (funcall expect 5 "Your new nickname is dummy")
- (funcall expect 5 "find the forester")
- (erc-d-t-wait-for 5 (string= (buffer-name) "#chan@foonet/dummy"))))
-
- (ert-info ("Renick propagated throughout all buffers of process")
- (should-not (get-buffer "#chan@foonet/tester"))
- (should-not (get-buffer "foonet/tester"))
- (should (get-buffer "foonet/dummy")))))
-
-;; When a channel user changes their nick, any query buffers for them
-;; are updated.
-
-(ert-deftest erc-scenarios-base-renick-queries-solo ()
- :tags '(:expensive-test)
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/renick/queries")
- (erc-server-flood-penalty 0.1)
- (erc-server-flood-margin 20)
- (dumb-server (erc-d-run "localhost" t 'solo))
- (expect (erc-d-t-make-expecter))
- (port (process-contact dumb-server :service))
- erc-autojoin-channels-alist
- erc-server-buffer-foo)
-
- (ert-info ("Connect to foonet")
- (setq erc-server-buffer-foo (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester"))
- (with-current-buffer erc-server-buffer-foo
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (erc-d-t-wait-for 10 (get-buffer "foonet"))
-
- (ert-info ("Joined by bouncer to #foo, pal Lal is present")
- (with-current-buffer (erc-d-t-wait-for 1 (get-buffer "#foo"))
- (funcall expect 10 "<bob> alice: On Thursday")
- (erc-scenarios-common-say "hi")))
-
- (ert-info ("Query buffer appears from Lal, who renicks")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "Lal"))
- (funcall expect 10 "<Lal> hello")
- (erc-scenarios-common-say "hi")
- (should-not (erc-get-channel-member "tester"))
- (funcall expect 10 "is now known as Linguo")
- ;; No duplicate message.
- (funcall expect -0.1 "is now known as Linguo")
- ;; No duplicate buffer.
- (erc-d-t-wait-for 1 (equal (buffer-name) "Linguo"))
- (should-not (get-buffer "Lal"))
- ;; Channel member has been updated
- (should-not (erc-get-channel-member "Lal"))
- (should-not (erc-get-server-user "Lal"))
- (should (erc-get-channel-member "Linguo"))
- (erc-scenarios-common-say "howdy Linguo")))
-
- (with-current-buffer "#foo"
- (funcall expect 10 "is now known as Linguo")
- (funcall expect -0.1 "is now known as Linguo")
- (funcall expect 10 "has left"))
-
- ;; User parting a common channel removes them from queries.
- (with-current-buffer "Linguo"
- (should-not (erc-get-channel-member "tester"))
- (erc-d-t-wait-for 10 (null (erc-get-channel-member "Linguo")))
- (should-not (erc-get-server-user "Linguo")))
-
- ;; Leaving the client's only channel doesn't remove its user data
- ;; from the server table (see below, after "get along ...").
- (with-current-buffer "#foo"
- (erc-scenarios-common-say "/part"))
-
- ;; Server and "channel" user are *not* (re)created upon receiving
- ;; a direct message for a user we already have an open query with
- ;; but with whom we no longer share a channel.
- (with-current-buffer "Linguo"
- (funcall expect 10 "get along")
- (should-not (erc-get-channel-member "Linguo"))
- (should-not (erc-get-channel-member "tester"))
- (should (erc-get-server-user "tester")))))
-
-;; Someone you have a query with disconnects and reconnects under a
-;; new nick (perhaps due to their client appending a backtick or
-;; underscore). They then engage you in another query before
-;; renicking to their original nick. Prior to 5.5, ERC would add a
-;; uniquifying suffix of the form bob<2> to the new, post-renick
-;; query. ERC 5.6+ acts differently. It mimics popular standalone
-;; clients in reusing existing query buffers.
-(ert-deftest erc-scenarios-base-renick-queries/reassume ()
- :tags '(:expensive-test)
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/renick/queries")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'reassume))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- (erc-autojoin-channels-alist '((foonet "#chan"))))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester")
- (funcall expect 10 "This server is in debug mode")))
-
- (ert-info ("User dummy opens a query with you")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "dummy"))
- (funcall expect 10 "hi")))
-
- (ert-info ("User dummy quits, reconnects as user warwick")
- (with-current-buffer "#chan"
- (funcall expect 10 "has quit")
- (should-not (erc-get-channel-member "dummy"))
- (with-current-buffer "dummy"
- (should-not (erc-get-channel-member "dummy")))
- (funcall expect 10 "<bob> Alas! sir")
- (funcall expect 10 "<bob> warwick, welcome")
- (funcall expect 10 "<warwick> hola")))
-
- (ert-info ("User warwick queries you, creating a new buffer")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "warwick"))
- (should (get-buffer "dummy")) ; not reused
- (funcall expect 10 "<warwick> howdy")
- (funcall expect 10 "is now known as dummy")
- (should-not (erc-get-channel-member "warwick"))
- (should-not (erc-get-channel-member "dummy"))))
-
- (ert-info ("User warwick renicks as user dummy")
- (with-current-buffer "#chan"
- (funcall expect 10 "is now known as dummy")
- (should-not (erc-get-channel-member "warwick"))))
-
- (with-current-buffer "dummy"
- (should-not (get-buffer "dummy<2>"))
- (funcall expect 10 "has quit" (point-min))
- (funcall expect -0.1 "merging buffer")
- (funcall expect 10 "is now known as dummy")
- (should (erc-get-channel-member "dummy"))
- (funcall expect 10 "<dummy> hey"))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "<alice> bob: Than those that"))))
-
-;; This test asserts behavior for the other side of the conversation
-;; described by `erc-scenarios-base-renick-queries/reassume' above.
-;; After speaking with someone in a query, you disconnect and
-;; reconnect under a new nick. You then open a new query with the
-;; same person before changing your nick back to the previous one.
-;; The buffers for the two session should then be merged with the help
-;; of `erc-networks--transplant-target-buffer-function' and
-;; `erc-networks--copy-server-buffer-functions'.
-(ert-deftest erc-scenarios-base-renick-self/merge-query ()
- :tags '(:expensive-test)
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/renick/self")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'merge-query-a 'merge-query-b))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- (erc-autojoin-channels-alist '((foonet "#chan"))))
-
- (ert-info ("Connect to foonet as tester")
- (with-current-buffer (erc :server "127.0.0.1" :port port :nick "tester")
- (funcall expect 10 "This server is in debug mode")))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 10 "<alice> bob: Speak to the people")
- (erc-scenarios-common-say "/query observer"))
-
- (with-current-buffer "observer"
- (erc-scenarios-common-say "hi")
- (funcall expect 10 "<observer> hi?"))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (erc-scenarios-common-say "/quit"))
-
- (with-current-buffer "foonet"
- (funcall expect 10 "*** ERC finished ***"))
-
- (ert-info ("Reconnect to foonet as dummy")
- (with-current-buffer (erc :server "127.0.0.1" :port port :nick "dummy")
- (funcall expect 10 "This server is in debug mode")))
-
- (with-current-buffer
- (erc-d-t-wait-for 10 (get-buffer "#chan@foonet/dummy"))
- ;; Uniquification has been performed.
- (should-not (get-buffer "#chan"))
- (should (get-buffer "#chan@foonet/tester"))
- (should-not (get-buffer "foonet"))
- (should (get-buffer "foonet/tester"))
- (should (get-buffer "foonet/dummy"))
- (funcall expect 10 "<alice> bob: Pray you")
- (erc-scenarios-common-say "/query observer"))
-
- (with-current-buffer "observer@foonet/dummy"
- (should-not (get-buffer "observer"))
- (should (get-buffer "observer@foonet/tester"))
- (erc-scenarios-common-say "hola")
- (funcall expect 10 "<observer> whodis?"))
-
- (with-current-buffer
- (erc-d-t-wait-for 10 (get-buffer "#chan@foonet/dummy"))
- (erc-scenarios-common-say "/nick tester"))
-
- ;; All buffers have been merged.
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "observer"))
- (should-not (get-buffer "observer@foonet/dummy"))
- (should-not (get-buffer "observer@foonet/tester"))
- ;; Goto last message from previous session. Notice that the
- ;; quit message appears in all buffers, including queries.
- (funcall expect 10 "has quit" (point-min))
- (funcall expect -0.01 "\n\n[") ; duplicate date stamp removed
- (funcall expect 1 (concat "*** Grafting buffer `observer@foonet/dummy'"
- " onto `observer@foonet/tester'"))
- (funcall expect 1 "<dummy> hola")
- (funcall expect 1 "<observer> whodis?")
- ;; The nickname change is announced in the query as well so that
- ;; the nature of the merge is clear.
- (funcall expect 1 "*** Your new nickname is tester"))
-
- (with-current-buffer "foonet"
- (should-not (get-buffer "foonet/dummy"))
- (should-not (get-buffer "foonet/tester"))
- ;; Goto last assertion.
- (funcall expect 10 "*** ERC finished ***" (point-min))
- (funcall expect -0.01 "\n\n[") ; duplicate date stamp removed
- (funcall expect 5 "Grafting buffer `foonet/dummy' onto `foonet/tester'"))
-
- (with-current-buffer "#chan"
- (should-not (get-buffer "#chan@foonet/dummy"))
- (should-not (get-buffer "#chan@foonet/tester"))
- (funcall expect 10 "has quit" (point-min))
- (funcall expect -0.01 "\n\n[") ; duplicate date stamp removed
- (funcall expect 1 (concat "*** Grafting buffer `#chan@foonet/dummy'"
- " onto `#chan@foonet/tester'"))
- (funcall expect 1 "You have joined channel #chan")
- (funcall expect 1 "<bob> alice: Have here bereft")
- (funcall expect 1 "*** Your new nickname is tester"))))
-
-;; You share a channel and a query buffer with a user on two different
-;; networks (through a proxy). The user changes their nick on both
-;; networks at the same time. Query buffers are updated accordingly.
-
-(ert-deftest erc-scenarios-base-renick-queries-bouncer ()
- :tags '(:expensive-test)
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/renick/queries")
- (erc-server-flood-penalty 0.1)
- (erc-server-flood-margin 30)
- (dumb-server (erc-d-run "localhost" t 'bouncer-foonet 'bouncer-barnet))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- erc-accidental-paste-threshold-seconds
- erc-autojoin-channels-alist
- erc-server-buffer-foo
- erc-server-buffer-bar)
-
- (ert-info ("Connect to foonet")
- (setq erc-server-buffer-foo (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester"))
- (with-current-buffer erc-server-buffer-foo
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (erc-d-t-wait-for 5 (get-buffer "foonet"))
-
- (ert-info ("Connect to barnet")
- (setq erc-server-buffer-bar (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "barnet:changeme"
- :full-name "tester"))
- (with-current-buffer erc-server-buffer-bar
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (erc-d-t-wait-for 5 (get-buffer "barnet"))
- (should-not (erc-scenarios-common-buflist "127.0.0.1"))
-
- (ert-info ("Joined by bouncer to #chan@foonet, pal persent")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan@foonet"))
- (funcall expect 1 "rando")
- (funcall expect 1 "simply misused")))
-
- (ert-info ("Joined by bouncer to #chan@barnet, pal persent")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan@barnet"))
- (funcall expect 1 "rando")
- (funcall expect 5 "come, sir, I am")))
-
- (ert-info ("Query buffer exists for rando@foonet")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "rando@foonet"))
- (funcall expect 1 "guess not")
- (erc-scenarios-common-say "I here")))
-
- (ert-info ("Query buffer exists for rando@barnet")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "rando@barnet"))
- (funcall expect 2 "rentacop")
- (erc-scenarios-common-say "Linda said you were gonna kill me.")))
-
- (ert-info ("Sync convo for rando@foonet")
- (with-current-buffer "rando@foonet"
- (funcall expect 10 "u are dumb")
- (erc-scenarios-common-say "not so")))
-
- (ert-info ("Sync convo for rando@barnet")
- (with-current-buffer "rando@barnet"
- (funcall expect 3 "I never saw her before")
- (erc-scenarios-common-say "You aren't with Wage?")))
-
- (erc-d-t-wait-for 10 (get-buffer "frenemy@foonet"))
- (erc-d-t-wait-for 10 (get-buffer "frenemy@barnet"))
- (should-not (get-buffer "rando@foonet"))
- (should-not (get-buffer "rando@barnet"))
-
- (with-current-buffer "frenemy@foonet"
- (funcall expect 10 "now known as")
- (funcall expect 10 "doubly so"))
-
- (with-current-buffer "frenemy@barnet"
- (funcall expect 10 "now known as")
- (funcall expect 10 "reality picture"))
-
- (when noninteractive
- (with-current-buffer "frenemy@barnet" (kill-buffer))
- (erc-d-t-wait-for 2 (get-buffer "frenemy"))
- (should-not (get-buffer "frenemy@foonet")))
-
- (with-current-buffer "#chan@foonet"
- (funcall expect 10 "is now known as frenemy")
- (should-not (search-forward "now known as frenemy" nil t)) ; regression
- (funcall expect 10 "words are razors"))
-
- (with-current-buffer "#chan@barnet"
- (funcall expect 10 "is now known as frenemy")
- (should-not (search-forward "now known as frenemy" nil t))
- (erc-d-t-search-for 25 "I have lost"))))
-
-;;; erc-scenarios-base-renick.el ends here
+++ /dev/null
-;;; erc-scenarios-base-reuse-buffers.el --- base-reuse-buffers scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(eval-when-compile (require 'erc-join))
-
-(defun erc-scenarios-common--base-reuse-buffers-server-buffers (&optional more)
- "Show that `erc-reuse-buffers' doesn't affect server buffers.
-Overlaps some with `clash-of-chans/uniquify'. Adapted from
-rebuffed/reuseless, described in Bug#48598: 28.0.50; buffer-naming
-collisions involving bouncers in ERC. Run EXTRA."
- (erc-scenarios-common-with-cleanup
- ((dumb-server (erc-d-run "localhost" t 'foonet 'barnet))
- (port (process-contact dumb-server :service))
- erc-autojoin-channels-alist)
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester")
- (should (string= (buffer-name)
- (format "127.0.0.1:%d/127.0.0.1" port)))
- (erc-d-t-search-for 12 "marked as being away")))
-
- (ert-info ("Connect to barnet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "barnet:changeme"
- :full-name "tester")
- (should (string= (buffer-name)
- (format "127.0.0.1:%d/127.0.0.1<2>" port)))
- (erc-d-t-search-for 45 "marked as being away")))
-
- (erc-d-t-wait-for 2 (get-buffer (format "127.0.0.1:%d/127.0.0.1" port)))
- (erc-d-t-wait-for 2 (get-buffer (format "127.0.0.1:%d/127.0.0.1<2>" port)))
-
- (ert-info ("Server buffers are unique, no IP-based names")
- (should (cdr (erc-scenarios-common-buflist "127.0.0.1"))))
- (when more (funcall more port))))
-
-;; FIXME no sense in running this twice (JOIN variant includes this)
-(ert-deftest erc-scenarios-base-reuse-buffers-server-buffers--disabled ()
- :tags '(:expensive-test)
- (with-suppressed-warnings ((obsolete erc-reuse-buffers))
- (should erc-reuse-buffers)
- (let ((erc-scenarios-common-dialog "base/reuse-buffers/server")
- erc-reuse-buffers)
- (erc-scenarios-common--base-reuse-buffers-server-buffers nil))))
-
-;; This also asserts that `erc-cmd-JOIN' is no longer susceptible to a
-;; regression introduced in 28.1 (ERC 5.4) that caused phantom target
-;; buffers of the form target/server to be created via
-;; `switch-to-buffer' ("phantom" because they would go unused"). This
-;; would happen (in place of a JOIN being sent out) when a previously
-;; used (parted) target buffer existed and `erc-reuse-buffers' was
-;; nil.
-;;
-;; Note: All the `erc-get-channel-user' calls have to do with the fact
-;; that `erc-default-target' relies on the ambiguously defined
-;; `erc-default-recipients' (meaning it's overloaded in the sense of
-;; being used both for retrieving a target name and checking if a
-;; channel has been PARTed). While not ideal, `erc-get-channel-user'
-;; can (also) be used to detect the latter.
-
-(defun erc-scenarios-common--base-reuse-buffers-channel-buffers (port)
- "The option `erc-reuse-buffers' is still respected when nil.
-Adapted from scenario clash-of-chans/uniquify described in Bug#48598:
-28.0.50; buffer-naming collisions involving bouncers in ERC."
- (let* ((expect (erc-d-t-make-expecter))
- (server-buffer-foo
- (get-buffer (format "127.0.0.1:%d/127.0.0.1" port)))
- (server-buffer-bar
- (get-buffer (format "127.0.0.1:%d/127.0.0.1<2>" port)))
- (server-process-foo
- (buffer-local-value 'erc-server-process server-buffer-foo))
- (server-process-bar
- (buffer-local-value 'erc-server-process server-buffer-bar)))
-
- (ert-info ("Unique #chan buffers exist")
- (erc-d-t-wait-for 3 (get-buffer "#chan/127.0.0.1<2>"))
- (erc-d-t-wait-for 3 (get-buffer "#chan/127.0.0.1")))
-
- (ert-info ("#chan@foonet is exclusive and not contaminated")
- (with-current-buffer "#chan/127.0.0.1"
- (funcall expect 1 "<bob>")
- (erc-d-t-absent-for 0.1 "<joe>")
- (funcall expect 1 "strength to climb")
- (should (eq erc-server-process server-process-foo))))
-
- (ert-info ("#chan@barnet is exclusive and not contaminated")
- (with-current-buffer "#chan/127.0.0.1<2>"
- (funcall expect 1 "<joe>")
- (erc-d-t-absent-for 0.1 "<bob>")
- (funcall expect 1 "the loudest noise")
- (should (eq erc-server-process server-process-bar))))
-
- (ert-info ("Part #chan@foonet")
- (with-current-buffer "#chan/127.0.0.1"
- (erc-d-t-search-for 1 "shake my sword")
- (erc-cmd-PART "#chan")
- (funcall expect 3 "You have left channel #chan")
- (should-not (erc-get-channel-user (erc-current-nick)))
- (erc-cmd-JOIN "#chan")))
-
- (ert-info ("Part #chan@barnet")
- (with-current-buffer "#chan/127.0.0.1<2>"
- (funcall expect 10 "Arm it in rags")
- (should (erc-get-channel-user (erc-current-nick)))
- (erc-cmd-PART "#chan")
- (funcall expect 3 "You have left channel #chan")
- (should-not (erc-get-channel-user (erc-current-nick)))
- (erc-cmd-JOIN "#chan")))
-
- (erc-d-t-wait-for 3 "New unique target buffer for #chan@foonet created"
- (get-buffer "#chan/127.0.0.1<3>"))
-
- (ert-info ("Activity continues in new, <n>-suffixed #chan@foonet buffer")
- ;; The first /JOIN did not cause the same buffer to be reused.
- (with-current-buffer "#chan/127.0.0.1"
- (should-not (erc-get-channel-user (erc-current-nick))))
- (with-current-buffer "#chan/127.0.0.1<3>"
- (should (erc-get-channel-user (erc-current-nick)))
- (funcall expect 2 "You have joined channel #chan")
- (funcall expect 2 "#chan was created on")
- (funcall expect 2 "<alice>")
- (should (eq erc-server-process server-process-foo))
- (erc-d-t-absent-for 0.2 "<joe>")))
-
- (sit-for 3)
- (erc-d-t-wait-for 5 "New unique target buffer for #chan@barnet created"
- (get-buffer "#chan/127.0.0.1<4>"))
-
- (ert-info ("Activity continues in new, <n>-suffixed #chan@barnet buffer")
- (with-current-buffer "#chan/127.0.0.1<2>"
- (should-not (erc-get-channel-user (erc-current-nick))))
- (with-current-buffer "#chan/127.0.0.1<4>"
- (funcall expect 2 "You have joined channel #chan")
- (funcall expect 1 "Users on #chan: @mike joe tester")
- (funcall expect 2 "<mike>")
- (should (eq erc-server-process server-process-bar))
- (erc-d-t-absent-for 0.2 "<bob>")))
-
- (ert-info ("Two new chans created for a total of four")
- (let* ((bufs (erc-scenarios-common-buflist "#chan"))
- (names (sort (mapcar #'buffer-name bufs) #'string<)))
- (should
- (equal names (mapcar (lambda (f) (concat "#chan/127.0.0.1" f))
- '("" "<2>" "<3>" "<4>"))))))
-
- (ert-info ("All output sent")
- (with-current-buffer "#chan/127.0.0.1<3>"
- (funcall expect 10 "most lively"))
- (with-current-buffer "#chan/127.0.0.1<4>"
- (funcall expect 10 "soul black")))
-
- ;; TODO ensure the exact <N>'s aren't reassigned during killing as
- ;; they are when the option is on.
- (ert-info ("Buffers are exempt from shortening")
- (kill-buffer "#chan/127.0.0.1<4>")
- (kill-buffer "#chan/127.0.0.1<3>")
- (kill-buffer "#chan/127.0.0.1<2>")
- (should-not (get-buffer "#chan"))
- (should (get-buffer "#chan/127.0.0.1")))))
-
-(ert-deftest erc-scenarios-base-reuse-buffers-channel-buffers--disabled ()
- :tags '(:expensive-test)
- (with-suppressed-warnings ((obsolete erc-reuse-buffers))
- (should erc-reuse-buffers)
- (let ((erc-scenarios-common-dialog "base/reuse-buffers/channel")
- (erc-server-flood-penalty 0.1)
- erc-reuse-buffers)
- (erc-scenarios-common--base-reuse-buffers-server-buffers
- #'erc-scenarios-common--base-reuse-buffers-channel-buffers))))
-
-;;; erc-scenarios-base-reuse-buffers.el ends here
+++ /dev/null
-;;; erc-scenarios-base-send-message.el --- `send-message' scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 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)))
-
-;; So-called "noncommands" are those that massage input submitted at
-;; the prompt and send it on behalf of the user.
-
-(ert-deftest erc-scenarios-base-send-message--noncommands ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/send-message")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'noncommands))
- (erc-modules (cons 'fill-wrap erc-modules))
- (erc-autojoin-channels-alist '((foonet "#chan")))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port (process-contact dumb-server :service)
- :nick "tester"
- :full-name "tester")
- (funcall expect 5 "debug mode")))
-
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (ert-info ("Send CTCP ACTION")
- (funcall expect 10 "<bob> alice: For hands, to do Rome")
- (erc-scenarios-common-say "/me sad")
- (funcall expect 10 "* tester sad"))
-
- (ert-info ("Send literal command")
- (funcall expect 10 "<alice> bob: Spotted, detested")
- (erc-scenarios-common-say "/say /me sad")
- (funcall expect 10 "<tester> /me sad"))
-
- (ert-info ("\"Nested\" `noncommands'")
-
- (ert-info ("Send version via /SV")
- (funcall expect 10 "<bob> Marcus, my brother!")
- (erc-scenarios-common-say "/sv")
- (funcall expect 10 "<tester> I'm using ERC"))
-
- (ert-info ("Send module list via /SM")
- (funcall expect 10 "<bob> alice: You still wrangle")
- (erc-scenarios-common-say "/sm")
- (funcall expect 10 "<tester> I'm using the following modules: ")
- (funcall expect 10 "<alice> No, not till Thursday;"))))))
-
-
-;; This asserts that the `command-indicator' module only inserts
-;; prompt-like prefixes for normal slash commands, like /JOIN.
-
-(ert-deftest erc-scenarios-base-send-message--command-indicator ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/send-message")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'noncommands))
- (erc-modules `(command-indicator fill-wrap ,@erc-modules))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port (process-contact dumb-server :service)
- :nick "tester"
- :full-name "tester")
- (funcall expect 5 "debug mode")
- (erc-scenarios-common-say "/join #chan")
- (funcall expect 10 "ERC> /join #chan")))
-
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (ert-info ("Prompt absent for CTCP ACTION")
- (funcall expect 10 "<bob> alice: For hands, to do Rome")
- (erc-scenarios-common-say "/me sad")
- (funcall expect -0.1 "ERC> /me sad")
- (funcall expect 10 "* tester sad"))
-
- (ert-info ("Prompt absent for literal command")
- (funcall expect 10 "<alice> bob: Spotted, detested")
- (erc-scenarios-common-say "/say /me sad")
- (funcall expect -0.1 "ERC> /say /me sad")
- (funcall expect 10 "<tester> /me sad"))
-
- (ert-info ("Prompt absent for /SV")
- (funcall expect 10 "<bob> Marcus, my brother!")
- (erc-scenarios-common-say "/sv")
- (funcall expect -0.1 "ERC> /sv")
- (funcall expect 10 "<tester> I'm using ERC"))
-
- (ert-info ("Prompt absent module list via /SM")
- (funcall expect 10 "<bob> alice: You still wrangle")
- (erc-scenarios-common-say "/sm")
- (funcall expect -0.1 "ERC> /sm")
- (funcall expect 10 "<tester> I'm using the following modules: ")
- (funcall expect 10 "<alice> No, not till Thursday;"))
-
- (ert-info ("Prompt present for /QUIT in issuing buffer")
- (erc-scenarios-common-say "/quit")
- (funcall expect 10 "ERC> /quit"))
-
- (with-current-buffer "foonet"
- (funcall expect 10 "ERC finished")))))
-
-;;; erc-scenarios-base-send-message.el ends here
+++ /dev/null
-;;; erc-scenarios-base-split-line.el --- ERC line splitting -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(ert-deftest erc-scenarios-base-split-line--koi8-r ()
- :tags '(:expensive-test)
- (should (equal erc-split-line-length 440))
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/flood")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'koi8-r))
- (erc-encoding-coding-alist '(("#koi8" . cyrillic-koi8)))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to server")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :full-name "tester")
- (funcall expect 10 "debug mode")
- (erc-cmd-JOIN "#koi8")))
-
- (with-current-buffer (erc-d-t-wait-for 8 (get-buffer "#koi8"))
- (funcall expect 10 "короче теперь")
- (ert-info ("Message well within `erc-split-line-length'")
- (erc-scenarios-common-say
- (concat
- "короче теперь если по русски написать все четко или все равно"
- " короче теперь если по русски написать все четко или все равно"
- " короче теперь если по русски написать все четко или все равно"
- " короче теперь если по русски написать все четко или все равно"))
- (funcall expect 1 "<tester>")
- (funcall expect -0.1 "<tester>"))
-
- (ert-info ("Message over `erc-split-line-length'")
- (erc-scenarios-common-say
- (concat
- "короче теперь если по русски написать все четко или все равно"
- " короче теперь если по русски написать все четко или все равно"
- " короче теперь если по русски написать все четко или все равно"
- " короче теперь если по русски написать все четко или все равно"
- " короче теперь если по русски написать все четко или все равно"
- " короче теперь если по русски написать все четко или все равно"
- " короче теперь если по русски написать все четко или все равно"
- " будет разрыв строки непонятно где"))
- (funcall expect 1 "<tester>")
- (funcall expect 1 "<tester> разрыв")))
-
- (with-current-buffer "foonet"
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished"))))
-
-(ert-deftest erc-scenarios-base-split-line--ascii ()
- :tags '(:expensive-test)
- (should (equal erc-split-line-length 440))
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/flood")
- (msg-432 (string-join (make-list 18 "twenty-three characters") " "))
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'ascii))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to server")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :full-name "tester")
- (funcall expect 10 "debug mode")
- (erc-cmd-JOIN "#ascii")))
-
- (with-current-buffer (erc-d-t-wait-for 8 (get-buffer "#ascii"))
- (ert-info ("Message with spaces fits exactly")
- (funcall expect 10 "Welcome")
- (should (= (length (concat msg-432 " 12345678")) 440))
- (erc-scenarios-common-say (concat msg-432 " 12345678"))
- (funcall expect 1 "<tester>")
- ;; Sent in a single go, hence no second <speaker>.
- (funcall expect -0.1 "<tester>")
- (funcall expect 0.1 "12345678"))
-
- (ert-info ("Message with spaces too long.")
- (erc-scenarios-common-say (concat msg-432 " 123456789"))
- (funcall expect 1 "<tester>")
- ;; Sent in two passes, split at last word.
- (funcall expect 0.1 "<tester> 123456789"))
-
- (ert-info ("Message sans spaces fits exactly")
- (erc-scenarios-common-say (make-string 440 ?x))
- (funcall expect 1 "<tester>")
- ;; Sent in a single go, hence no second <speaker>.
- (funcall expect -0.1 "<tester>"))
-
- (ert-info ("Message sans spaces too long.")
- (erc-scenarios-common-say (concat (make-string 440 ?y) "z"))
- (funcall expect 1 "<tester>")
- ;; Sent in two passes, split at last word.
- (funcall expect 0.1 "<tester> z"))
-
- (ert-info ("Rejected when escape-hatch set")
- (let ((erc--reject-unbreakable-lines t))
- (should-error
- (erc-scenarios-common-say
- (concat
- "https://mail.example.org/verify?token="
- (string-join (make-list 18 "twenty-three_characters") "_")))))))
-
- (with-current-buffer "foonet"
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished"))))
-
-(ert-deftest erc-scenarios-base-split-line--utf-8 ()
- :tags '(:expensive-test)
- (unless (> emacs-major-version 27)
- (ert-skip "No emojis in Emacs 27"))
-
- (should (equal erc-split-line-length 440))
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/flood")
- (msg-432 (string-join (make-list 18 "twenty-three characters") " "))
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'utf-8))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to server")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :full-name "tester")
- (funcall expect 10 "debug mode")
- (erc-cmd-JOIN "#utf-8")))
-
- (with-current-buffer (erc-d-t-wait-for 8 (get-buffer "#utf-8"))
- (funcall expect 10 "Welcome")
-
- (ert-info ("Message with spaces over `erc-split-line-length'")
- (erc-scenarios-common-say
- (concat
- "короче теперь если по русски написать все четко или все равно"
- " короче теперь если по русски написать все четко или все равно"
- " короче теперь если по русски написать все четко или все равно"
- " короче теперь если по русски написать все четко или все равно"
- " короче теперь если по русски написать все четко или все равно"
- " короче теперь если по русски написать все четко или все равно"
- " короче теперь если по русски написать все четко или все равно"
- " будет разрыв строки непонятно где"
- " будет разрыв строки непонятно где"))
- (funcall expect 1 "<tester> короче")
- (funcall expect 1 "<tester> все")
- (funcall expect 1 "<tester> разрыв")
- (funcall expect 1 "Entirely honour"))
-
- (ert-info ("Message sans spaces over `erc-split-line-length'")
- (erc-scenarios-common-say
- (concat "話說天下大勢，分久必合，合久必分：周末七國分爭，并入於秦。"
- "及秦滅之後，楚、漢分爭，又并入於漢。漢朝自高祖斬白蛇而起義，"
- "一統天下。後來光武中興，傳至獻帝，遂分為三國。推其致亂之由，"
- "殆始於桓、靈二帝。桓帝禁錮善類，崇信宦官。及桓帝崩，靈帝即位，"
- "大將軍竇武、太傅陳蕃，共相輔佐。時有宦官曹節等弄權，竇武、陳蕃謀誅之，"
- "作事不密，反為所害。中涓自此愈橫"))
- (funcall expect 1 "<tester>")
- ;; Sent in two passes, split at last word.
- (funcall expect 0.1 "<tester> 竇武")
- (funcall expect 1 "this prey out"))
-
- ;; Combining emojis are respected.
- (ert-info ("Message sans spaces over small `erc-split-line-length'")
- (let ((erc-split-line-length 100))
- (erc-scenarios-common-say
- "будет разрыв строки непонятно где🏁🚩🎌🏴🏳️🏳️🌈🏳️⚧️🏴☠️"))
- (funcall expect 1 "<tester>")
- (funcall expect 1 "<tester> 🏳️🌈")))
-
- (with-current-buffer "foonet"
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished"))))
-
-;;; erc-scenarios-base-split-line.el ends here
+++ /dev/null
-;;; erc-scenarios-base-statusmsg.el --- statusmsg tests -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(ert-deftest erc-scenarios-base-statusmsg ()
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/display-message")
- (dumb-server (erc-d-run "localhost" t 'statusmsg))
- (erc-autojoin-channels-alist '((foonet "#mine")))
- (erc-modules (cons 'fill-wrap erc-modules))
- (port (process-contact dumb-server :service))
- (erc-show-speaker-membership-status nil)
- (erc-server-flood-penalty 0.1)
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :full-name "tester")
- (funcall expect 5 "This server is in debug mode")))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#mine"))
-
- (ert-info ("Receive status messages unprefixed")
- (funcall expect 5 "+dummy")
- (funcall expect 5 "(dummy+) hello")
- (should (eq 'statusmsg (erc--get-inserted-msg-prop 'erc--msg)))
- (should (equal "dummy" (erc--get-inserted-msg-prop 'erc--spkr)))
- (should (eq (get-text-property (1- (point)) 'font-lock-face)
- 'erc-default-face))
- (funcall expect 5 "(dummy+) there")
- (should (equal "" (get-text-property (pos-bol) 'display)))
-
- ;; CTCP ACTION
- (funcall expect 5 "* (dummy+) sad")
- (should (eq 'ctcp-action-statusmsg
- (erc--get-inserted-msg-prop 'erc--msg)))
- (should (eq (get-text-property (1- (point)) 'font-lock-face)
- 'erc-action-face))
- (funcall expect 5 "* (dummy+) glad")
- (should (equal "" (get-text-property (pos-bol) 'display))))
-
- (ert-info ("Send status messages")
- ;; We don't have `echo-message' yet, so ERC doesn't currently
- ;; insert commands like "/msg +#mine foo".
- (let ((erc-default-recipients '("+#mine")))
- (erc-send-message "howdy"))
- (funcall expect 5 "(@tester+) howdy")
- (should (eq 'statusmsg-input (erc--get-inserted-msg-prop 'erc--msg)))
- (should (equal "tester" (erc--get-inserted-msg-prop 'erc--spkr)))
- (should (eq (get-text-property (1- (point)) 'font-lock-face)
- 'erc-input-face))
- (let ((erc-default-recipients '("+#mine")))
- (erc-send-message "tenderfoot"))
- (funcall expect 5 "(@tester+) tenderfoot")
- (should (equal "" (get-text-property (pos-bol) 'display)))
-
- ;; Simulate some "echoed" CTCP ACTION messages since we don't
- ;; actually support that yet.
- (funcall expect 5 "* (@tester+) mad")
- (should (eq 'ctcp-action-statusmsg-input
- (erc--get-inserted-msg-prop 'erc--msg)))
- (should (equal (get-text-property (1- (point)) 'font-lock-face)
- '(erc-input-face erc-action-face)))
- (funcall expect 5 "* (@tester+) chad")
- (should (equal "" (get-text-property (pos-bol) 'display))))
-
- (ert-info ("Receive status messages prefixed")
- (setq erc-show-speaker-membership-status t)
- (erc-scenarios-common-say "/me ready") ; sync
- (funcall expect 5 "* @tester ready")
- (funcall expect 5 "(+dummy+) okie")
-
- ;; CTCP ACTION
- (funcall expect 5 "* (+dummy+) dokie")
- (funcall expect 5 "* +dummy out")))))
-
-;;; erc-scenarios-base-statusmsg.el ends here
+++ /dev/null
-;;; erc-scenarios-base-unstable.el --- base unstable scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(eval-when-compile (require 'erc-join) (require 'warnings))
-
-;; Not unstable, but stashed here for now
-
-(ert-deftest erc-scenarios-aux-unix-socket ()
- :tags '(:expensive-test)
- (skip-unless (featurep 'make-network-process '(:family local)))
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/renick/self")
- (erc-server-flood-penalty 0.1)
- (sock (expand-file-name "erc-d.sock" temporary-file-directory))
- (erc-scenarios-common-extra-teardown (lambda () (delete-file sock)))
- (erc-server-connect-function
- (lambda (n b _ p &rest r)
- (apply #'make-network-process
- `(:name ,n :buffer ,b :service ,p :family local ,@r))))
- (dumb-server (erc-d-run nil sock 'auto))
- erc-autojoin-channels-alist
- erc-server-buffer-foo)
-
- (ert-info ("Connect to foonet")
- (setq erc-server-buffer-foo (erc :server "fake"
- :port sock
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester"))
- (with-current-buffer erc-server-buffer-foo
- (should (string= (buffer-name) (format "fake:%s" sock)))))
-
- (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "foonet"))
- (erc-d-t-search-for 10 "Your new nickname is dummy"))
-
- (ert-info ("Joined by bouncer to #foo, own nick present")
- (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#foo"))
- (erc-d-t-search-for 10 "dummy")
- (erc-d-t-search-for 10 "On Thursday")))))
-
-;; See `erc-networks--rename-server-buffer'. A perceived loss in
-;; network connectivity turns out to be a false alarm, but the bouncer
-;; has already accepted the second connection
-
-(defun erc-scenarios--base-aborted-reconnect ()
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/reconnect")
- (erc-d-t-cleanup-sleep-secs 1)
- (dumb-server (erc-d-run "localhost" t 'aborted 'aborted-dupe))
- (port (process-contact dumb-server :service))
- erc-autojoin-channels-alist
- erc-server-buffer-foo)
-
- (ert-info ("Connect to foonet")
- (setq erc-server-buffer-foo (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "changeme"
- :full-name "tester"))
- (with-current-buffer erc-server-buffer-foo
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (ert-info ("Server buffer is unique and temp name is absent")
- (erc-d-t-wait-for 10 (get-buffer "FooNet"))
- (should-not (erc-scenarios-common-buflist "127.0.0.1"))
- (with-current-buffer erc-server-buffer-foo
- (erc-cmd-JOIN "#chan")))
-
- (ert-info ("Channel buffer #chan alive and well")
- (with-current-buffer (erc-d-t-wait-for 4 (get-buffer "#chan"))
- (erc-d-t-search-for 10 "welcome")))
-
- (ert-info ("Connect to foonet again")
- (setq erc-server-buffer-foo (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "changeme"
- :full-name "tester"))
- (let ((inhibit-message noninteractive))
- (with-current-buffer erc-server-buffer-foo
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (erc-d-t-wait-for 5 (not (erc-server-process-alive)))
- (erc-d-t-search-for 10 "FooNet still connected"))))
-
- (ert-info ("Server buffer is unique and temp name is absent")
- (should (equal (list (get-buffer "FooNet"))
- (erc-scenarios-common-buflist "FooNet")))
- (should (equal (list (get-buffer (format "127.0.0.1:%d" port)))
- (erc-scenarios-common-buflist "127.0.0.1"))))
-
- (ert-info ("Channel buffer #chan still going")
- (with-current-buffer "#chan"
- (erc-d-t-search-for 10 "and be prosperous")))))
-
-(ert-deftest erc-scenarios-base-aborted-reconnect ()
- :tags '(:unstable)
- (let ((tries 3)
- (timeout 1)
- failed)
- (while (condition-case _err
- (progn
- (erc-scenarios--base-aborted-reconnect)
- nil)
- (ert-test-failed
- (message "Test %S failed; %s attempt(s) remaining."
- (ert-test-name (ert-running-test))
- tries)
- (sleep-for (cl-incf timeout))
- (not (setq failed (zerop (cl-decf tries)))))))
- (should-not failed)))
-
-;; The `erc-networks' library has slowly become a hard dependency of
-;; the interactive client since its incorporation in 2006. But its
-;; module, which was added in ERC 5.3 (2008) and thereafter loaded by
-;; default, only became quasi-required in ERC 5.5 (2022). Despite
-;; this, a basic connection should still always succeed, at least long
-;; enough to warn users that their setup is abnormal. Of course,
-;; third-party code intentionally omitting the module will have to
-;; override various erc-server-*-functions to avoid operating in a
-;; degraded state, which has likely been the case for a while.
-
-(ert-deftest erc-scenarios-networks-no-module ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "networks/no-module")
- (erc-server-flood-penalty 0.1)
- (erc-networks-mode-orig erc-networks-mode)
- (dumb-server (erc-d-run "localhost" t 'basic))
- (port (process-contact dumb-server :service))
- (erc-modules (remq 'networks erc-modules))
- (warning-suppress-log-types '((erc)))
- (expect (erc-d-t-make-expecter)))
-
- (erc-networks-mode -1)
- (ert-info ("Connect and retain dialed name")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :full-name "tester")
- (funcall expect 10 "Required module `networks' not loaded")
- (funcall expect 10 "This server is in debug mode")
- ;; Buffer not named after network
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (erc-cmd-JOIN "#chan")))
-
- (ert-info ("Join #chan, change nick, query op")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 20 "Even at thy teat thou")
- (erc-cmd-NICK "dummy")
- (funcall expect 10 "Your new nickname is dummy")
- (erc-scenarios-common-say "/msg alice hi")))
-
- (ert-info ("Switch to query and quit")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "alice"))
- (funcall expect 20 "bye"))
-
- (with-current-buffer (format "127.0.0.1:%d" port)
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
- (when erc-networks-mode-orig
- (erc-networks-mode +1))))
-
-;;; erc-scenarios-base-unstable.el ends here
+++ /dev/null
-;;; erc-scenarios-base-upstream-recon-soju.el --- Bouncer recon scenario -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 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:
-
-;; These concern the loss and recovery of a proxy's IRC-side
-;; connection (hence "upstream").
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(ert-deftest erc-scenarios-upstream-recon--soju ()
- :tags '(:expensive-test)
- (erc-scenarios-common--upstream-reconnect
- (lambda ()
- (with-current-buffer "foonet"
- (erc-d-t-search-for 1 "disconnected from foonet")
- (erc-d-t-search-for 1 "connected from foonet"))
- (with-current-buffer "barnet"
- (erc-d-t-search-for 1 "disconnected from barnet")
- (erc-d-t-search-for 1 "connected from barnet")))
- 'soju-foonet
- 'soju-barnet))
-
-;;; erc-scenarios-base-upstream-recon-soju.el ends here
+++ /dev/null
-;;; erc-scenarios-base-upstream-recon-znc.el --- Bouncer recon scenario -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 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:
-
-;; These concern the loss and recovery of a proxy's IRC-side
-;; connection (hence "upstream").
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(ert-deftest erc-scenarios-upstream-recon--znc ()
- :tags '(:expensive-test)
- (erc-scenarios-common--upstream-reconnect
- (lambda ()
- (with-current-buffer "*status@foonet"
- (erc-d-t-search-for 1 "Disconnected from IRC")
- (erc-d-t-search-for 1 "Connected!"))
- (with-current-buffer "*status@barnet"
- (erc-d-t-search-for 1 "Disconnected from IRC")
- (erc-d-t-search-for 1 "Connected!")))
- 'znc-foonet
- 'znc-barnet))
-
-;; Here, the upstream connection is already severed when first
-;; connecting. The bouncer therefore sends query messages from an
-;; administrative bot before the first numerics burst, which results
-;; in a target buffer not being associated with an `erc-networks--id'.
-;; The problem only manifests later, when the buffer-association
-;; machinery checks the names of all target buffers and assumes a
-;; non-nil `erc-networks--id'.
-(ert-deftest erc-scenarios-upstream-recon--znc/severed ()
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/upstream-reconnect")
- (erc-d-t-cleanup-sleep-secs 1)
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'znc-severed))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester@vanilla/foonet"
- :password "changeme"
- :full-name "tester")
- (erc-scenarios-common-assert-initial-buf-name nil port)
- (erc-d-t-wait-for 6 (eq (erc-network) 'foonet))))
-
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "*status"))
- (funcall expect 10 "Connection Refused. Reconnecting...")
- (funcall expect 10 "Connected!"))
-
- (ert-info ("Join #chan")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 10 "<alice> tester, welcome!")
- (funcall expect 10 "<bob> alice: And see a fearful sight")
- (funcall expect 10 "<eve> hola")
- (funcall expect 10 "<Evel> hell o")
- ;;
- (funcall expect 10 "<alice> bob: Or to drown my clothes")))
-
- (ert-info ("Buffer not renamed with net id")
- (should (get-buffer "*status")))
-
- (ert-info ("No error")
- (with-current-buffer (messages-buffer)
- (funcall expect -0.1 "error in process filter")))))
-
-;;; erc-scenarios-base-upstream-recon-znc.el ends here
+++ /dev/null
-;;; erc-scenarios-display-message.el --- erc-display-message -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(ert-deftest erc-scenarios-display-message--multibuf ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/display-message")
- (dumb-server (erc-d-run "localhost" t 'multibuf))
- (port (process-contact dumb-server :service))
- (erc-server-flood-penalty 0.1)
- (erc-modules (cons 'fill-wrap erc-modules))
- (erc-autojoin-channels-alist '((foonet "#chan")))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :full-name "tester")
- (funcall expect 10 "debug mode")))
-
- (ert-info ("User dummy is a member of #chan")
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (funcall expect 10 "dummy")))
-
- (ert-info ("Dummy's QUIT notice in query contains metadata props")
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "dummy"))
- (funcall expect 10 "<dummy> hi")
- (funcall expect 10 "*** dummy (~u@rdjcgiwfuwqmc.irc) has quit")
- (should (eq 'QUIT (get-text-property (match-beginning 0) 'erc--msg)))))
-
- (ert-info ("Dummy's QUIT notice in #chan contains metadata props")
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (funcall expect 10 "*** dummy (~u@rdjcgiwfuwqmc.irc) has quit")
- (should (eq 'QUIT (get-text-property (match-beginning 0) 'erc--msg)))))
-
- (with-current-buffer "foonet"
- (erc-cmd-QUIT ""))))
-
-;;; erc-scenarios-display-message.el ends here
+++ /dev/null
-;;; erc-scenarios-fill-wrap.el --- Fill-wrap module -*- lexical-binding: t -*-
-
-;; Copyright (C) 2024-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(defun erc-scenarios-fill-wrap--merged-p ()
- (get-text-property (pos-bol) 'erc-fill--wrap-merge))
-
-;; This asserts that an intervening date stamp between two messages
-;; from the same speaker will trigger a break in merge detection, so
-;; the second message's speaker tag won't be hidden.
-(ert-deftest erc-scenarios-fill-wrap/merge-datestamp ()
- :tags '(:expensive-test)
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "fill/wrap")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'merge-datestamp))
- (erc-stamp--tz t)
- ;; Start at 2023-10-22T06:16:43.445Z
- (erc-stamp--current-time (if (< emacs-major-version 29)
- '(25908 23515 445000 0)
- '(1697930203445 . 1000)))
- (erc-timer-hook (cons (lambda (&rest _)
- (setq erc-stamp--current-time
- (time-add erc-stamp--current-time 15)))
- erc-timer-hook))
- (expect (erc-d-t-make-expecter))
- (erc-autojoin-channels-alist '((foonet "#chan" "#control")))
- (erc-modules `(nicks fill-wrap scrolltobottom ,@erc-modules))
- (port (process-contact dumb-server :service)))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :full-name "tester")
- (funcall expect 10 "This server is in debug mode")))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "dummy"))
- (funcall expect 10 "<dummy> hi")
- (funcall expect 10 "<dummy> there"))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "<bob> tester, welcome")
-
- ;; Force date change.
- (setq erc-stamp--current-time
- (time-add erc-stamp--current-time (* 60 60))))
-
- (with-current-buffer "#control"
- (erc-send-message "1"))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "[Sun Oct 22 2023]")
- (funcall expect 10 "<bob> one")
- (should-not (erc-scenarios-fill-wrap--merged-p)))
-
- (with-current-buffer "#control"
- (erc-send-message "2"))
-
- (with-current-buffer "dummy"
- (funcall expect 10 "[Sun Oct 22 2023]")
- (funcall expect 10 "<dummy> again")
- (should-not (erc-scenarios-fill-wrap--merged-p)))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "<alice> bob: He was famous"))
-
- (erc-scrolltobottom-mode -1)))
-
-;;; erc-scenarios-fill-wrap.el ends here
+++ /dev/null
-;;; erc-scenarios-ignore.el --- /IGNORE scenarios ERC -*- lexical-binding: t -*-
-
-;; Copyright (C) 2024-2025 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:
-
-;; TODO add test covering the same ignored speaker in two different
-;; channels on the same server: they should be ignored in both.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(ert-deftest erc-scenarios-ignore/basic ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/assoc/multi-net")
- (erc-server-flood-penalty 0.1)
- (dumb-server-foonet (erc-d-run "localhost" t 'foonet))
- (dumb-server-barnet (erc-d-run "localhost" t 'barnet))
- (erc-autojoin-channels-alist '((foonet "#chan") (barnet "#chan")))
- (port-foonet (process-contact dumb-server-foonet :service))
- (port-barnet (process-contact dumb-server-barnet :service))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to two networks")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port-barnet
- :nick "tester"
- :password "changeme"
- :full-name "tester"))
- (with-current-buffer (erc :server "127.0.0.1"
- :port port-foonet
- :nick "tester"
- :password "changeme"
- :full-name "tester")
- (funcall expect 10 "debug mode")))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan@foonet"))
- (funcall expect 10 "<bob> tester, welcome!")
- (funcall expect 10 "<alice> tester, welcome!")
- (erc-scenarios-common-say "/ignore alice 1m")
- (erc-scenarios-common-say "/ignore mike 1h")
- (funcall expect 10 "ignoring alice for 1m0s")
- (funcall expect 10 "<bob> alice: Signior Iachimo")
- (erc-scenarios-common-say "/ignore")
- (funcall expect 20 '(: "alice 5" (any "0-9") "s"))
- (funcall expect 10 '(: "mike 59m5" (any "0-9") "s"))
- (funcall expect -0.1 "<alice>")
- (funcall expect 10 "<bob> alice: The ground is bloody")
- (erc-scenarios-common-say "/unignore alice")
- (funcall expect 10 "<alice>"))
-
- ;; No <mike> messages were ignored on network barnet.
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan@barnet"))
- (funcall expect 10 "<mike> tester, welcome!")
- (funcall expect 10 "<joe> tester, welcome!")
- (funcall expect 10 "<mike> joe: Whipp'd")
- (funcall expect 10 "<mike> joe: Double"))))
-
-;;; erc-scenarios-ignore.el ends here
+++ /dev/null
-;;; erc-scenarios-internal.el --- Proxy file for erc-d tests -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 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
- (when (and (getenv "EMACS_TEST_DIRECTORY")
- (getenv "EMACS_TEST_JUNIT_REPORT"))
- (setq ert-load-file-name (or (macroexp-file-name) buffer-file-name)))
- (let ((load-path `(,(expand-file-name "erc-d" (ert-resource-directory))
- ,(ert-resource-directory)
- ,@load-path)))
- ;; Run all tests in ./resources/erc-d/erc-d-tests.el.
- (load "erc-d-tests" nil 'silent)
- (require 'erc-tests-common)))
-
-;; Run all tests tagged `:erc--graphical' in an "interactive"
-;; subprocess. Time out after 90 seconds.
-(ert-deftest erc-scenarios-internal--run-graphical-all ()
- :tags '(:expensive-test :unstable)
- (unless (and (getenv "ERC_TESTS_GRAPHICAL_ALL")
- (not (getenv "ERC_TESTS_GRAPHICAL"))
- (not (getenv "CI")))
- (ert-skip "Environmental conditions unmet"))
-
- (let* ((default-directory (expand-file-name "../" (ert-resource-directory)))
- (libs (directory-files default-directory 'full (rx ".el" eot)))
- (process-environment (cons "ERC_TESTS_GRAPHICAL=1"
- process-environment))
- (program '(progn (ert (quote (tag :erc--graphical)))
- (with-current-buffer ert--output-buffer-name
- (kill-emacs (ert--stats-failed-unexpected
- ert--results-stats)))))
- (proc (erc-tests-common-create-subprocess program
- '( "-L" "." "-l" "ert")
- libs)))
-
- (erc-d-t-wait-for 90 "interactive tests to complete"
- (not (process-live-p proc)))
-
- (should (zerop (process-exit-status proc)))))
-
-;;; erc-scenarios-internal.el ends here
+++ /dev/null
-;;; erc-scenarios-join-auth-source.el --- join-auth-source scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 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:
-
-;; TODO add another test with autojoin and channel keys
-
-;;; 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-auth-source--network ()
- :tags '(:expensive-test)
- (should erc-auth-source-join-function)
- (erc-scenarios-common-with-cleanup
- ((entries
- '("machine 127.0.0.1 port %d login \"#foo\" password spam"
- "machine irc.foonet.org port %d login tester password fake"
- "machine irc.foonet.org login \"#spam\" password secret"
- "machine foonet port %d login dummy password fake"
- "machine 127.0.0.1 port %d login dummy password changeme"))
- (erc-scenarios-common-dialog "join/auth-source")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'foonet))
- (port (process-contact dumb-server :service))
- (ents (mapcar (lambda (fmt) (format fmt port)) entries))
- (netrc-file (make-temp-file "auth-source-test" nil nil
- (string-join ents "\n")))
- (auth-sources (list netrc-file))
- (auth-source-do-cache nil)
- (expect (erc-d-t-make-expecter))
- (erc-scenarios-common-extra-teardown (lambda ()
- (delete-file netrc-file))))
-
- (ert-info ("Connect without password")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "dummy"
- :full-name "dummy")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (erc-d-t-wait-for 8 (eq erc-network 'foonet))
- (funcall expect 10 "user modes")
- (erc-scenarios-common-say "/JOIN #spam")))
-
- (ert-info ("Join #spam")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))
- (funcall expect 10 "#spam was created on")))))
-
-;;; erc-scenarios-join-auth-source.el ends here
+++ /dev/null
-;;; erc-scenarios-join-display-context.el --- buffer-display autojoin ctx -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 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
+++ /dev/null
-;;; erc-scenarios-join-netid-newcmd-id.el --- join netid newcmd scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(ert-deftest erc-scenarios-join-netid--newcmd-id ()
- :tags '(:expensive-test)
- (let ((connect (lambda ()
- (erc :server "127.0.0.1"
- :port (with-current-buffer "oofnet"
- (process-contact erc-server-process :service))
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester"
- :id 'oofnet))))
- (erc-scenarios-common--join-network-id connect 'oofnet nil)))
-
-(ert-deftest erc-scenarios-join-netid--newcmd-ids ()
- :tags '(:expensive-test)
- (let ((connect (lambda ()
- (erc :server "127.0.0.1"
- :port (with-current-buffer "oofnet"
- (process-contact erc-server-process :service))
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester"
- :id 'oofnet))))
- (erc-scenarios-common--join-network-id connect 'oofnet 'rabnet)))
-
-;;; erc-scenarios-join-netid-newcmd-id.el ends here
+++ /dev/null
-;;; erc-scenarios-join-netid-newcmd.el --- join netid newcmd scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(ert-deftest erc-scenarios-join-netid--newcmd ()
- :tags '(:expensive-test)
- (let ((connect (lambda ()
- (erc :server "127.0.0.1"
- :port (with-current-buffer "foonet"
- (process-contact erc-server-process :service))
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester"))))
- (erc-scenarios-common--join-network-id connect nil nil)))
-
-;;; erc-scenarios-join-netid-newcmd.el ends here
+++ /dev/null
-;;; erc-scenarios-join-netid-recon-id.el --- join-netid-recon scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(ert-deftest erc-scenarios-join-netid--recon-id ()
- :tags '(:expensive-test)
- (let ((connect (lambda ()
- (with-current-buffer "oofnet"
- (erc-cmd-RECONNECT)
- (should (eq (current-buffer)
- (process-buffer erc-server-process)))
- (current-buffer)))))
- (erc-scenarios-common--join-network-id connect 'oofnet nil)))
-
-(ert-deftest erc-scenarios-join-netid--recon-ids ()
- :tags '(:expensive-test)
- (let ((connect (lambda ()
- (with-current-buffer "oofnet"
- (erc-cmd-RECONNECT)
- (should (eq (current-buffer)
- (process-buffer erc-server-process)))
- (current-buffer)))))
- (erc-scenarios-common--join-network-id connect 'oofnet 'rabnet)))
-
-;;; erc-scenarios-join-netid-recon-id.el ends here
+++ /dev/null
-;;; erc-scenarios-join-netid-recon.el --- join-netid-recon scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(ert-deftest erc-scenarios-join-netid--recon ()
- :tags '(:expensive-test)
- (let ((connect (lambda ()
- (with-current-buffer "foonet"
- (erc-cmd-RECONNECT)
- (should (eq (current-buffer)
- (process-buffer erc-server-process)))
- (current-buffer)))))
- (erc-scenarios-common--join-network-id connect nil nil)))
-
-;;; erc-scenarios-join-netid-recon.el ends here
+++ /dev/null
-;;; erc-scenarios-keep-place-indicator-trunc.el --- `truncate' integration -*- lexical-binding: t -*-
-
-;; Copyright (C) 2024-2025 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-goodies)
-
-(ert-deftest erc-scenarios-keep-place-indicator-trunc ()
- :tags `(:expensive-test
- ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical)))
-
- (when (and noninteractive (= emacs-major-version 27))
- (ert-skip "Times out"))
-
- (defvar erc-max-buffer-size)
- (defvar erc-truncate-padding-size)
-
- (erc-scenarios-common-with-noninteractive-in-term
- ((erc-scenarios-common-dialog "keep-place")
- (dumb-server (erc-d-run "localhost" t 'follow))
- (port (process-contact dumb-server :service))
- (erc-modules `( keep-place-indicator scrolltobottom
- truncate ,@erc-modules))
- (erc-server-flood-penalty 0.1)
- (erc-max-buffer-size 300)
- (erc-truncate-padding-size 200)
- (erc-keep-place-indicator-truncation t)
- (erc-autojoin-channels-alist '((foonet "#chan" "#spam")))
- (expect (erc-d-t-make-expecter)))
-
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :full-name "tester"
- :nick "tester"
- :user "tester")
- (funcall expect 10 "debug mode"))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (set-window-buffer nil (current-buffer))
- (delete-other-windows)
-
- (ert-info ("Truncation occurs because indicator still at start pos")
- (funcall expect 10 "]\n<alice> bob: And what I spake")
- (redisplay)
- (should (= (overlay-start erc--keep-place-indicator-overlay) 2))
- (funcall expect 10 "Yes, faith will I")
- (goto-char (point-max)))
-
- (switch-to-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))) ; lower
- (funcall expect 10 "<alice> tester, welcome!")
- (erc-scenarios-common-say "one")
- (erc-scenarios-common-say "two")
- (funcall expect 10 "<bob> Cause they take")
- (erc-scenarios-common-say "three")
- (goto-char (point-max))
-
- (ert-info ("Truncation limited by indicator")
- (switch-to-buffer "#chan")
- (funcall expect 10 "<bob> Ready")
- (redisplay)
- (funcall expect 10 "]\n<alice> Yes, faith will I" (point-min))
- (should (= (overlay-start erc--keep-place-indicator-overlay)
- (pos-bol)))
- (should (> (buffer-size) 500)))
-
- (ert-info ("Normal keep-place behavior still present")
- (switch-to-buffer "#spam")
- (should (< (point) erc-input-marker)))
-
- (erc-keep-place-mode -1)
- (erc-scrolltobottom-mode -1))))
-
-;;; erc-scenarios-keep-place-indicator-trunc.el ends here
+++ /dev/null
-;;; erc-scenarios-keep-place-indicator.el --- erc-keep-place-indicator-mode -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 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-goodies)
-
-;; This test shows that the indicator does not update when at least
-;; one window remains. When the last window showing a buffer switches
-;; away, the indicator is updated if it's earlier in the buffer.
-(ert-deftest erc-scenarios-keep-place-indicator--follow ()
- :tags `(:expensive-test
- ,@(and (getenv "EMACS_EMBA_CI") '(:unstable))
- ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical)))
- (when (version< emacs-version "29") (ert-skip "Times out"))
- ;; XXX verify that this continues to be the case ^.
-
- (should-not erc-scrolltobottom-all)
- (should-not erc-scrolltobottom-mode)
- (should-not erc-keep-place-mode)
-
- (erc-scenarios-common-with-noninteractive-in-term
- ((erc-scenarios-common-dialog "keep-place")
- (dumb-server (erc-d-run "localhost" t 'follow))
- (port (process-contact dumb-server :service))
- (erc-modules `( keep-place-indicator scrolltobottom fill-wrap
- ,@erc-modules))
- (erc-keep-place-indicator-follow t)
- (erc-scrolltobottom-all t)
- (erc-server-flood-penalty 0.1)
- (erc-autojoin-channels-alist '((foonet "#chan" "#spam")))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :full-name "tester"
- :nick "tester"
- :user "tester")
- (funcall expect 10 "debug mode")))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (set-window-buffer nil (current-buffer))
- (delete-other-windows)
- (split-window-below)
- (funcall expect 10 "<bob> tester, welcome!")
- (recenter 0)
- (other-window 1)
- (funcall expect 10 "<alice> tester, welcome!")
- (recenter 0)
- (should (= 2 (length (window-list))))
-
- (ert-info ("Last window to switch away has point earlier in buffer")
- ;; Lower window, with point later in buffer, switches away first.
- (switch-to-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))) ; lower
- (other-window 1)
- (switch-to-buffer "#spam") ; upper
- (erc-scenarios-common-say "one")
- (funcall expect 10 "Ay, the heads")
-
- ;; Overlay has moved to upper window start.
- (switch-to-buffer "#chan")
- (redisplay) ; force overlay to update
- (save-excursion
- (goto-char (window-point))
- (should (looking-back (rx "<bob> tester, welcome!")))
- (should (= (pos-bol) (window-start)))
- (erc-d-t-wait-for 20
- (= (overlay-start erc--keep-place-indicator-overlay) (pos-bol))))
- ;; Lower window is still centered at start.
- (other-window 1)
- (switch-to-buffer "#chan")
- (save-excursion
- (goto-char (window-point))
- (should (looking-back (rx "<alice> tester, welcome!")))
- (should (= (pos-bol) (window-start)))))
-
- (ert-info ("Last window to switch away has point later in buffer")
- ;; Lower window advances.
- (funcall expect 10 "<bob> alice: Since you can cog")
- (recenter 0)
- (redisplay) ; force ^ to appear on first line
-
- (other-window 1) ; upper still at indicator, switches first
- (switch-to-buffer "#spam")
- (other-window 1)
- (switch-to-buffer "#spam") ; lower follows, speaks to sync
- (erc-scenarios-common-say "two")
- (funcall expect 10 "<bob> Cause they take")
- (goto-char (point-max))
-
- ;; Upper switches back first, finds indicator gone.
- (other-window 1)
- (switch-to-buffer "#chan")
- (save-excursion
- (goto-char (window-point))
- (should (looking-back (rx "<bob> tester, welcome!")))
- (should (= (pos-bol) (window-start)))
- (should (> (overlay-start erc--keep-place-indicator-overlay)
- (pos-eol))))
-
- ;; Lower window follows, window-start preserved.
- (other-window 1)
- (switch-to-buffer "#chan")
- (save-excursion
- (goto-char (window-point))
- (should (looking-back (rx "you can cog")))
- (should (= (pos-bol) (window-start)
- (overlay-start erc--keep-place-indicator-overlay)))))
-
- (ert-info ("Point formerly at prompt resides at last arrived message")
- (erc-send-input-line "#spam" "three")
- (save-excursion (erc-d-t-search-for 10 "Ready"))
- (switch-to-buffer "#spam")
- (should (< (point) erc-input-marker))))
-
- (erc-keep-place-mode -1)
- (erc-scrolltobottom-mode -1)))
-
-;;; erc-scenarios-keep-place-indicator.el ends here
+++ /dev/null
-;;; erc-scenarios-log.el --- erc-log scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 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)))
-
-(require 'erc-log)
-(require 'erc-truncate)
-
-(defvar erc-timestamp-format-left)
-
-(ert-deftest erc-scenarios-log--kill-hook ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/assoc/bouncer-history")
- (dumb-server (erc-d-run "localhost" t 'foonet))
- (tempdir (make-temp-file "erc-tests-log." t nil nil))
- (erc-log-channels-directory tempdir)
- (erc-modules (cons 'log erc-modules))
- (port (process-contact dumb-server :service))
- (logfile (expand-file-name (format "#chan!tester@127.0.0.1:%d.txt" port)
- tempdir))
- (erc-server-flood-penalty 0.1)
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (funcall expect 5 "foonet")))
-
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (funcall expect 10 "was created on")
- (funcall expect 10 "please your lordship")
- (with-current-buffer "foonet"
- (delete-process erc-server-process)
- (funcall expect 5 "failed"))
- (should-not (file-exists-p logfile))
- (kill-buffer)
- (should (file-exists-p logfile)))
-
- (with-temp-buffer
- (insert-file-contents logfile)
- (funcall expect 1 "You have joined")
- (funcall expect 1 "Playback Complete.")
- (funcall expect 1 "please your lordship"))
-
- (erc-log-mode -1)
- (if noninteractive
- (delete-directory tempdir :recursive)
- (add-hook 'kill-emacs-hook
- (lambda () (delete-directory tempdir :recursive))))))
-
-;; These next tests show that, in addition to truncating the buffer,
-;; /CLEAR also syncs the log. They differ from the tests further below
-;; involving the `truncate' module in that, here, the upper truncation
-;; boundary doesn't reside on an `erc--msg' char but rather on a newline
-;; (the final one before `erc-insert-marker'). This was initially done
-;; to safeguard `erc-last-saved-position' because `erc-insert-marker'
-;; originally had a nil insertion type. This staggered alignment means
-;; truncation resulting from a /CLEAR actually demands more twiddling
-;; and care than that triggered by the `truncate' module.
-(ert-deftest erc-scenarios-log--cmd-clear/date-stamps ()
- :tags '(:expensive-test)
- (require 'erc-stamp)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/assoc/bouncer-history")
- (dumb-server (erc-d-run "localhost" t 'foonet))
- (tempdir (make-temp-file "erc-tests-log." t nil nil))
- (erc-scenarios-common-extra-teardown
- (and noninteractive
- (lambda ()
- (run-at-time 0 nil #'delete-directory tempdir :recursive))))
- (erc-log-channels-directory tempdir)
- (erc-modules (cons 'log erc-modules))
- (erc-timestamp-format-left "\n[%a %b %e %Y @@STAMP@@]\n")
- (port (process-contact dumb-server :service))
- (logfile (expand-file-name (format "#chan!tester@127.0.0.1:%d.txt" port)
- tempdir))
- (erc-server-flood-penalty 0.1)
- (expect (erc-d-t-make-expecter)))
-
- (unless noninteractive
- (add-hook 'kill-emacs-hook
- (lambda () (delete-directory tempdir :recursive))))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (funcall expect 5 "foonet")))
-
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (funcall expect 10 "@@STAMP@@")
- (funcall expect 10 "Grows, lives")
- (should-not (file-exists-p logfile))
- (goto-char (point-max))
- (erc-scenarios-common-say "/clear")
- (should (file-exists-p logfile))
- (funcall expect 10 "please your lordship")
- (ert-info ("Buffer truncated")
- (funcall expect 10 "@@STAMP@@" (goto-char (point-min))) ; reset
- ;; Requisite two blank lines plus date stamp are present.
- (should (string-prefix-p "\n\n\n[" (buffer-string)))
- (funcall expect -0.1 "Grows, lives")
- (funcall expect 1 "For these two")
- ;; Stamp resides just before `erc-last-saved-position'.
- (should (looking-back (rx "]\n<bob> alice: For these two")))
- (should (= erc-last-saved-position (1- (pos-bol))))))
-
- (ert-info ("Current contents saved")
- (with-temp-buffer
- (insert-file-contents logfile)
- (funcall expect 1 "@@STAMP@@")
- (funcall expect 1 "You have joined")
- (funcall expect 1 "Playback Complete.")
- (funcall expect 1 "Grows, lives")
- (funcall expect -0.001 "alice: For these two hours")))
-
- (ert-info ("Remainder saved, timestamp printed when option non-nil")
- (with-current-buffer "foonet"
- (delete-process erc-server-process)
- (funcall expect 5 "failed"))
- (kill-buffer "#chan")
- (with-temp-buffer
- (insert-file-contents logfile)
- (funcall expect 1 "@@STAMP@@")
- (funcall expect 1 "Grows, lives")
- (funcall expect -0.01 "@@STAMP@@")
- (forward-line 1) ; no blank, no timestamp
- (should (looking-at (rx "<bob> alice: For these two hours,")))
- (funcall expect 1 "please your lordship")))
-
- (erc-log-mode -1)))
-
-(ert-deftest erc-scenarios-log--cmd-clear/left-stamps ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/assoc/bouncer-history")
- (dumb-server (erc-d-run "localhost" t 'foonet))
- (tempdir (make-temp-file "erc-tests-log." t nil nil))
- (erc-scenarios-common-extra-teardown
- (and noninteractive
- (lambda ()
- (run-at-time 0 nil #'delete-directory tempdir :recursive))))
- (erc-log-channels-directory tempdir)
- (erc-modules (cons 'log erc-modules))
- (erc-insert-timestamp-function #'erc-insert-timestamp-left)
- (erc-timestamp-only-if-changed-flag nil)
- (port (process-contact dumb-server :service))
- (logfile (expand-file-name (format "#chan!tester@127.0.0.1:%d.txt" port)
- tempdir))
- (erc-server-flood-penalty 0.1)
- (expect (erc-d-t-make-expecter)))
-
- (unless noninteractive
- (add-hook 'kill-emacs-hook
- (lambda () (delete-directory tempdir :recursive))))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (funcall expect 5 "foonet")))
-
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (funcall expect 10 "Grows, lives")
- (should (string-prefix-p "\n\n[" (buffer-string)))
- (should-not (file-exists-p logfile))
- (goto-char (point-max))
- (erc-scenarios-common-say "/clear")
- (should (file-exists-p logfile))
- (funcall expect 10 "please your lordship")
-
- ;; During truncation, `erc--clear-function' inserts exactly two
- ;; blanks, regardless of the following content.
- (ert-info ("Buffer truncated")
- (funcall expect -0.1 "Grows, lives")
- (funcall expect 1 "For these two" (goto-char (point-min)))
- (should (string-prefix-p "\n\n[" (buffer-string)))
- (should (looking-back (rx "]<bob> alice: For these two")))
- (should (= erc-last-saved-position 2))))
-
- (ert-info ("Current contents saved")
- (with-temp-buffer
- (insert-file-contents logfile)
- (should (string-prefix-p "[" (buffer-string)))
- (funcall expect 1 "]*** You have joined")
- (funcall expect 1 "Playback Complete.")
- (funcall expect 1 "]<alice> bob: Grows, lives")
- (funcall expect -0.001 "<bob> alice: For these two hours")))
-
- (ert-info ("Remainder saved, timestamp printed when option non-nil")
- (with-current-buffer "foonet"
- (delete-process erc-server-process)
- (funcall expect 5 "failed"))
- (kill-buffer "#chan")
- (with-temp-buffer
- (insert-file-contents logfile)
- (funcall expect 1 "]<alice> bob: Grows, lives")
- (forward-line 1) ; no blank, no timestamp
- (should (looking-at (rx "[" (+ (in ":0-9"))
- "]<bob> alice: For these two hours,")))
- (funcall expect 1 "]<alice> bob: As't please your lordship")))
-
- (erc-log-mode -1)))
-
-(defun erc-scenarios-log--truncate (assert-truncation assert-log)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/assoc/bouncer-history")
- (dumb-server (erc-d-run "localhost" t 'foonet))
- (tempdir (make-temp-file "erc-tests-log." t nil nil))
- (erc-log-channels-directory tempdir)
- (erc-modules (cons 'truncate (cons 'log erc-modules)))
- (erc-max-buffer-size 512)
- (erc-truncate-padding-size 512)
- (port (process-contact dumb-server :service))
- (logchan (expand-file-name (format "#chan!tester@127.0.0.1:%d.txt" port)
- tempdir))
- (logserv (expand-file-name
- (format "127.0.0.1:%d!tester@127.0.0.1:%d.txt" port port)
- tempdir))
- (erc-server-flood-penalty 0.1)
- (expect (erc-d-t-make-expecter)))
-
- (unless noninteractive
- (add-hook 'kill-emacs-hook
- (lambda () (delete-directory tempdir :recursive))))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (should-not (file-exists-p logserv))
- (should-not (file-exists-p logchan))
- ;; Verify that truncation actually happens where it should.
- (funcall assert-truncation expect)
- (should (file-exists-p logserv))))
-
- (ert-info ("Log file ahead of truncation point")
- ;; Log contains lines still present in buffer.
- (with-temp-buffer
- (insert-file-contents logserv)
- (funcall expect 10 "*** MAXLIST=beI:60")))
-
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (funcall expect 10 "please your lordship")
- (should (file-exists-p logchan))
- (funcall expect -0.1 "[07:04:37] alice: Here," (point-min)))
-
- (ert-info ("Log ahead of truncation point")
- (with-temp-buffer
- (insert-file-contents logchan)
- (funcall expect 1 "You have joined")
- ;; No unwanted duplicates.
- (funcall expect 1 "<bob> [07:04:37] alice: Here,")
- (funcall expect -0.001 "<bob> [07:04:37] alice: Here,")
- (funcall expect 1 "<alice> [07:04:42] bob: By my troth")
- (funcall expect -0.001 "<alice> [07:04:42] bob: By my troth")
- (funcall expect 1 "I will grant it")
- (funcall assert-log expect)))
-
- (erc-log-mode -1)
- (erc-truncate-mode -1)
- (when noninteractive (delete-directory tempdir :recursive))))
-
-(ert-deftest erc-scenarios-log--truncate ()
- :tags '(:expensive-test :unstable)
- (erc-scenarios-log--truncate
-
- (lambda (expect)
- (funcall expect 10 "*** MAXLIST=beI:60")
- (should (= (pos-bol) 22))
- ;; Exactly two + 1 (for date stamp) newlines preserved.
- (should (string-prefix-p "\n\n\n[" (buffer-string))))
-
- (lambda (expect)
- (funcall expect -0.001 "loathed enemy"))))
-
-(ert-deftest erc-scenarios-log--truncate/left-stamps ()
- :tags '(:expensive-test :unstable)
- (let ((erc-insert-timestamp-function #'erc-insert-timestamp-left)
- (erc-timestamp-only-if-changed-flag nil))
-
- (erc-scenarios-log--truncate
-
- (lambda (expect)
- ;; Exactly two leading newlines preserved.
- (funcall expect 10
- '(: "\n\n[" (= 5 (in "0-9:")) "]*** There are 0 users")))
-
- (lambda (expect)
- (funcall expect 1 "loathed enemy")
- (funcall expect -0.001 "please your lordship")))))
-
-(defvar erc-insert-timestamp-function)
-(declare-function erc-insert-timestamp-left "erc-stamp" (string))
-
-(ert-deftest erc-scenarios-log--save-buffer-in-logs/truncate-on-save ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/assoc/bouncer-history")
- (dumb-server (erc-d-run "localhost" t 'foonet))
- (tempdir (make-temp-file "erc-tests-log." t nil nil))
- (erc-log-channels-directory tempdir)
- (erc-modules (cons 'log erc-modules))
- (port (process-contact dumb-server :service))
- (erc-truncate-buffer-on-save t)
- (logchan (expand-file-name (format "#chan!tester@127.0.0.1:%d.txt" port)
- tempdir))
- (erc-server-flood-penalty 0.1)
- (erc-insert-timestamp-function #'erc-insert-timestamp-left)
- (expect (erc-d-t-make-expecter)))
-
- (unless noninteractive
- (add-hook 'kill-emacs-hook
- (lambda () (delete-directory tempdir :recursive))))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (funcall expect 10 "<someone> [07:04:10] hi everyone")
- (should-not (file-exists-p logchan))
- ;; Simulate an M-x erc-save-buffer-in-logs RET
- (cl-letf (((symbol-function 'called-interactively-p) #'always))
- (call-interactively #'erc-save-buffer-in-logs))
- (should (file-exists-p logchan))
- (funcall expect 10 "<alice> bob: As't please your lordship")
- (erc-save-buffer-in-logs)
- ;; Not truncated when called by lisp code.
- (should (> (buffer-size) 400)))
-
- (ert-info ("No double entries")
- (with-temp-buffer
- (insert-file-contents logchan)
- (funcall expect 0.1 "hi everyone")
- (funcall expect -0.1 "hi everyone")
- (funcall expect 0.1 "Playback Complete")
- (funcall expect -0.1 "Playback Complete")
- (funcall expect 10 "<alice> bob: As't")))
-
- (erc-log-mode -1)
- (when noninteractive (delete-directory tempdir :recursive))))
-
-;;; erc-scenarios-log.el ends here
+++ /dev/null
-;;; erc-scenarios-match.el --- Misc `erc-match' scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(eval-when-compile
- (require 'erc-join)
- (require 'erc-match))
-
-(require 'erc-stamp)
-(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
-;; `erc-insert-modify-hook'. Basically, `erc-match-message' used to
-;; expect an `erc-parsed' text property on the first character in a
-;; message, which doesn't exist, when the message content is prefixed
-;; by a leading timestamp.
-
-(ert-deftest erc-scenarios-match--stamp-left-current-nick ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/reconnect")
- (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect))
- (port (process-contact dumb-server :service))
- (erc-server-flood-penalty 0.1)
- (erc-insert-timestamp-function 'erc-insert-timestamp-left)
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :full-name "tester"
- :nick "tester")
- ;; Module `timestamp' follows `match' in insertion hooks.
- (should (memq 'erc-add-timestamp
- (memq 'erc-match-message
- (default-value 'erc-insert-modify-hook))))
- ;; The "match type" is `current-nick'.
- (funcall expect 5 "tester")
- (should (eq (get-text-property (1- (point)) 'font-lock-face)
- 'erc-current-nick-face))))))
-
-;; When hacking on tests that use this fixture, it's best to run it
-;; interactively, and visually inspect the output with various
-;; combinations of:
-;;
-;; M-x erc-match-toggle-hidden-fools RET
-;; M-x erc-toggle-timestamps RET
-;;
-(defun erc-scenarios-match--invisible-stamp (hiddenp visiblep)
- (unless noninteractive
- (push "erc-match-toggle-hidden-fools" extended-command-history)
- (push "erc-toggle-timestamps" extended-command-history))
-
- (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-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)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :full-name "tester"
- :password "changeme"
- :nick "tester")
- ;; Module `timestamp' follows `match' in insertion hooks.
- (should (memq 'erc-add-timestamp
- (memq 'erc-match-message
- (default-value 'erc-insert-modify-hook))))
- (funcall expect 5 "This server is in debug mode")))
-
- (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!"))
- (ert-info ("<bob> tester, welcome!") (funcall hiddenp))
-
- ;; Alice's is the only one visible.
- (should (funcall expect 10 "<alice> tester, welcome!"))
- (ert-info ("<alice> tester, welcome!") (funcall visiblep))
-
- (should (funcall expect 10 "<bob> alice: But, as it seems"))
- (ert-info ("<bob> alice: But, as it seems") (funcall hiddenp))
-
- (should (funcall expect 10 "<alice> bob: Well, this is the forest"))
- (ert-info ("<alice> bob: Well, this is the forest") (funcall hiddenp))
-
- (should (funcall expect 10 "<alice> bob: And will you"))
- (ert-info ("<alice> bob: And will you") (funcall hiddenp))
-
- (should (funcall expect 10 "<bob> alice: Live, and be prosperous"))
- (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))))))
-
-;; 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)
- '(match-fools timestamp)))
-
- ;; Message proper has the `invisible' property `match-fools'.
- (let ((msg-beg (next-single-property-change (pos-bol) 'invisible)))
- (should (eq (get-text-property msg-beg 'invisible) 'match-fools))
- (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))))))))
-
-;; In most cases, `erc-hide-fools' makes line endings invisible.
-(defun erc-scenarios-match--stamp-right-fools-invisible ()
- (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right))
- (erc-scenarios-match--invisible-stamp
-
- (lambda ()
- (pcase-let ((`(,beg . ,end) (erc--get-inserted-msg-bounds)))
- ;; 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)
- '(match-fools timestamp)))
-
- ;; The final newline is hidden by `match', not `stamps'
- (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
- (if erc-legacy-invisible-bounds-p
- (should (eq (get-text-property end 'invisible) 'match-fools))
- (should (eq (get-text-property beg 'invisible) 'match-fools))
- (should-not (get-text-property end 'invisible))))
-
- ;; The message proper has the `invisible' property `match-fools',
- ;; and it starts after the preceding newline.
- (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
-
- ;; It ends just before the timestamp.
- (let ((msg-end (next-single-property-change (pos-bol) 'invisible)))
- (should (equal (get-text-property msg-end 'invisible)
- '(match-fools timestamp)))
-
- ;; 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--get-inserted-msg-end (point))))
- ;; 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))))))))
-
-(ert-deftest erc-scenarios-match--stamp-right-fools-invisible ()
- :tags '(:expensive-test)
- (erc-scenarios-match--stamp-right-fools-invisible))
-
-(ert-deftest erc-scenarios-match--stamp-right-fools-invisible--nooffset ()
- :tags '(:expensive-test)
- (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
- (should-not erc-legacy-invisible-bounds-p)
- (let ((erc-legacy-invisible-bounds-p t))
- (erc-scenarios-match--stamp-right-fools-invisible))))
-
-;; 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)
- '(match-fools timestamp)))
-
- ;; The message proper has the `invisible' property `match-fools',
- ;; which starts at the preceding newline...
- (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'match-fools))
-
- ;; ... and ends just before the timestamp.
- (let ((msgend (next-single-property-change (1- (pos-bol)) 'invisible)))
- (should (equal (get-text-property msgend 'invisible)
- '(match-fools timestamp)))
-
- ;; 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)))))))
-
-(defun erc-scenarios-match--fill-wrap-stamp-dedented-p (point)
- (pcase (get-text-property point 'line-prefix)
- (`(space :width (- erc-fill--wrap-value (,n)))
- (if (display-graphic-p) (< 100 n 200) (< 10 n 30)))
- (`(space :width (- erc-fill--wrap-value ,n))
- (< 10 n 30))))
-
-(ert-deftest erc-scenarios-match--hide-fools/stamp-both/fill-wrap ()
-
- ;; Rewind the clock to known date artificially. We should probably
- ;; use a ticks/hz cons on 29+.
- (let ((erc-stamp--current-time 704591940)
- (erc-stamp--tz t)
- (erc-fill-function #'erc-fill-wrap)
- (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]")
- ;; First stamp in a buffer is not invisible from previous
- ;; newline (before stamp's own leading newline).
- (should (= 4 (match-beginning 0)))
- (should (get-text-property 3 'invisible))
- (should-not (get-text-property 2 'invisible))
- (should (erc-scenarios-match--fill-wrap-stamp-dedented-p 4))
- (search-forward "[23:59]"))))
-
- (ert-info ("Line endings in Bob's messages are invisible")
- ;; The message proper has the `invisible' property `match-fools'.
- (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
- (pcase-let ((`(,mbeg . ,mend) (erc--get-inserted-msg-bounds)))
- (should (= (char-after mend) ?\n))
- (should-not (field-at-pos mend))
- (should-not (field-at-pos mbeg))
-
- (when (= bob-utterance-counter 1)
- (let ((right-stamp (field-end mbeg)))
- (should (eq 'erc-timestamp (field-at-pos right-stamp)))
- (should (= mend (field-end right-stamp)))
- (should (eq (field-at-pos (1- mend)) 'erc-timestamp))))
-
- ;; The `erc--ts' property is present in prop stack.
- (should (get-text-property (pos-bol) 'erc--ts))
- (should-not (next-single-property-change (1+ (pos-bol)) 'erc--ts))
-
- ;; Line ending has the `invisible' property `match-fools'.
- (should (eq (get-text-property mbeg 'invisible) 'match-fools))
- (should-not (get-text-property mend 'invisible))))
-
- ;; Only the message right after Alice speaks contains stamps.
- (when (= 1 bob-utterance-counter)
-
- (ert-info ("Date stamp occupying previous line is invisible")
- (should (eq 'match-fools (get-text-property (point) 'invisible)))
- (save-excursion
- (forward-line -1)
- (goto-char (pos-bol))
- (should (looking-at (rx "[Mon May 4 1992]")))
- (ert-info ("Stamp's NL `invisible' as fool, not timestamp")
- (let ((end (match-end 0)))
- (should (eq (char-after end) ?\n))
- (should (eq 'timestamp
- (get-text-property (1- end) 'invisible)))
- (should (eq 'match-fools
- (get-text-property end 'invisible)))))
- (should (erc-scenarios-match--fill-wrap-stamp-dedented-p (point)))
- ;; Date stamp has a combined `invisible' property value
- ;; that starts at the previous message's trailing newline
- ;; and extends until the start of the message proper.
- (should (equal ?\n (char-before (point))))
- (should (equal ?\n (char-before (1- (point)))))
- (let ((val (get-text-property (- (point) 2) 'invisible)))
- (should (equal val 'timestamp))
- (should (= (text-property-not-all (- (point) 2) (point-max)
- 'invisible val)
- (pos-eol))))))
-
- (ert-info ("Current message's RHS stamp is hidden")
- ;; Right stamp has `match-fools' property.
- (save-excursion
- (should-not (field-at-pos (point)))
- (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)
- '(match-fools timestamp)))
-
- ;; Combined `invisible' property spans entire timestamp.
- (should (= (next-single-property-change msgend 'invisible)
- (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))))))
-
-;; This asserts that speaker hiding by `erc-fill-wrap-merge' doesn't
-;; take place after a series of hidden fool messages with an
-;; intervening outgoing message followed immediately by a non-fool
-;; message from the last non-hidden speaker (other than the user).
-(ert-deftest erc-scenarios-match--hide-fools/stamp-both/fill-wrap/speak ()
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "match/fools")
- (erc-stamp--current-time 704591940)
- (dumb-server (erc-d-run "localhost" t 'fill-wrap))
- (erc-stamp--tz t)
- (erc-fill-function #'erc-fill-wrap)
- (port (process-contact dumb-server :service))
- (erc-server-flood-penalty 0.1)
- (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)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :full-name "tester"
- :password "changeme"
- :nick "tester")
- ;; Module `timestamp' follows `match' in insertion hooks.
- (should (memq 'erc-add-timestamp
- (memq 'erc-match-message
- (default-value 'erc-insert-modify-hook))))
- (funcall expect 5 "This server is in debug mode")))
-
- (ert-info ("Ensure lines featuring \"bob\" are invisible")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (should (funcall expect 10 "<alice> None better than"))
- (should (funcall expect 10 "<alice> bob: Still we went"))
- (should (funcall expect 10 "<bob> alice: Give me your hand"))
- (erc-scenarios-common-say "hey")
- (should (funcall expect 10 "<bob> You have paid the heavens"))
- (should (funcall expect 10 "<alice> bob: In the sick air"))
- (should (funcall expect 10 "<alice> The web of our life"))
-
- ;; Regression (see leading comment).
- (should-not (equal "" (get-text-property (pos-bol) 'display)))
-
- ;; No remaining meta-data positions, no more timestamps.
- (should-not (next-single-property-change (1+ (pos-bol)) 'erc--ts))
- ;; No remaining invisible messages.
- (should-not (text-property-not-all (pos-bol) erc-insert-marker
- 'invisible nil))
-
- (should (funcall expect 10 "ERC>"))
- (should-not (get-text-property (pos-bol) 'invisible))
- (should-not (get-text-property (point) 'invisible))))))
-
-(defun erc-scenarios-match--stamp-both-invisible-fill-static (assert-ds)
- (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 `match-fools'.
- (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
- (pcase-let ((`(,mbeg . ,mend) (erc--get-inserted-msg-bounds)))
-
- (should (= (char-after mend) ?\n))
- (should-not (field-at-pos mbeg))
- (should-not (field-at-pos mend))
- (when (= 1 bob-utterance-counter)
- ;; For Bob's stamped message, check newline after stamp.
- (should (eq (field-at-pos (field-end mbeg)) 'erc-timestamp))
- (should (eq (field-at-pos (1- mend)) 'erc-timestamp)))
-
- ;; The `erc--ts' property is present in the message's
- ;; width 1 prop collection at its first char.
- (should (get-text-property (pos-bol) 'erc--ts))
- (should-not (next-single-property-change (1+ (pos-bol)) 'erc--ts))
-
- ;; Line ending has the `invisible' property `match-fools'.
- (should (= (char-after mend) ?\n))
- (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
- (if erc-legacy-invisible-bounds-p
- (should (eq (get-text-property mend 'invisible) 'match-fools))
- (should (eq (get-text-property mbeg 'invisible) 'match-fools))
- (should-not (get-text-property mend 'invisible))))))
-
- ;; 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]")))
- (should (= ?\n (char-after (- (point) 2)))) ; welcome!\n
- (funcall assert-ds))) ; "assert date stamp"
-
- (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)
- '(match-fools timestamp)))
-
- ;; 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))))))
-
-;; FIXME explain why these next two fail on FreeBSD 14.2 (Bug#74722).
-(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static ()
- :tags `(:expensive-test ,@(and (eq system-type 'berkeley-unix) '(:unstable)))
- (erc-scenarios-match--stamp-both-invisible-fill-static
-
- (lambda ()
- ;; Date stamp has an `invisible' property that starts from the
- ;; newline delimiting the current and previous messages and
- ;; extends until the stamp's final newline. It is not combined
- ;; with the old value, `match-fools'.
- (let ((delim-pos (- (point) 2)))
- (should (equal 'timestamp (get-text-property delim-pos 'invisible)))
- ;; Stamp-only invisibility ends before its last newline.
- (should (= (text-property-not-all delim-pos (point-max)
- 'invisible 'timestamp)
- (match-end 0))))))) ; pos-eol
-
-(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static--nooffset ()
- :tags `(:expensive-test ,@(and (eq system-type 'berkeley-unix) '(:unstable)))
- (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
- (should-not erc-legacy-invisible-bounds-p)
-
- (let ((erc-legacy-invisible-bounds-p t))
- (erc-scenarios-match--stamp-both-invisible-fill-static
-
- (lambda ()
- ;; Date stamp has an `invisible' property that covers its
- ;; format string exactly. It is not combined with the old
- ;; value, `match-fools'.
- (let ((delim-prev (- (point) 2)))
- (should-not (get-text-property delim-prev 'invisible))
- (should (eq 'erc-timestamp (field-at-pos (point))))
- (should (= (next-single-property-change delim-prev 'invisible)
- (field-beginning (point))))
- (should (equal 'timestamp
- (get-text-property (1- (point)) 'invisible)))
- ;; Field stops before final newline because the date stamp
- ;; is (now, as of ERC 5.6) its own standalone message.
- (should (= ?\n (char-after (field-end (point)))))
- ;; Stamp-only invisibility includes last newline.
- (should (= (text-property-not-all (1- (point)) (point-max)
- 'invisible 'timestamp)
- (1+ (field-end (point)))))))))))
-
-;;; erc-scenarios-match.el ends here
+++ /dev/null
-;;; erc-scenarios-misc-commands.el --- Misc commands for ERC -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 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)))
-
-;; This defends against a partial regression in which an /MOTD caused
-;; 376 and 422 handlers in erc-networks to run.
-
-(ert-deftest erc-scenarios-misc-commands--MOTD ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "commands")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'motd))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to server")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :full-name "tester")
- (funcall expect 10 "This is the default Ergo MOTD")
- (funcall expect 10 "debug mode")))
-
- (ert-info ("Send plain MOTD")
- (with-current-buffer "foonet"
- (erc-cmd-MOTD)
- (funcall expect -0.2 "Unexpected state detected")
- (funcall expect 10 "This is the default Ergo MOTD")))
-
- (ert-info ("Send MOTD with known target")
- (with-current-buffer "foonet"
- (erc-scenarios-common-say "/MOTD irc1.foonet.org")
- (funcall expect -0.2 "Unexpected state detected")
- (funcall expect 10 "This is the default Ergo MOTD")))
-
- (ert-info ("Send MOTD with erroneous target")
- (with-current-buffer "foonet"
- (erc-scenarios-common-say "/MOTD fake.foonet.org")
- (funcall expect -0.2 "Unexpected state detected")
- (funcall expect 10 "No such server")
- ;; Message may show up before the handler runs.
- (erc-d-t-wait-for 10
- (not (local-variable-p 'erc-server-402-functions)))
- (should-not (local-variable-p 'erc-server-376-functions))
- (should-not (local-variable-p 'erc-server-422-functions))
- (erc-cmd-QUIT "")))))
-
-
-(ert-deftest erc-scenarios-misc-commands--SQUERY ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "commands")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'squery))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to server")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :full-name "tester")
- (funcall expect 10 "Your connection is secure")))
-
- (ert-info ("Send SQUERY")
- (with-current-buffer "IRCnet"
- (erc-scenarios-common-say "/SQUERY alis help list")
- (funcall expect -0.1 "Incorrect arguments")
- (funcall expect 10 "See also: HELP EXAMPLES")))))
-
-;; Note that as of ERC 5.6, there is no actual slash-command function
-;; named `erc-cmd-vhost'. At the moment, this test merely exists to
-;; assert that the `erc-server-396' response handler updates the rolls
-;; correctly.
-(ert-deftest erc-scenarios-misc-commands--VHOST ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "commands")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'vhost))
- ;; As of ERC 5.6, we must join a channel before ERC adds itself
- ;; to `erc-server-users'. Without such an entry, there's
- ;; nothing to update when the 396 arrives.
- (erc-autojoin-channels-alist '((foonet "#chan")))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to server")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "changeme"
- :full-name "tester")
- (funcall expect 10 "debug mode")))
-
- (ert-info ("Send VHOST")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (erc-scenarios-common-say "/VHOST tester changeme")
- (funcall expect 10 "visible host")
- (should (string= (erc-server-user-host (erc-get-server-user "tester"))
- "some.host.test.cc"))))))
-
-;; This tests four related slash commands, /AMSG, /GMSG, /AME, /GME,
-;; the latter three introduced by bug#68401. It mainly asserts
-;; correct routing behavior, especially not sending or inserting
-;; messages in buffers belonging to disconnected sessions. Left
-;; unaddressed are interactions with the `command-indicator' module
-;; (`erc-noncommands-list') and whatever future `echo-message'
-;; implementation manifests out of bug#49860.
-(ert-deftest erc-scenarios-misc-commands--AMSG-GMSG-AME-GME ()
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "commands")
- (erc-server-flood-penalty 0.1)
- (dumb-server-foonet (erc-d-run "localhost" t "srv-foonet" 'amsg-foonet))
- (dumb-server-barnet (erc-d-run "localhost" t "srv-barnet" 'amsg-barnet))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to foonet and join #foo")
- (with-current-buffer
- (erc :server "127.0.0.1"
- :port (process-contact dumb-server-foonet :service)
- :nick "tester")
- (funcall expect 10 "debug mode")
- (erc-cmd-JOIN "#foo")))
-
- (ert-info ("Connect to barnet and join #bar")
- (with-current-buffer
- (erc :server "127.0.0.1"
- :port (process-contact dumb-server-barnet :service)
- :nick "tester")
- (funcall expect 10 "debug mode")
- (erc-cmd-JOIN "#bar")))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo"))
- (funcall expect 10 "welcome"))
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#bar"))
- (funcall expect 10 "welcome"))
-
- (ert-info ("/AMSG only sent to issuing context's server")
- (with-current-buffer "foonet"
- (erc-scenarios-common-say "/amsg 1 foonet only"))
- (with-current-buffer "barnet"
- (erc-scenarios-common-say "/amsg 2 barnet only"))
- (with-current-buffer "#foo"
- (funcall expect 10 "<tester> 1 foonet only")
- (funcall expect 10 "<alice> bob: Our queen and all"))
- (with-current-buffer "#bar"
- (funcall expect 10 "<tester> 2 barnet only")
- (funcall expect 10 "<joe> mike: And secretly to greet")))
-
- (ert-info ("/AME only sent to issuing context's server")
- (with-current-buffer "foonet"
- (erc-scenarios-common-say "/ame 3 foonet only"))
- (with-current-buffer "barnet"
- (erc-scenarios-common-say "/ame 4 barnet only"))
- (with-current-buffer "#foo"
- (funcall expect 10 "* tester 3 foonet only")
- (funcall expect 10 "<alice> bob: You have discharged this"))
- (with-current-buffer "#bar"
- (funcall expect 10 "* tester 4 barnet only")
- (funcall expect 10 "<joe> mike: That same Berowne")))
-
- (ert-info ("/GMSG and /GME sent to all servers")
- (with-current-buffer "foonet"
- (erc-scenarios-common-say "/gmsg 5 all nets")
- (erc-scenarios-common-say "/gme 6 all nets"))
- (with-current-buffer "#bar"
- (funcall expect 10 "<tester> 5 all nets")
- (funcall expect 10 "* tester 6 all nets")
- (funcall expect 10 "<joe> mike: Mehercle! if their sons")))
-
- (ert-info ("/GMSG and /GME only sent to connected servers")
- (with-current-buffer "barnet"
- (erc-cmd-QUIT "")
- (funcall expect 10 "ERC finished"))
- (with-current-buffer "#foo"
- (funcall expect 10 "<tester> 5 all nets")
- (funcall expect 10 "* tester 6 all nets")
- (funcall expect 10 "<alice> bob: Stand you!"))
- (with-current-buffer "foonet"
- (erc-scenarios-common-say "/gmsg 7 all live nets")
- (erc-scenarios-common-say "/gme 8 all live nets"))
- ;; Message *not* inserted in disconnected buffer.
- (with-current-buffer "#bar"
- (funcall expect -0.1 "<tester> 7 all live nets")
- (funcall expect -0.1 "* tester 8 all live nets")))
-
- (with-current-buffer "#foo"
- (funcall expect 10 "<tester> 7 all live nets")
- (funcall expect 10 "* tester 8 all live nets")
- (funcall expect 10 "<bob> alice: Live, and be prosperous;"))))
-
-;;; erc-scenarios-misc-commands.el ends here
+++ /dev/null
-;;; erc-scenarios-misc.el --- Misc scenarios for ERC -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(eval-when-compile (require 'erc-join))
-
-(ert-deftest erc-scenarios-base-flood ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/flood")
- (dumb-server (erc-d-run "localhost" t 'soju))
- (port (process-contact dumb-server :service))
- (erc-server-flood-penalty 0.5) ; this ratio MUST match
- (erc-server-flood-margin 1.5) ; the default of 3:10
- (expect (erc-d-t-make-expecter))
- erc-autojoin-channels-alist)
-
- (ert-info ("Connect to bouncer")
- (with-current-buffer
- (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (funcall expect 5 "Soju")))
-
- (ert-info ("#chan@foonet exists")
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan/foonet"))
- (erc-d-t-search-for 10 "<bob/foonet>")
- (erc-d-t-absent-for 0.1 "<joe")
- (funcall expect 10 "was created on")))
-
- (ert-info ("#chan@barnet exists")
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan/barnet"))
- (erc-d-t-search-for 2 "<joe/barnet>")
- (erc-d-t-absent-for 0.1 "<bob")
- (funcall expect 3 "was created on")
- (funcall expect 10 "To get good guard")))
-
- (ert-info ("Message not held in queue limbo")
- (with-current-buffer "#chan/foonet"
- ;; Without 'no-penalty param in `erc-server-send', should fail
- ;; after ~10 secs with:
- ;;
- ;; (erc-d-timeout "Timed out awaiting request: (:name ~privmsg
- ;; :pattern \\`PRIVMSG #chan/foonet :alice: hi :timeout 2
- ;; :dialog soju)")
- ;;
- ;; Try reversing commit and spying on queue interactively
- (erc-cmd-MSG "#chan/foonet alice: hi")
- (funcall expect 5 "tester: Good, very good")))
-
- (ert-info ("All output sent")
- (with-current-buffer "#chan/foonet"
- (funcall expect 16 "Some man or other"))
- (with-current-buffer "#chan/barnet"
- (funcall expect 10 "That's he that was Othello")))))
-
-;; Corner case demoing fallback behavior for an absent 004 RPL but a
-;; present 422 or 375. If this is unlikely enough, remove or guard
-;; with `ert-skip' plus some condition so it only runs when explicitly
-;; named via ERT specifier
-
-(ert-deftest erc-scenarios-networks-announced-missing ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "networks/announced-missing")
- (expect (erc-d-t-make-expecter))
- (dumb-server (erc-d-run "localhost" t 'foonet))
- (port (process-contact dumb-server :service)))
-
- (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)))
- (funcall expect 1 "Failed to determine")
- (funcall expect 1 "Failed to determine")
- (funcall expect 1 "Connection failed")
- (should (string-prefix-p "Unknown" (erc-network-name)))
- (should (string= erc-server-announced-name "irc.foonet.org"))))))
-
-;; Targets that are host/server masks like $*, $$*, and #* are routed
-;; to the server buffer: https://github.com/ircdocs/wooooms/issues/5
-
-(ert-deftest erc-scenarios-base-mask-target-routing ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/mask-target-routing")
- (dumb-server (erc-d-run "localhost" t 'foonet))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (erc-d-t-wait-for 10 (get-buffer "foonet"))
-
- (ert-info ("Channel buffer #foo playback received")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo"))
- (funcall expect 10 "Excellent workman")))
-
- (ert-info ("Global notices routed to server buffer")
- (with-current-buffer "foonet"
- (funcall expect 10 "going down soon")
- (funcall expect 10 "this is a warning")
- (funcall expect 10 "second warning")
- (funcall expect 10 "final warning")))
-
- (should-not (get-buffer "$*"))))
-
-(defvar url-irc-function)
-
-(ert-deftest erc-scenarios-handle-irc-url ()
- :tags '(:expensive-test)
- (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))
- (expect (erc-d-t-make-expecter))
- (url-irc-function 'url-irc-erc)
- (erc-url-connect-function
- (lambda (scheme &rest r)
- (ert-info ("Connect to foonet")
- (should (equal scheme "irc"))
- (with-current-buffer (apply #'erc `(:full-name "tester" ,@r))
- (should (string= (buffer-name)
- (format "127.0.0.1:%d" port)))
- (current-buffer))))))
-
- (with-temp-buffer
- (insert (format ";; irc://tester:changeme@127.0.0.1:%d/#chan" port))
- (goto-char 10)
- (browse-url-at-point))
-
- (ert-info ("Connected")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 10 "welcome")))))
-
-;; Ensure that ERC does not attempt to switch to a killed server
-;; buffer via `erc-track-switch-buffer'.
-
-(declare-function erc-track-switch-buffer "erc-track" (arg))
-(defvar erc-track-mode)
-
-(ert-deftest erc-scenarios-base-kill-server-track ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "networks/merge-server")
- (dumb-server (erc-d-run "localhost" t 'track))
- (port (process-contact dumb-server :service))
- (erc-server-flood-penalty 0.1)
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (should erc-track-mode)
- (funcall expect 5 "changed mode for tester")
- (erc-cmd-JOIN "#chan")))
-
- (ert-info ("Join channel and kill server buffer")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 5 "The hour that fools should ask"))
- (with-current-buffer "FooNet"
- (set-process-query-on-exit-flag erc-server-process nil)
- (kill-buffer))
- (should-not (eq (current-buffer) (get-buffer "#chan"))) ; *temp*
- (ert-simulate-command '(erc-track-switch-buffer 1)) ; No longer signals
- (should (eq (current-buffer) (get-buffer "#chan"))))))
-
-;;; erc-scenarios-misc.el ends here
+++ /dev/null
-;;; erc-scenarios-prompt-format.el --- erc-prompt-format-mode -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 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)))
-
-(defvar erc-fill-wrap-align-prompt)
-(defvar erc-fill-wrap-use-pixels)
-
-(defun erc-scenarios-prompt-format--assert (needle &rest props)
- (save-excursion
- (goto-char erc-insert-marker)
- (should (search-forward needle nil t))
- (pcase-dolist (`(,k . ,v) props)
- (should (equal (get-text-property (point) k) v)))))
-
-;; This makes assertions about the option `erc-fill-wrap-align-prompt'
-;; as well as the standard value of `erc-prompt-format'. One minor
-;; omission is that this doesn't check behavior in query buffers.
-(ert-deftest erc-scenarios-prompt-format ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/modes")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'chan-changed))
- (erc-modules (cons 'fill-wrap erc-modules))
- (erc-fill-wrap-align-prompt t)
- (erc-fill-wrap-use-pixels nil)
- (erc-prompt #'erc-prompt-format)
- (erc-autojoin-channels-alist '((Libera.Chat "#chan")))
- (expect (erc-d-t-make-expecter))
- ;; Collect samples of `line-prefix' to verify deltas as the
- ;; prompt grows and shrinks.
- (line-prefixes nil)
- (stash-pfx (lambda ()
- (pcase (get-text-property erc-insert-marker 'line-prefix)
- (`(space :width (- erc-fill--wrap-value ,n))
- (car (push n line-prefixes)))))))
-
- (ert-info ("Connect to Libera.Chat")
- (with-current-buffer (erc :server "127.0.0.1"
- :port (process-contact dumb-server :service)
- :nick "tester"
- :full-name "tester")
- (funcall expect 5 "Welcome to the Libera.Chat")
- (funcall stash-pfx)
- (funcall expect 5 "changed mode")
- ;; New prompt is shorter than default with placeholders, like
- ;; "(foo?)(bar?)" (assuming we win the inherent race).
- (should (>= (car line-prefixes) (funcall stash-pfx)))
- (erc-scenarios-prompt-format--assert "user-" '(display . ("Ziw")))))
-
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (should-not erc-channel-key)
- (should-not erc-channel-user-limit)
-
- (ert-info ("Receive notice that mode has changed")
- (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t")))
- (funcall stash-pfx)
- (erc-scenarios-common-say "ready before")
- (funcall expect 10 " has changed mode for #chan to +Qu")
- (erc-d-t-wait-for 10 (equal erc-channel-modes '("Q" "n" "t" "u")))
- ;; Prompt is longer now, so too is the `line-prefix' subtrahend.
- (should (< (car line-prefixes) (funcall stash-pfx)))
- (erc-scenarios-prompt-format--assert "Qntu")
- (erc-scenarios-prompt-format--assert "#chan>"))
-
- (ert-info ("Key stored locally")
- (erc-scenarios-common-say "ready key")
- (funcall expect 10 " has changed mode for #chan to +k hunter2")
- ;; Prompt has grown by 1.
- (should (< (car line-prefixes) (funcall stash-pfx)))
- (erc-scenarios-prompt-format--assert "Qkntu"))
-
- (ert-info ("Limit stored locally")
- (erc-scenarios-common-say "ready limit")
- (funcall expect 10 " has changed mode for #chan to +l 3")
- (erc-d-t-wait-for 10 (eql erc-channel-user-limit 3))
- (should (equal erc-channel-modes '("Q" "n" "t" "u")))
- ;; Prompt has grown by 1 again.
- (should (< (car line-prefixes) (funcall stash-pfx)))
- (erc-scenarios-prompt-format--assert "Qklntu"))
-
- (ert-info ("Modes removed and local state deletion succeeds")
- (erc-scenarios-common-say "ready drop")
- (funcall expect 10 " has changed mode for #chan to -lu")
- (funcall expect 10 " has changed mode for #chan to -Qk *")
- (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t")))
- ;; Prompt has shrunk.
- (should (> (car line-prefixes) (funcall stash-pfx)))
- (erc-scenarios-prompt-format--assert "nt"))
-
- (should-not erc-channel-key)
- (should-not erc-channel-user-limit)
- (funcall expect 10 "<Chad> after"))))
-
-;;; erc-scenarios-prompt-format.el ends here
+++ /dev/null
-;;; erc-scenarios-sasl.el --- SASL tests for ERC -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 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-sasl)
-
-(ert-deftest erc-scenarios-sasl--plain ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "sasl")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'plain))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (erc-sasl-password "password123")
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :full-name "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (ert-info ("Notices received")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "ExampleOrg"))
- (funcall expect 10 "This server is in debug mode")
- ;; Regression "\0\0\0\0 ..." caused by (fillarray passphrase 0)
- (should (string= erc-sasl-password "password123"))))))
-
-;; The user's unreasonably long password is apportioned into chunks on
-;; the way out the door.
-
-(ert-deftest erc-scenarios-sasl--plain-overlong-split ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "sasl")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'plain-overlong-split))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (erc-sasl-password
- (concat
- "Est ut beatae omnis ipsam. "
- "Quis fugiat deleniti totam qui. "
- "Ipsum quam a dolorum tempora velit laborum odit. "
- "Et saepe voluptate sed cumque vel. "
- "Voluptas sint ab pariatur libero veritatis corrupti. "
- "Vero iure omnis ullam. "
- "Vero beatae dolores facere fugiat ipsam. "
- "Ea est pariatur minima nobis sunt aut ut. "
- "Dolores ut laudantium maiores temporibus voluptates. "
- "Reiciendis impedit omnis et unde delectus quas ab. "
- "Quae eligendi necessitatibus doloribus "
- "molestias tempora magnam assumenda."))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "emersion"
- :user "emersion"
- :full-name "emersion")
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-QUIT "")))))
-
-(ert-deftest erc-scenarios-sasl--plain-overlong-aligned ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "sasl")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'plain-overlong-aligned))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (erc-sasl-password
- (concat
- "Est ut beatae omnis ipsam. "
- "Quis fugiat deleniti totam qui. "
- "Ipsum quam a dolorum tempora velit laborum odit. "
- "Et saepe voluptate sed cumque vel. "
- "Voluptas sint ab pariatur libero veritatis corrupti. "
- "Vero iure omnis ullam. Vero beatae dolores facere fugiat ipsam. "
- "Ea est pariatur minima nobis"))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "emersion"
- :user "emersion"
- :full-name "emersion")
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-QUIT "")))))
-
-(ert-deftest erc-scenarios-sasl--external ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "sasl")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'external))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (erc-sasl-mechanism 'external)
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :full-name "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (ert-info ("Notices received")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "ExampleOrg"))
- (funcall expect 10 "Authentication successful")
- (funcall expect 10 "This server is in debug mode")))))
-
-(ert-deftest erc-scenarios-sasl--plain-fail ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "sasl")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'plain-failed))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (erc-sasl-password "wrong")
- (erc-sasl-mechanism 'plain)
- (erc--warnings-buffer-name "*ERC test warnings*")
- (warnings-buffer (get-buffer-create erc--warnings-buffer-name))
- (inhibit-message noninteractive)
- (expect (erc-d-t-make-expecter)))
-
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :full-name "tester")
- (funcall expect 10 "Opening connection")
- (funcall expect 20 "SASL authentication failed")
- (funcall expect 20 "Connection failed!")
- (should-not (erc-server-process-alive)))
-
- (with-current-buffer warnings-buffer
- (funcall expect 10 "please review SASL settings")))
-
- (when noninteractive
- (should-not (get-buffer "*ERC test warnings*"))))
-
-(defun erc-scenarios--common--sasl (mech)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "sasl")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t mech))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (erc-sasl-user :nick)
- (erc-sasl-mechanism mech)
- (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" ""))
- (sasl-unique-id-function (lambda () (pop mock-rvs)))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "jilles"
- :password "sesame"
- :full-name "jilles")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
-
- (ert-info ("Notices received")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "jaguar"))
- (funcall expect 10 "Found your hostname")
- (funcall expect 20 "marked as being away")))))
-
-(ert-deftest erc-scenarios-sasl--scram-sha-1 ()
- :tags '(:expensive-test)
- (let ((erc-sasl-authzid "jilles"))
- (erc-scenarios--common--sasl 'scram-sha-1)))
-
-(ert-deftest erc-scenarios-sasl--scram-sha-256 ()
- :tags '(:expensive-test)
- (unless (featurep 'sasl-scram-sha256)
- (ert-skip "Emacs lacks sasl-scram-sha256"))
- (erc-scenarios--common--sasl 'scram-sha-256))
-
-;;; erc-scenarios-sasl.el ends here
+++ /dev/null
-;;; erc-scenarios-scrolltobottom-relaxed.el --- erc-scrolltobottom-all relaxed -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 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/>.
-
-;; TODO assert behavior of prompt input spanning multiple lines, with
-;; and without line endings.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(require 'erc-goodies)
-
-(ert-deftest erc-scenarios-scrolltobottom--relaxed ()
- :tags `(:expensive-test
- ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical)))
- (when (version< emacs-version "29") (ert-skip "Times out"))
-
- (should-not erc-scrolltobottom-all)
-
- (erc-scenarios-common-with-noninteractive-in-term
- ((erc-scenarios-common-dialog "scrolltobottom")
- (dumb-server (erc-d-run "localhost" t 'help))
- (port (process-contact dumb-server :service))
- (erc-modules `(scrolltobottom fill-wrap ,@erc-modules))
- (erc-scrolltobottom-all 'relaxed)
- (erc-server-flood-penalty 0.1)
- (expect (erc-d-t-make-expecter))
- lower upper)
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :full-name "tester"
- :nick "tester")
- (funcall expect 10 "debug mode")))
-
- (with-current-buffer "foonet"
- (should (looking-at " and"))
- (set-window-buffer nil (current-buffer))
- (delete-other-windows)
- (split-window-below 15)
- (recenter 0)
-
- (ert-info ("Moving into prompt does not trigger scroll")
- (with-selected-window (next-window)
- (should-not (erc-scenarios-common--at-win-end-p))
- (recenter 0)
- (goto-char (1- erc-insert-marker))
- (execute-kbd-macro "\C-n")
- (should-not (erc-scenarios-common--at-win-end-p))
- (should (= (point) (point-max)))
- (setq lower (count-screen-lines (window-start) (window-point)))))
-
- (ert-info ("Module `move-to-prompt' still works")
- ;; Prompt is somewhere in the middle of the window.
- (should (erc-scenarios-common--above-win-end-p))
- (should-not (= (point-max) (point)))
- ;; Hitting a self-insert key triggers `move-to-prompt' but not
- ;; a scroll (to bottom).
- (execute-kbd-macro "hi")
- ;; Prompt and input appear on same line.
- (should (= (point-max) (point)))
- (setq upper (count-screen-lines (window-start) (window-point)))
- (should-not (= upper (window-body-height))))
-
- (ert-info ("Command `recenter-top-bottom' allowed at prompt")
- ;; Hitting C-l recenters the window.
- (should (= upper (count-screen-lines (window-start) (window-point))))
- (let ((lines (list upper)))
- (erc-scenarios-common--recenter-top-bottom)
- (push (count-screen-lines (window-start) (window-point)) lines)
- (erc-scenarios-common--recenter-top-bottom)
- (push (count-screen-lines (window-start) (window-point)) lines)
- (erc-scenarios-common--recenter-top-bottom)
- (push (count-screen-lines (window-start) (window-point)) lines)
- (setq lines (delete-dups lines))
- (should (= (length lines) 4))))
-
- (ert-info ("Command `beginning-of-buffer' allowed at prompt")
- ;; Hitting C-< goes to beginning of buffer.
- (execute-kbd-macro "\M-<")
- (should (= 1 (point)))
- (redisplay)
- (should (zerop (count-screen-lines (window-start) (window-point))))
- (should (erc-scenarios-common--prompt-past-win-end-p)))
-
- (ert-info ("New message doesn't trigger scroll when away from prompt")
- ;; Arriving insertions don't trigger a scroll when away from the
- ;; prompt. New output not seen.
- (erc-cmd-MSG "NickServ help register")
- (save-excursion (erc-d-t-search-for 10 "End of NickServ"))
- (should (= 1 (point)))
- (should (zerop (count-screen-lines (window-start) (window-point))))
- (should (erc-scenarios-common--prompt-past-win-end-p)))
-
- (ert-info ("New insertion keeps prompt stationary in other window")
- (let ((w (next-window)))
- ;; We're at prompt and completely stationary.
- (should (>= (window-point w) erc-input-marker))
- (erc-d-t-wait-for 10
- (= lower (count-screen-lines (window-start w) (window-point w))))
- (erc-d-t-ensure-for 0.5
- (= lower (count-screen-lines (window-start w)
- (window-point w))))))
-
- (should (= 2 (length (window-list))))
- (ert-info ("New message does not trigger a scroll when at prompt")
- ;; Recenter so prompt is above rather than at window's end.
- (funcall expect 10 "End of NickServ HELP")
- (recenter 0)
- (set-window-point nil (point-max))
- (setq upper (count-screen-lines (window-start) (window-point)))
- ;; Prompt is somewhere in the middle of the window.
- (erc-d-t-wait-for 10 (erc-scenarios-common--above-win-end-p))
- (erc-scenarios-common-say "/msg NickServ help identify")
- ;; New arriving messages don't move prompt.
- (erc-d-t-ensure-for 1
- (= upper (count-screen-lines (window-start) (window-point))))
- (funcall expect 10 "IDENTIFY lets you login")))))
-
-;;; erc-scenarios-scrolltobottom-relaxed.el ends here
+++ /dev/null
-;;; erc-scenarios-scrolltobottom.el --- erc-scrolltobottom-mode -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 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-goodies)
-
-;; These two actually seem to run fine on Emacs 28, but skip them for
-;; now to stay in sync with `erc-scenarios-scrolltobottom--relaxed'.
-
-(ert-deftest erc-scenarios-scrolltobottom--normal ()
- :tags `(:expensive-test ,@(and (getenv "ERC_TESTS_GRAPHICAL")
- '(:erc--graphical)))
- (when (version< emacs-version "29") (ert-skip "Times out"))
-
- (should-not erc-scrolltobottom-all)
-
- (erc-scenarios-common-scrolltobottom--normal
- (lambda ()
- (ert-info ("New insertion doesn't anchor prompt in other window")
- (let ((w (next-window)))
- ;; We're at prompt but not aligned to bottom.
- (should (>= (window-point w) erc-input-marker))
- (erc-d-t-wait-for 10
- (not (erc-scenarios-common--at-win-end-p w))))))))
-
-(ert-deftest erc-scenarios-scrolltobottom--all ()
- :tags `(:expensive-test ,@(and (getenv "ERC_TESTS_GRAPHICAL")
- '(:erc--graphical)))
- (when (version< emacs-version "29") (ert-skip "Times out"))
-
- (should-not erc-scrolltobottom-all)
-
- (let ((erc-scrolltobottom-all t))
-
- (erc-scenarios-common-scrolltobottom--normal
- (lambda ()
- (ert-info ("New insertion anchors prompt in other window")
- (let ((w (next-window)))
- ;; We're at prompt and aligned to bottom.
- (should (>= (window-point w) erc-input-marker))
- (erc-d-t-wait-for 10
- (erc-scenarios-common--at-win-end-p w))
- (erc-d-t-ensure-for 0.5
- (erc-scenarios-common--at-win-end-p w))))))))
-
-;;; erc-scenarios-scrolltobottom.el ends here
+++ /dev/null
-;;; erc-scenarios-services-misc.el --- Services-misc scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-scenarios-common)))
-
-(eval-when-compile (require 'erc-join)
- (require 'erc-services))
-
-(ert-deftest erc-scenarios-services-password ()
- :tags '(:expensive-test)
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "services/password")
- (erc-server-flood-penalty 0.1)
- (erc-modules (cons 'services erc-modules))
- (erc-nickserv-passwords '((Libera.Chat (("joe" . "bar")
- ("tester" . "changeme")))))
- (expect (erc-d-t-make-expecter))
- (dumb-server (erc-d-run "localhost" t 'libera))
- (port (process-contact dumb-server :service)))
-
- (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)))
- (erc-d-t-wait-for 5 (eq erc-network 'Libera.Chat))
- (funcall expect 5 "This nickname is registered.")
- (funcall expect 2 "You are now identified")
- (funcall expect 1 "Last login from")
- (erc-cmd-QUIT "")))
-
- (erc-services-mode -1)
-
- (should-not (memq 'services erc-modules))))
-
-(ert-deftest erc-scenarios-services-prompt ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "services/password")
- (erc-server-flood-penalty 0.1)
- (inhibit-interaction nil)
- (erc-modules (cons 'services erc-modules))
- (expect (erc-d-t-make-expecter))
- (dumb-server (erc-d-run "localhost" t 'libera))
- (port (process-contact dumb-server :service)))
-
- (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)))
- (ert-simulate-keys "changeme\r"
- (erc-d-t-wait-for 10 (eq erc-network 'Libera.Chat))
- (funcall expect 3 "This nickname is registered.")
- (funcall expect 3 "You are now identified")
- (funcall expect 3 "Last login from"))
- (erc-cmd-QUIT "")))
-
- (erc-services-mode -1)
-
- (should-not (memq 'services erc-modules))))
-
-;; A user with `services' enabled connects, quits, and reconnects. An
-;; entry in their netrc matches the network ID, which isn't known when
-;; `erc-auth-source-server-function' runs -- initially *or* on
-;; reconnect. It's only seen by `erc-auth-source-services-function'.
-
-(ert-deftest erc-scenarios-services-auth-source-reconnect ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "services/auth-source")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'recon 'recon))
- (port (process-contact dumb-server :service))
- (netrc-file (make-temp-file
- "auth-source-test" nil nil
- "machine FooNet login tester password changeme\n"))
- (auth-sources (list netrc-file))
- (auth-source-do-cache nil)
- (erc-modules (cons 'services erc-modules))
- (erc-use-auth-source-for-nickserv-password t) ; do consult
- (erc-prompt-for-nickserv-password nil) ; don't prompt
- (erc-nickserv-alist
- (cons '(FooNet
- "NickServ!NickServ@services.int"
- "This nickname is registered. Please choose"
- "NickServ" "IDENTIFY" nil nil "You are now identified for ")
- erc-nickserv-alist))
- (expect (erc-d-t-make-expecter))
- (erc-scenarios-common-extra-teardown (lambda ()
- (delete-file netrc-file))))
-
- (ert-info ("Server password omitted from initial connection")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :full-name "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (ert-info ("Services module authenticates")
- (funcall expect 10 "This nickname is registered.")
- (funcall expect 3 "You are now identified"))
- (erc-cmd-JOIN "#chan")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 10 "the gallants desire it"))
- (erc-cmd-QUIT "")
- (funcall expect 3 "finished")))
-
- (ert-info ("Server password withheld on reconnect")
- (with-current-buffer "#chan"
- (erc-cmd-RECONNECT))
- (with-current-buffer "FooNet"
- (funcall expect 10 "This nickname is registered.")
- (funcall expect 3 "You are now identified")
- (with-current-buffer "#chan" ; autojoined
- (funcall expect 10 "the gallants desire it"))
- (erc-cmd-QUIT "")
- (funcall expect 3 "finished")))
-
- (erc-services-mode -1)))
-
-;; The server rejects your nick during registration, so ERC acquires a
-;; placeholder and successfully renicks once the connection is up.
-;; See also `erc-scenarios-base-renick-self-auto'.
-
-(ert-deftest erc-scenarios-services-misc--reconnect-retry-nick ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-server-flood-penalty 0.1)
- (erc-scenarios-common-dialog "services/regain")
- (dumb-server (erc-d-run "localhost" t 'reconnect-retry
- 'reconnect-retry-again))
- (port (process-contact dumb-server :service))
- (erc-server-reconnect-function #'erc-server-delayed-reconnect)
- (erc-server-auto-reconnect t)
- (erc-modules `(services-regain sasl ,@erc-modules))
- (erc-services-regain-alist
- '((Libera.Chat . erc-services-retry-nick-on-connect)))
- (expect (erc-d-t-make-expecter)))
-
- ;; FIXME figure out and explain why this is so.
- (should (featurep 'erc-services))
-
- (ert-info ("Session succeeds but cut short")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :password "changeme"
- :full-name "tester")
- (funcall expect 10 "Last login from")
- (erc-cmd-JOIN "#test")))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#test"))
- (funcall expect 10 "was created on"))
-
- (ert-info ("Service restored")
- (with-current-buffer "Libera.Chat"
- (erc-d-t-wait-for 10 erc--server-reconnect-timer)
- (funcall expect 10 "Connection failed!")
- (funcall expect 10 "already in use")
- (funcall expect 10 "changed mode for tester`")
- (funcall expect 10 "Last login from")
- (funcall expect 10 "Your new nickname is tester")))
-
- (with-current-buffer "#test"
- (funcall expect 10 "tester ")
- (funcall expect 10 "was created on"))))
-
-;; This only asserts that the handler fires and issues the right
-;; NickServ command, but it doesn't accurately recreate a
-;; disconnection, but it probably should.
-(ert-deftest erc-scenarios-services-misc--regain-command ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-server-flood-penalty 0.1)
- (erc-scenarios-common-dialog "services/regain")
- (dumb-server (erc-d-run "localhost" t 'taken-regain))
- (port (process-contact dumb-server :service))
- (erc-server-auto-reconnect t)
- (erc-modules `(services-regain sasl ,@erc-modules))
- (erc-services-regain-alist
- '((ExampleNet . erc-services-issue-regain)))
- (expect (erc-d-t-make-expecter)))
-
- (should (featurep 'erc-services)) ; see note in prior test
-
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "dummy"
- :user "tester"
- :password "changeme"
- :full-name "tester"
- :id 'ExampleNet)
- (funcall expect 10 "dummy is already in use, trying dummy`")
- (funcall expect 10 "You are now logged in as tester")
- (funcall expect 10 "-NickServ- dummy has been regained.")
- (funcall expect 10 "*** Your new nickname is dummy")
- ;; Works with "given" `:id'.
- (should (and (erc-network) (not (eq (erc-network) 'ExampleNet)))))))
-
-(ert-deftest erc-scenarios-services-misc--regain-command/oftc ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-server-flood-penalty 0.1)
- (erc-scenarios-common-dialog "services/regain")
- (dumb-server (erc-d-run "localhost" t 'taken-regain-oftc))
- (port (process-contact dumb-server :service))
- (erc-modules `(services-regain ,@erc-modules))
- (erc-services-regain-timeout-seconds 1)
- (use-id-p (cl-evenp (truncate (float-time))))
- (erc-services-regain-alist (list (cons (if use-id-p 'oftc 'OFTC)
- #'erc-services-issue-regain)))
- (expect (erc-d-t-make-expecter)))
-
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "dummy"
- :user "tester"
- :full-name "tester"
- :id (and use-id-p 'oftc))
- (funcall expect 10 "Nickname dummy is already in use, trying dummy`")
- (funcall expect 10 "-NickServ- REGAIN succeed on nickname")
- (funcall expect 10 "*** Your new nickname is dummy")
- (funcall expect 10 "*** dummy has changed mode for dummy to +R"))))
-
-(ert-deftest erc-scenarios-services-misc--ghost-and-retry-nick ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-server-flood-penalty 0.1)
- (erc-scenarios-common-dialog "services/regain")
- (dumb-server (erc-d-run "localhost" t 'taken-ghost))
- (port (process-contact dumb-server :service))
- (erc-server-auto-reconnect t)
- (erc-modules `(services-regain sasl ,@erc-modules))
- (erc-services-regain-alist
- '((FooNet . erc-services-issue-ghost-and-retry-nick)))
- (expect (erc-d-t-make-expecter)))
-
- (should (featurep 'erc-services)) ; see note in prior test
-
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "dummy"
- :user "tester"
- :password "changeme"
- :full-name "tester")
- (funcall expect 10 "dummy is already in use, trying dummy`")
- (funcall expect 10 "You are now logged in as tester")
- (funcall expect 10 "-NickServ- dummy has been ghosted.")
- (funcall expect 10 "*** Your new nickname is dummy"))))
-
-;;; erc-scenarios-services-misc.el ends here
+++ /dev/null
-;;; erc-scenarios-spelling.el --- Basic spelling scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2025 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-spelling)
-
-(ert-deftest erc-scenarios-spelling--auto-correct ()
- :tags `(:expensive-test
- :unstable
- ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical)))
-
- ;; Allow running locally with SELECTOR=t if user has ispell configured.
- (unless (ignore-errors
- (and (executable-find ispell-program-name)
- (progn (ispell-check-version) t)
- (member "american" (ispell-valid-dictionary-list))))
- (ert-skip "Missing ispell program"))
-
- (ert-with-temp-directory erc-scenarios-spelling
-
- (erc-scenarios-common-with-noninteractive-in-term
- ((erc-scenarios-common-dialog "spelling")
- (process-environment (cons
- (format "HOME=%s" erc-scenarios-spelling)
- process-environment))
- (dumb-server (erc-d-run "localhost" t 'auto-correct))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- (erc-autojoin-channels-alist '((foonet "#chan")))
- (erc-modules (cons 'spelling erc-modules))
- (erc-server-flood-penalty 0.1))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :full-name "tester")
- (funcall expect 10 "no longer marked as being")
- (should erc-spelling-mode)
- (should flyspell-mode)))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (should erc-spelling-mode)
- (should flyspell-mode)
- (funcall expect 10 "<alice> tester, welcome!")
-
- ;; Insert a command with one misspelled word.
- (set-window-buffer nil (current-buffer))
- (execute-kbd-macro "\M->/AMSG an/dor /gmsg one fsbot two frob my shoe")
- (funcall expect 10 "shoe")
-
- (let* ((ovs (overlays-in erc-input-marker (point)))
- (ov1 (pop ovs))
- (ov2 (pop ovs)))
- ;; At this point, flyspell should have done its thing. There
- ;; should be two overlays: one on "dor" and the other on
- ;; "frob". The spelling module's modifications should have
- ;; prevented the two valid slash commands as well as "fsbot"
- ;; from being highlighted.
- (should-not ovs)
- (should (flyspell-overlay-p ov1))
- (should (equal "dor" (buffer-substring (overlay-start ov1)
- (overlay-end ov1))))
- (should (flyspell-overlay-p ov2))
- (should (equal "frob" (buffer-substring (overlay-start ov2)
- (overlay-end ov2))))
- (goto-char (overlay-start ov2))
-
- ;; Depending on the machine, this should become something
- ;; like: "/AMSG an/dor /gmsg one fsbot two Rob my shoe".
- (execute-kbd-macro (key-parse "M-TAB"))
- (should (equal (overlays-in erc-input-marker (point-max))
- (list ov1)))))
-
- (when noninteractive
- (erc-spelling-mode -1)))))
-
-;;; erc-scenarios-spelling.el ends here
+++ /dev/null
-;;; erc-scenarios-stamp.el --- Misc `erc-stamp' scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 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-stamp)
-
-(defvar erc-scenarios-stamp--user-marker nil)
-
-(defun erc-scenarios-stamp--on-post-modify ()
- (when-let (((erc--check-msg-prop 'erc--cmd 4)))
- (set-marker erc-scenarios-stamp--user-marker (point-max))
- (ert-info ("User marker correctly placed at `erc-insert-marker'")
- (should (= ?\n (char-before erc-scenarios-stamp--user-marker)))
- (should (= erc-scenarios-stamp--user-marker erc-insert-marker))
- (save-excursion
- (goto-char erc-scenarios-stamp--user-marker)
- ;; The raw message ends in " Iabefhkloqv". However,
- ;; `erc-server-004' only prints up to the 5th parameter.
- (should (looking-back "CEIMRUabefhiklmnoqstuv\n"))))))
-
-(ert-deftest erc-scenarios-stamp--left/display-margin-mode ()
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/reconnect")
- (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect))
- (port (process-contact dumb-server :service))
- (erc-scenarios-stamp--user-marker (make-marker))
- (erc-stamp--current-time 704591940)
- (erc-stamp--tz t)
- (erc-server-flood-penalty 0.1)
- (erc-insert-timestamp-function #'erc-insert-timestamp-left)
- (erc-modules (cons 'fill-wrap erc-modules))
- (erc-timestamp-only-if-changed-flag nil)
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :full-name "tester"
- :nick "tester")
-
- (add-hook 'erc-insert-post-hook #'erc-scenarios-stamp--on-post-modify
- nil t)
- (funcall expect 5 "This server is in debug mode")
-
- (ert-info ("Stamps appear in left margin and are invisible")
- (should (eq 'erc-timestamp (field-at-pos (pos-bol))))
- (should (= (pos-bol) (field-beginning (pos-bol))))
- (should (eq 'query-notice (get-text-property (pos-bol) 'erc--msg)))
- (should (eq 'NOTICE (get-text-property (pos-bol) 'erc--cmd)))
- (should (= ?- (char-after (field-end (pos-bol)))))
- (should (equal (get-text-property (1+ (field-end (pos-bol)))
- 'erc--speaker)
- "irc.foonet.org"))
- (should (pcase (get-text-property (pos-bol) 'display)
- (`((margin left-margin) ,s)
- (eq 'timestamp (get-text-property 0 'invisible s))))))
-
- ;; We set a third-party marker at the end of 004's message (on
- ;; then "\n"), post-insertion.
- (ert-info ("User markers untouched by subsequent message left stamp")
- (save-excursion
- (goto-char erc-scenarios-stamp--user-marker)
- (should (looking-back "CEIMRUabefhiklmnoqstuv\n"))
- (should (looking-at (rx "[")))))))))
-
-(ert-deftest erc-scenarios-stamp--legacy-date-stamps ()
- (with-suppressed-warnings ((obsolete erc-stamp-prepend-date-stamps-p))
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/reconnect")
- (erc-stamp-prepend-date-stamps-p t)
- (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect))
- (port (process-contact dumb-server :service))
- (erc-server-flood-penalty 0.1)
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :full-name "tester"
- :nick "tester")
- (funcall expect 5 "*** Welcome")
- (goto-char (1- (match-beginning 0)))
- (should (eq 'erc-timestamp (field-at-pos (point))))
- (should (eq 'notice (erc--get-inserted-msg-prop 'erc--msg)))
- ;; Force redraw of date stamp.
- (setq erc-timestamp-last-inserted-left nil)
-
- (funcall expect 5 "This server is in debug mode")
- (while (and (zerop (forward-line -1))
- (not (eq 'erc-timestamp (field-at-pos (point))))))
- (should (erc--get-inserted-msg-prop 'erc--cmd))
- (should-not erc-stamp--date-mode)
- (should-not erc-stamp--date-stamps))))))
-
-;; This user-owned hook member places a marker on the first message in
-;; a buffer. Inserting a date stamp in front of it shouldn't move the
-;; marker.
-(defun erc-scenarios-stamp--on-insert-modify ()
- (unless (marker-position erc-scenarios-stamp--user-marker)
- (set-marker erc-scenarios-stamp--user-marker (point-min))
- (save-excursion
- (goto-char erc-scenarios-stamp--user-marker)
- (should (looking-at "Opening"))))
-
- ;; Sometime after the first message ("Opening connection.."), assert
- ;; that the marker we just placed hasn't moved.
- (when (erc--check-msg-prop 'erc--cmd 2)
- (save-restriction
- (widen)
- (ert-info ("Date stamp preserves opening user marker")
- (goto-char erc-scenarios-stamp--user-marker)
- (should-not (eq 'erc-timestamp (field-at-pos (point))))
- (should (looking-at "Opening"))
- (should (eq 'unknown (get-text-property (point) 'erc--msg))))))
-
- ;; On 003 ("*** This server was created on"), clear state to force a
- ;; new date stamp on the next message.
- (when (erc--check-msg-prop 'erc--cmd 3)
- (setq erc-timestamp-last-inserted-left nil)
- (set-marker erc-scenarios-stamp--user-marker erc-insert-marker)))
-
-(ert-deftest erc-scenarios-stamp--date-mode/left-and-right ()
-
- (should (eq erc-insert-timestamp-function
- #'erc-insert-timestamp-left-and-right))
-
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/reconnect")
- (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect))
- (port (process-contact dumb-server :service))
- (erc-scenarios-stamp--user-marker (make-marker))
- (erc-server-flood-penalty 0.1)
- (erc-modules (if (zerop (random 2))
- (cons 'fill-wrap erc-modules)
- erc-modules))
- (expect (erc-d-t-make-expecter))
- (erc-mode-hook
- (cons (lambda ()
- (add-hook 'erc-insert-modify-hook
- #'erc-scenarios-stamp--on-insert-modify -99 t))
- erc-mode-hook)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :full-name "tester"
- :nick "tester")
-
- (funcall expect 5 "Welcome to the foonet")
- (funcall expect 5 "*** AWAYLEN=390")
-
- (ert-info ("Date stamp preserves other user marker")
- (goto-char erc-scenarios-stamp--user-marker)
- (should-not (eq 'erc-timestamp (field-at-pos (point))))
- (should (looking-at (rx "*** irc.foonet.org oragono")))
- (should (eq 's004 (get-text-property (point) 'erc--msg))))
-
- (funcall expect 5 "This server is in debug mode")))))
-
-;; Assert that only one date stamp per day appears in the server
-;; buffer when reconnecting.
-(ert-deftest erc-scenarios-stamp--date-mode/reconnect ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/reconnect")
- (erc-server-flood-penalty 0.1)
- (erc-stamp--tz t)
- (erc-server-reconnect-function #'erc-server-delayed-reconnect)
- (erc-server-auto-reconnect t)
- ;; Start close to midnight: 2024-06-02T23:58:11.055Z
- (erc-stamp--current-time (if (< emacs-major-version 29)
- '(26205 1811 55000 0)
- '(1717372691055 . 1000)))
- (erc-insert-post-hook (cons (lambda ()
- (setq erc-stamp--current-time
- (time-add erc-stamp--current-time 0.1)))
- erc-insert-post-hook))
- (dumb-server (erc-d-run "localhost" t
- 'unexpected-disconnect 'unexpected-disconnect))
- ;; Define overriding formatting function for catalog entry
- ;; `disconnected' to spoof time progressing past midnight.
- (erc-message-english-disconnected
- (let ((orig erc-message-english-disconnected))
- (lambda (&rest _)
- (setq erc-stamp--current-time
- (time-add erc-stamp--current-time 120))
- orig)))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :full-name "tester")
- (funcall expect 10 "debug mode")))
-
- ;; Ensure date stamps are unique per server buffer.
- (with-current-buffer "FooNet"
- (funcall expect 10 "[Mon Jun 3 2024]")
- (funcall expect -0.1 "[Mon Jun 3 2024]") ; no duplicates
- (funcall expect 10 "[00:00]")
- (funcall expect -0.1 "[00:00]")
- (funcall expect 10 "Welcome to the foonet")
- (delete-process erc-server-process))))
-
-;;; erc-scenarios-stamp.el ends here
+++ /dev/null
-;;; erc-scenarios-status-sidebar.el --- erc-sidebar/speedbar tests -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 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
- (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--get-timers "erc-speedbar" nil)
-(declare-function speedbar-timer-fn "speedbar" nil)
-(defvar erc-nickbar-mode)
-(defvar speedbar-buffer)
-
-;; FIXME move to own file because it takes 20+ seconds, uncompiled.
-(ert-deftest erc-scenarios-status-sidebar--nickbar ()
- :tags `(:expensive-test :unstable ,@(and (getenv "ERC_TESTS_GRAPHICAL")
- '(:erc--graphical)))
- (when (and noninteractive (= emacs-major-version 27))
- (ert-skip "Hangs on Emacs 27, asking for input"))
-
- (erc-scenarios-common-with-noninteractive-in-term
- ((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.
- (call-interactively #'erc-nickbar-mode)
- (should-not erc-nickbar-mode)
- (should-not speedbar-buffer)
- (should-not (get-buffer " SPEEDBAR"))
-
- (erc-nickbar-mode +1)
- (should (and speedbar-buffer (get-buffer-window speedbar-buffer)))
- (should (eq speedbar-buffer (get-buffer " SPEEDBAR")))
- (should (get-buffer " SPEEDBAR"))
-
- (erc-nickbar-mode -1)
- (should-not (get-buffer " SPEEDBAR"))
- (should-not erc-nickbar-mode)
- (should-not (cdr (frame-list)))))
-
- (should-not (erc-speedbar--get-timers))))
-
-;;; erc-scenarios-status-sidebar.el ends here
+++ /dev/null
-;;; erc-services-tests.el --- Tests for erc-services. -*- lexical-binding:t -*-
-
-;; Copyright (C) 2020-2025 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:
-
-;; TODO: move the auth-source tests somewhere else. They've been
-;; stashed here for pragmatic reasons.
-
-;;; Code:
-
-(require 'ert-x)
-(require 'erc-services)
-(require 'erc-compat)
-(require 'secrets)
-
-;;;; Core auth-source
-
-(ert-deftest erc--auth-source-determine-params-merge ()
- (let ((erc-session-server "irc.gnu.org")
- (erc-server-announced-name "my.gnu.org")
- (erc-session-port 6697)
- (erc-network 'fake)
- (erc-server-current-nick "tester")
- (erc-networks--id (erc-networks--id-create 'GNU.chat)))
-
- (should (equal (erc--auth-source-determine-params-merge)
- '(:host ("GNU.chat" "my.gnu.org" "irc.gnu.org")
- :port ("6697" "irc")
- :require (:secret))))
-
- (should (equal (erc--auth-source-determine-params-merge :host "fake")
- '(:host ("fake" "GNU.chat" "my.gnu.org" "irc.gnu.org")
- :port ("6697" "irc")
- :require (:secret))))
-
- (should (equal (erc--auth-source-determine-params-merge
- :host '("fake") :require :host)
- '(:host ("fake" "GNU.chat" "my.gnu.org" "irc.gnu.org")
- :require (:host :secret)
- :port ("6697" "irc"))))
-
- (should (equal (erc--auth-source-determine-params-merge
- :host '("fake" "GNU.chat") :port "1234" :x "x")
- '(:host ("fake" "GNU.chat" "my.gnu.org" "irc.gnu.org")
- :port ("1234" "6697" "irc")
- :x ("x")
- :require (:secret))))))
-
-(defun erc-services-tests--wrap-search (s)
- (lambda (&rest r) (erc--unfun (apply s r))))
-
-;; Some of the following may be related to bug#23438.
-
-(defun erc-services-tests--auth-source-standard (search)
- (setq search (erc-services-tests--wrap-search search))
-
- (ert-info ("Session ID wins")
- (let ((erc-session-server "irc.gnu.org")
- (erc-server-announced-name "my.gnu.org")
- (erc-session-port 6697)
- (erc-network 'fake)
- (erc-server-current-nick "tester")
- (erc-networks--id (erc-networks--id-create 'GNU.chat)))
- (should (string= (funcall search :user "#chan") "foo"))))
-
- (ert-info ("Network wins")
- (let* ((erc-session-server "irc.gnu.org")
- (erc-server-announced-name "my.gnu.org")
- (erc-session-port 6697)
- (erc-network 'GNU.chat)
- (erc-server-current-nick "tester")
- (erc-networks--id (erc-networks--id-create nil)))
- (should (string= (funcall search :user "#chan") "foo"))))
-
- (ert-info ("Announced wins")
- (let ((erc-session-server "irc.gnu.org")
- (erc-server-announced-name "my.gnu.org")
- (erc-session-port 6697)
- (erc-networks--id (erc-networks--id-create nil)))
- (should (string= (funcall search :user "#chan") "baz"))))
-
- (ert-info ("Dialed wins")
- (let ((erc-session-server "irc.gnu.org")
- (erc-session-port 6697)
- (erc-networks--id (erc-networks--id-create nil)))
- (should (string= (funcall search :user "#chan") "bar")))))
-
-(defun erc-services-tests--auth-source-announced (search)
- (setq search (erc-services-tests--wrap-search search))
- (let* ((erc--isupport-params (make-hash-table))
- (erc-server-parameters '(("CHANTYPES" . "&#")))
- (erc--target (erc--target-from-string "&chan")))
-
- ;; Pretend #chan is just some account name and not a channel.
- (ert-info ("Host priorities reversed when target is local")
-
- (ert-info ("Announced wins")
- (let* ((erc-session-server "irc.gnu.org")
- (erc-server-announced-name "my.gnu.org")
- (erc-session-port 6697)
- (erc-network 'GNU.chat)
- (erc-server-current-nick "tester")
- (erc-networks--id (erc-networks--id-create nil)))
- (should (string= (funcall search :user "#chan") "baz"))))
-
- (ert-info ("Dialed next")
- (let* ((erc-server-announced-name "irc.gnu.org")
- (erc-session-port 6697)
- (erc-network 'GNU.chat)
- (erc-server-current-nick "tester")
- (erc-networks--id (erc-networks--id-create nil)))
- (should (string= (funcall search :user "#chan") "bar"))))
-
- (ert-info ("Network used as fallback")
- (let* ((erc-session-port 6697)
- (erc-network 'GNU.chat)
- (erc-server-current-nick "tester")
- (erc-networks--id (erc-networks--id-create nil)))
- (should (string= (funcall search :user "#chan") "foo")))))))
-
-(defun erc-services-tests--auth-source-overrides (search)
- (setq search (erc-services-tests--wrap-search search))
- (let* ((erc-session-server "irc.gnu.org")
- (erc-server-announced-name "my.gnu.org")
- (erc-network 'GNU.chat)
- (erc-server-current-nick "tester")
- (erc-networks--id (erc-networks--id-create nil))
- (erc-session-port 6667))
-
- (ert-info ("Specificity and overrides")
-
- (ert-info ("More specific port")
- (let ((erc-session-port 6697))
- (should (string= (funcall search :user "#chan") "spam"))))
-
- (ert-info ("More specific user (network loses)")
- (should (string= (funcall search :user '("#fsf")) "42")))
-
- (ert-info ("Actual override")
- (should (string= (funcall search :port "6667") "sesame")))
-
- (ert-info ("Overrides don't interfere with post-processing")
- (should (string= (funcall search :host "MyHost") "123"))))))
-
-;; auth-source netrc backend
-
-(defvar erc-services-tests--auth-source-entries
- '("machine irc.gnu.org port irc user \"#chan\" password bar"
- "machine my.gnu.org port irc user \"#chan\" password baz"
- "machine GNU.chat port irc user \"#chan\" password foo"))
-
-;; FIXME explain what this is for
-(defun erc-services-tests--auth-source-shuffle (&rest extra)
- (string-join `(,@(sort (append erc-services-tests--auth-source-entries extra)
- (lambda (&rest _) (zerop (random 2))))
- "")
- "\n"))
-
-(ert-deftest erc--auth-source-search--netrc-standard ()
- (ert-with-temp-file netrc-file
- :prefix "erc--auth-source-search--standard"
- :text (erc-services-tests--auth-source-shuffle)
-
- (let ((auth-sources (list netrc-file))
- (auth-source-do-cache nil))
- (erc-services-tests--auth-source-standard #'erc-auth-source-search))))
-
-(ert-deftest erc--auth-source-search--netrc-announced ()
- (ert-with-temp-file netrc-file
- :prefix "erc--auth-source-search--announced"
- :text (erc-services-tests--auth-source-shuffle)
-
- (let ((auth-sources (list netrc-file))
- (auth-source-do-cache nil))
- (erc-services-tests--auth-source-announced #'erc-auth-source-search))))
-
-(ert-deftest erc--auth-source-search--netrc-overrides ()
- (ert-with-temp-file netrc-file
- :prefix "erc--auth-source-search--overrides"
- :text (erc-services-tests--auth-source-shuffle
- "machine GNU.chat port 6697 user \"#chan\" password spam"
- "machine my.gnu.org port irc user \"#fsf\" password 42"
- "machine irc.gnu.org port 6667 password sesame"
- "machine MyHost port irc password 456"
- "machine MyHost port 6667 password 123")
-
- (let ((auth-sources (list netrc-file))
- (auth-source-do-cache nil))
- (erc-services-tests--auth-source-overrides #'erc-auth-source-search))))
-
-;; auth-source plstore backend
-
-(defun erc-services-test--call-with-plstore (&rest args)
- (advice-add 'epg-decrypt-string :override
- (lambda (&rest r) (prin1-to-string (cadr r)))
- '((name . erc--auth-source-plstore)))
- (advice-add 'epg-find-configuration :override
- (lambda (&rest _) "" '((program . "/bin/true")))
- '((name . erc--auth-source-plstore)))
- (unwind-protect
- (apply #'erc-auth-source-search args)
- (advice-remove 'epg-decrypt-string 'erc--auth-source-plstore)
- (advice-remove 'epg-find-configuration 'erc--auth-source-plstore)))
-
-(defvar erc-services-tests--auth-source-plstore-standard-announced "\
-;;; public entries -*- mode: plstore -*-
-((\"ba950d38118a76d71f9f0591bb373d6cb366a512\"
- :secret-secret t
- :host \"irc.gnu.org\"
- :user \"#chan\"
- :port \"irc\")
- (\"7f17ca445d11158065e911a6d0f4cbf52ca250e3\"
- :secret-secret t
- :host \"my.gnu.org\"
- :user \"#chan\"
- :port \"irc\")
- (\"fcd3c8bd6daf4509de0ad6ee98e744ce0fca9377\"
- :secret-secret t
- :host \"GNU.chat\"
- :user \"#chan\"
- :port \"irc\"))
-;;; secret entries
-((\"ba950d38118a76d71f9f0591bb373d6cb366a512\" :secret \"bar\")
- (\"7f17ca445d11158065e911a6d0f4cbf52ca250e3\" :secret \"baz\")
- (\"fcd3c8bd6daf4509de0ad6ee98e744ce0fca9377\" :secret \"foo\"))")
-
-(ert-deftest erc--auth-source-search--plstore-standard ()
- (ert-with-temp-file plstore-file
- :suffix ".plist"
- :text erc-services-tests--auth-source-plstore-standard-announced
- (let ((auth-sources (list plstore-file))
- (auth-source-do-cache nil))
- (erc-services-tests--auth-source-standard
- #'erc-services-test--call-with-plstore))
- (kill-buffer (get-file-buffer plstore-file))))
-
-(ert-deftest erc--auth-source-search--plstore-announced ()
- (ert-with-temp-file plstore-file
- :suffix ".plist"
- :text erc-services-tests--auth-source-plstore-standard-announced
- (let ((auth-sources (list plstore-file))
- (auth-source-do-cache nil))
- (erc-services-tests--auth-source-announced
- #'erc-services-test--call-with-plstore))
- (kill-buffer (get-file-buffer plstore-file))))
-
-(ert-deftest erc--auth-source-search--plstore-overrides ()
- (ert-with-temp-file plstore-file
- :suffix ".plist"
- :text "\
-;;; public entries -*- mode: plstore -*-
-((\"ba950d38118a76d71f9f0591bb373d6cb366a512\"
- :secret-secret t :host \"irc.gnu.org\" :user \"#chan\" :port \"irc\")
- (\"7f17ca445d11158065e911a6d0f4cbf52ca250e3\"
- :secret-secret t :host \"my.gnu.org\" :user \"#chan\" :port \"irc\")
- (\"fcd3c8bd6daf4509de0ad6ee98e744ce0fca9377\"
- :secret-secret t :host \"GNU.chat\" :user \"#chan\" :port \"irc\")
- (\"1b3fab249a8dff77a4d8fe7eb4b0171b25cc711a\"
- :secret-secret t :host \"GNU.chat\" :user \"#chan\" :port \"6697\")
- (\"6cbcdc39476b8cfcca6f3e9a7876f41ec3f708cc\"
- :secret-secret t :host \"my.gnu.org\" :user \"#fsf\" :port \"irc\")
- (\"a33e2b3bd2d6f33995a4b88710a594a100c5e41d\"
- :secret-secret t :host \"irc.gnu.org\" :port \"6667\")
- (\"ab2fd349b2b7d6a9215bb35a92d054261b0b1537\"
- :secret-secret t :host \"MyHost\" :port \"irc\")
- (\"61a6bd552059494f479ff720e8de33e22574650a\"
- :secret-secret t :host \"MyHost\" :port \"6667\"))
-;;; secret entries
-((\"ba950d38118a76d71f9f0591bb373d6cb366a512\" :secret \"bar\")
- (\"7f17ca445d11158065e911a6d0f4cbf52ca250e3\" :secret \"baz\")
- (\"fcd3c8bd6daf4509de0ad6ee98e744ce0fca9377\" :secret \"foo\")
- (\"1b3fab249a8dff77a4d8fe7eb4b0171b25cc711a\" :secret \"spam\")
- (\"6cbcdc39476b8cfcca6f3e9a7876f41ec3f708cc\" :secret \"42\")
- (\"a33e2b3bd2d6f33995a4b88710a594a100c5e41d\" :secret \"sesame\")
- (\"ab2fd349b2b7d6a9215bb35a92d054261b0b1537\" :secret \"456\")
- (\"61a6bd552059494f479ff720e8de33e22574650a\" :secret \"123\"))"
-
- (let ((auth-sources (list plstore-file))
- (auth-source-do-cache nil))
- (erc-services-tests--auth-source-overrides
- #'erc-services-test--call-with-plstore))
- (kill-buffer (get-file-buffer plstore-file))))
-
-;; auth-source JSON backend
-
-(defvar erc-services-tests--auth-source-json-standard-announced "\
-[{\"host\": \"irc.gnu.org\",
- \"port\": \"irc\",
- \"user\": \"#chan\",
- \"secret\": \"bar\"},
- {\"host\": \"my.gnu.org\",
- \"port\": \"irc\",
- \"user\": \"#chan\",
- \"secret\": \"baz\"},
- {\"host\": \"GNU.chat\",
- \"port\": \"irc\",
- \"user\": \"#chan\",
- \"secret\": \"foo\"}]")
-
-(ert-deftest erc--auth-source-search--json-standard ()
- (ert-with-temp-file json-store
- :text erc-services-tests--auth-source-json-standard-announced
- :suffix ".json"
- (let ((auth-sources (list json-store))
- (auth-source-do-cache nil))
- (erc-services-tests--auth-source-standard #'erc-auth-source-search))))
-
-(ert-deftest erc--auth-source-search--json-announced ()
- (ert-with-temp-file plstore-file
- :suffix ".json"
- :text erc-services-tests--auth-source-json-standard-announced
- (let ((auth-sources (list plstore-file))
- (auth-source-do-cache nil))
- (erc-services-tests--auth-source-announced #'erc-auth-source-search))))
-
-(ert-deftest erc--auth-source-search--json-overrides ()
- (ert-with-temp-file json-file
- :suffix ".json"
- :text "\
-[{\"host\": \"irc.gnu.org\",
- \"port\": \"irc\",
- \"user\": \"#chan\",
- \"secret\": \"bar\"},
- {\"host\": \"my.gnu.org\",
- \"port\": \"irc\",
- \"user\": \"#chan\",
- \"secret\": \"baz\"},
- {\"host\": \"GNU.chat\",
- \"port\": \"irc\",
- \"user\": \"#chan\",
- \"secret\": \"foo\"},
- {\"host\": \"GNU.chat\",
- \"user\": \"#chan\",
- \"port\": \"6697\",
- \"secret\": \"spam\"},
- {\"host\": \"my.gnu.org\",
- \"user\": \"#fsf\",
- \"port\": \"irc\",
- \"secret\": \"42\"},
- {\"host\": \"irc.gnu.org\",
- \"port\": \"6667\",
- \"secret\": \"sesame\"},
- {\"host\": \"MyHost\",
- \"port\": \"irc\",
- \"secret\": \"456\"},
- {\"host\": \"MyHost\",
- \"port\": \"6667\",
- \"secret\": \"123\"}]"
- (let ((auth-sources (list json-file))
- (auth-source-do-cache nil))
- (erc-services-tests--auth-source-overrides #'erc-auth-source-search))))
-
-;; auth-source-secrets backend
-
-(defvar erc-services-tests--auth-source-secrets-standard-entries
- '(("#chan@irc.gnu.org:irc" ; label
- (:host . "irc.gnu.org")
- (:user . "#chan")
- (:port . "irc")
- (:xdg:schema . "org.freedesktop.Secret.Generic"))
- ("#chan@my.gnu.org:irc"
- (:host . "my.gnu.org")
- (:user . "#chan")
- (:port . "irc")
- (:xdg:schema . "org.freedesktop.Secret.Generic"))
- ("#chan@GNU.chat:irc"
- (:host . "GNU.chat")
- (:user . "#chan")
- (:port . "irc")
- (:xdg:schema . "org.freedesktop.Secret.Generic"))))
-
-(defvar erc-services-tests--auth-source-secrets-standard-secrets
- '(("#chan@irc.gnu.org:irc" . "bar")
- ("#chan@my.gnu.org:irc" . "baz")
- ("#chan@GNU.chat:irc" . "foo")))
-
-(defun erc-services-tests--secrets-search-items (entries _ &rest r)
- (mapcan (lambda (s)
- (and (seq-every-p (pcase-lambda (`(,k . ,v))
- (equal v (alist-get k (cdr s))))
- (map-pairs r))
- (list (car s))))
- entries))
-
-(ert-deftest erc--auth-source-search--secrets-standard ()
- (skip-unless (bound-and-true-p secrets-enabled))
- (let ((auth-sources '("secrets:Test"))
- (auth-source-do-cache nil)
- (entries erc-services-tests--auth-source-secrets-standard-entries)
- (secrets erc-services-tests--auth-source-secrets-standard-secrets))
-
- (cl-letf (((symbol-function 'secrets-search-items)
- (apply-partially #'erc-services-tests--secrets-search-items
- entries))
- ((symbol-function 'secrets-get-secret)
- (lambda (_ label) (assoc-default label secrets)))
- ((symbol-function 'secrets-get-attributes)
- (lambda (_ label) (assoc-default label entries))))
-
- (erc-services-tests--auth-source-standard #'erc-auth-source-search))))
-
-(ert-deftest erc--auth-source-search--secrets-announced ()
- (skip-unless (bound-and-true-p secrets-enabled))
- (let ((auth-sources '("secrets:Test"))
- (auth-source-do-cache nil)
- (entries erc-services-tests--auth-source-secrets-standard-entries)
- (secrets erc-services-tests--auth-source-secrets-standard-secrets))
-
- (cl-letf (((symbol-function 'secrets-search-items)
- (apply-partially #'erc-services-tests--secrets-search-items
- entries))
- ((symbol-function 'secrets-get-secret)
- (lambda (_ label) (assoc-default label secrets)))
- ((symbol-function 'secrets-get-attributes)
- (lambda (_ label) (assoc-default label entries))))
-
- (erc-services-tests--auth-source-announced #'erc-auth-source-search))))
-
-(ert-deftest erc--auth-source-search--secrets-overrides ()
- (skip-unless (bound-and-true-p secrets-enabled))
- (let ((auth-sources '("secrets:Test"))
- (auth-source-do-cache nil)
- (entries `(,@erc-services-tests--auth-source-secrets-standard-entries
- ("#chan@GNU.chat:6697"
- (:host . "GNU.chat") (:user . "#chan") (:port . "6697")
- (:xdg:schema . "org.freedesktop.Secret.Generic"))
- ("#fsf@my.gnu.org:irc"
- (:host . "my.gnu.org") (:user . "#fsf") (:port . "irc")
- (:xdg:schema . "org.freedesktop.Secret.Generic"))
- ("irc.gnu.org:6667"
- (:host . "irc.gnu.org") (:port . "6667")
- (:xdg:schema . "org.freedesktop.Secret.Generic"))
- ("MyHost:irc"
- (:host . "MyHost") (:port . "irc")
- (:xdg:schema . "org.freedesktop.Secret.Generic"))
- ("MyHost:6667"
- (:host . "MyHost") (:port . "6667")
- (:xdg:schema . "org.freedesktop.Secret.Generic"))))
- (secrets `(,@erc-services-tests--auth-source-secrets-standard-secrets
- ("#chan@GNU.chat:6697" . "spam")
- ("#fsf@my.gnu.org:irc" . "42" )
- ("irc.gnu.org:6667" . "sesame")
- ("MyHost:irc" . "456")
- ("MyHost:6667" . "123"))))
-
- (cl-letf (((symbol-function 'secrets-search-items)
- (apply-partially #'erc-services-tests--secrets-search-items
- entries))
- ((symbol-function 'secrets-get-secret)
- (lambda (_ label) (assoc-default label secrets)))
- ((symbol-function 'secrets-get-attributes)
- (lambda (_ label) (assoc-default label entries))))
-
- (erc-services-tests--auth-source-overrides #'erc-auth-source-search))))
-
-;; auth-source-pass backend
-
-(require 'auth-source-pass)
-
-;; `auth-source-pass--find-match-unambiguous' returns something like:
-;;
-;; (list :host "irc.gnu.org"
-;; :port "6697"
-;; :user "rms"
-;; :secret
-;; #[0 "\301\302\300\"\207"
-;; [((secret . "freedom")) auth-source-pass--get-attr secret] 3])
-;;
-;; This function gives ^ (faked here to avoid gpg and file IO). See
-;; `auth-source-pass--with-store' in ../auth-source-pass-tests.el
-(defun erc-services-tests--asp-parse-entry (store entry)
- (when-let ((found (cl-find entry store :key #'car :test #'string=)))
- (list (assoc 'secret (cdr found)))))
-
-(defvar erc-join-tests--auth-source-pass-entries
- '(("irc.gnu.org:irc/#chan" (secret . "bar"))
- ("my.gnu.org:irc/#chan" (secret . "baz"))
- ("GNU.chat:irc/#chan" (secret . "foo"))))
-
-(ert-deftest erc--auth-source-search--pass-standard ()
- (let ((store erc-join-tests--auth-source-pass-entries)
- (auth-sources '(password-store))
- (auth-source-do-cache nil))
-
- (cl-letf (((symbol-function 'auth-source-pass-parse-entry)
- (apply-partially #'erc-services-tests--asp-parse-entry store))
- ((symbol-function 'auth-source-pass-entries)
- (lambda () (mapcar #'car store))))
-
- (erc-services-tests--auth-source-standard #'erc-auth-source-search))))
-
-(ert-deftest erc--auth-source-search--pass-announced ()
- (let ((store erc-join-tests--auth-source-pass-entries)
- (auth-sources '(password-store))
- (auth-source-do-cache nil))
-
- (cl-letf (((symbol-function 'auth-source-pass-parse-entry)
- (apply-partially #'erc-services-tests--asp-parse-entry store))
- ((symbol-function 'auth-source-pass-entries)
- (lambda () (mapcar #'car store))))
-
- (erc-services-tests--auth-source-announced #'erc-auth-source-search))))
-
-(ert-deftest erc--auth-source-search--pass-overrides ()
- (let ((store
- `(,@erc-join-tests--auth-source-pass-entries
- ("GNU.chat:6697/#chan" (secret . "spam"))
- ("my.gnu.org:irc/#fsf" (secret . "42"))
- ("irc.gnu.org:6667" (secret . "sesame"))
- ("MyHost:irc" (secret . "456"))
- ("MyHost:6667" (secret . "123"))))
- (auth-sources '(password-store))
- (auth-source-do-cache nil))
-
- (cl-letf (((symbol-function 'auth-source-pass-parse-entry)
- (apply-partially #'erc-services-tests--asp-parse-entry store))
- ((symbol-function 'auth-source-pass-entries)
- (lambda () (mapcar #'car store))))
-
- (erc-services-tests--auth-source-overrides #'erc-auth-source-search))))
-
-;;;; The services module
-
-(ert-deftest erc-nickserv-get-password ()
- (should erc-prompt-for-nickserv-password)
- (ert-with-temp-file netrc-file
- :prefix "erc-nickserv-get-password"
- :text (mapconcat 'identity
- '("machine GNU/chat port 6697 user bob password spam"
- "machine FSF.chat port 6697 user bob password sesame"
- "machine MyHost port irc password 123")
- "\n")
-
- (let* ((auth-sources (list netrc-file))
- (auth-source-do-cache nil)
- (erc-nickserv-passwords '((FSF.chat (("alice" . "foo")
- ("joe" . "bar")))))
- (erc-use-auth-source-for-nickserv-password t)
- (erc-session-server "irc.gnu.org")
- (erc-server-announced-name "my.gnu.org")
- (erc-network 'FSF.chat)
- (erc-server-current-nick "tester")
- (erc-networks--id (erc-networks--id-create nil))
- (erc-session-port 6697)
- (search (erc-services-tests--wrap-search
- #'erc-nickserv-get-password)))
-
- (ert-info ("Lookup custom option")
- (should (string= (funcall search "alice") "foo")))
-
- (ert-info ("Auth source")
- (ert-info ("Network")
- (should (string= (funcall search "bob") "sesame")))
-
- (ert-info ("Network ID")
- (let ((erc-networks--id (erc-networks--id-create 'GNU/chat)))
- (should (string= (funcall search "bob") "spam")))))
-
- (ert-info ("Read input")
- (should (string=
- (ert-simulate-keys "baz\r" (erc-nickserv-get-password "mike"))
- "baz")))
-
- (ert-info ("Failed")
- (should-not (ert-simulate-keys "\r"
- (erc-nickserv-get-password "fake")))))))
-
-
-;;; erc-services-tests.el ends here
+++ /dev/null
-;;; erc-stamp-tests.el --- Tests for erc-stamp. -*- lexical-binding:t -*-
-
-;; Copyright (C) 2023-2025 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-;;
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; GNU Emacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-(require 'erc-stamp)
-(require 'erc-goodies) ; for `erc-make-read-only'
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-tests-common)))
-
-;; These display-oriented tests are brittle because many factors
-;; influence how text properties are applied. We should just
-;; rework these into full scenarios.
-
-(defun erc-stamp-tests--insert-right (test)
- (let ((val (list 0 0))
- (erc-insert-modify-hook '(erc-add-timestamp))
- (erc-insert-post-hook '(erc-make-read-only)) ; see comment above
- (erc-timestamp-only-if-changed-flag nil)
- ;;
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
-
- (advice-add 'erc-format-timestamp :filter-args
- (lambda (args) (cons (cl-incf (cadr val) 60) (cdr args)))
- '((name . ert-deftest--erc-timestamp-use-align-to)))
-
- (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*")
- (erc-mode)
- (erc-stamp--manage-local-options-state)
- (erc--initialize-markers (point) nil)
- (erc-tests-common-init-server-proc "sleep" "1")
-
- (funcall test)
-
- (when noninteractive
- (kill-buffer)))
-
- (advice-remove 'erc-format-timestamp
- 'ert-deftest--erc-timestamp-use-align-to)))
-
-(defun erc-stamp-tests--use-align-to--nil (compat)
- (erc-stamp-tests--insert-right
- (lambda ()
-
- (ert-info ("nil, normal")
- (let ((erc-timestamp-use-align-to nil))
- (erc-display-message nil 'notice (current-buffer) "begin"))
- (goto-char (point-min))
- (should (search-forward-regexp
- (rx "begin" (+ "\t") (* " ") "[") nil t))
- ;; Field includes intervening spaces
- (should (eql ?n (char-before (field-beginning (point)))))
- ;; Timestamp extends to the end of the line
- (should (eql ?\n (char-after (field-end (point))))))
-
- ;; The option `erc-timestamp-right-column' is normally nil by
- ;; default, but it's a convenient stand in for a sufficiently
- ;; small `erc-fill-column' (we can force a line break without
- ;; involving that module).
- (should-not erc-timestamp-right-column)
-
- (ert-info ("nil, overlong (hard wrap)")
- (let ((erc-timestamp-use-align-to nil)
- (erc-timestamp-right-column 20))
- (erc-display-message nil 'notice (current-buffer)
- "twenty characters"))
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
- ;; Field includes leading whitespace.
- (should (eql (if compat ?\[ ?\n)
- (char-after (field-beginning (point)))))
- ;; Timestamp extends to the end of the line.
- (should (eql ?\n (char-after (field-end (point)))))))))
-
-(ert-deftest erc-timestamp-use-align-to--nil ()
- (ert-info ("Field starts on stamp text (compat)")
- (let ((erc-stamp--omit-properties-on-folded-lines t))
- (erc-stamp-tests--use-align-to--nil 'compat)))
- (ert-info ("Field includes leaidng white space")
- (erc-stamp-tests--use-align-to--nil nil)))
-
-(defun erc-stamp-tests--use-align-to--t (compat)
- (erc-stamp-tests--insert-right
- (lambda ()
-
- (ert-info ("t, normal")
- (let ((erc-timestamp-use-align-to t))
- (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
- (erc-display-message nil nil (current-buffer) msg)))
- (goto-char (point-min))
- ;; Exactly two spaces, one from format, one added by erc-stamp.
- (should (search-forward "msg one [" nil t))
- ;; Field covers space between.
- (should (eql ?e (char-before (field-beginning (point)))))
- (should (eql ?\n (char-after (field-end (point))))))
-
- (ert-info ("t, overlong (hard wrap)")
- (let ((erc-timestamp-use-align-to t)
- (erc-timestamp-right-column 20))
- (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
- (erc-display-message nil nil (current-buffer) msg)))
- ;; Indented to pos (this is arguably a bug).
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
- ;; Field includes leading space.
- (should (eql (if compat ?\[ ?\n) (char-after (field-beginning (point)))))
- (should (eql ?\n (char-after (field-end (point)))))))))
-
-(ert-deftest erc-timestamp-use-align-to--t ()
- (ert-info ("Field starts on stamp text (compat)")
- (let ((erc-stamp--omit-properties-on-folded-lines t))
- (erc-stamp-tests--use-align-to--t 'compat)))
- (ert-info ("Field includes leaidng white space")
- (erc-stamp-tests--use-align-to--t nil)))
-
-(ert-deftest erc-timestamp-use-align-to--integer ()
- (erc-stamp-tests--insert-right
- (lambda ()
-
- (ert-info ("integer, normal")
- (let ((erc-timestamp-use-align-to 1))
- (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
- (erc-display-message nil nil (current-buffer) msg)))
- (goto-char (point-min))
- ;; Space not added because included in format string.
- (should (search-forward "msg one [" nil t))
- ;; Field covers space between.
- (should (eql ?e (char-before (field-beginning (point)))))
- (should (eql ?\n (char-after (field-end (point))))))
-
- (ert-info ("integer, overlong (hard wrap)")
- (let ((erc-timestamp-use-align-to 1)
- (erc-timestamp-right-column 20))
- (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
- (erc-display-message nil nil (current-buffer) msg)))
- ;; No hard wrap
- (should (search-forward "oooo [" nil t))
- ;; Field starts at leading space.
- (should (eql ?\s (char-after (field-beginning (point)))))
- (should (eql ?\n (char-after (field-end (point)))))))))
-
-(ert-deftest erc-stamp--display-margin-mode--right ()
- (erc-stamp-tests--insert-right
- (lambda ()
- (erc-stamp--display-margin-mode +1)
-
- (ert-info ("margin, normal")
- (let ((erc-timestamp-use-align-to 'margin))
- (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
- (put-text-property 0 (length msg) 'wrap-prefix 10 msg)
- (erc-display-message nil nil (current-buffer) msg)))
- (goto-char (point-min))
- ;; Leading space added as part of the stamp's field.
- (should (search-forward "msg one [" nil t))
- ;; Field covers stamp and space.
- (should (eql ?e (char-before (field-beginning (point)))))
- ;; Vanity props extended.
- (should (get-text-property (field-beginning (point)) 'wrap-prefix))
- (should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix))
- (should (get-text-property (1- (field-end (point))) 'wrap-prefix))
- (should (eql ?\n (char-after (field-end (point))))))
-
- (ert-info ("margin, overlong (hard wrap)")
- (let ((erc-timestamp-use-align-to 'margin)
- (erc-timestamp-right-column 20))
- (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
- (erc-display-message nil nil (current-buffer) msg)))
- ;; No hard wrap.
- (should (search-forward "oooo [" nil t))
- ;; Field starts at managed space before format string.
- (should (eql ?\s (char-after (field-beginning (point)))))
- (should (eql ?\n (char-after (field-end (point)))))))))
-
-;; This concerns a proposed partial reversal of the changes resulting
-;; from:
-;;
-;; 24.1.50; Wrong behavior of move-end-of-line in ERC (Bug#11706)
-;;
-;; Perhaps core behavior has changed since this bug was reported, but
-;; C-e stopping one char short of EOL no longer seems a problem.
-;; However, invoking C-n (`next-line') exhibits a similar effect.
-;; When point is in a stamp or near the beginning of a line, issuing a
-;; C-n puts point one past the start of the message (i.e., two chars
-;; beyond the timestamp's closing "]". Dropping the invisible
-;; property when timestamps are hidden does indeed prevent this, but
-;; it's also a lasting commitment. The docs mention that it's
-;; pointless to pair the old `intangible' property with `invisible'
-;; and suggest users look at `cursor-intangible-mode'. Turning off
-;; the latter does indeed do the trick as does decrementing the end of
-;; the `cursor-intangible' interval so that, in addition to C-n
-;; working, a C-f from before the timestamp doesn't overshoot. This
-;; appears to be the case whether `erc-hide-timestamps' is enabled or
-;; not, but it may be inadvisable for some reason (a hack) and
-;; therefore warrants further investigation.
-;;
-;; Note some striking omissions here:
-;;
-;; 1. a lack of `fill' module integration (we simulate it by
-;; making lines short enough to not wrap)
-;; 2. functions like `line-move' behave differently when
-;; `noninteractive'
-;; 3. no actual test assertions involving `cursor-sensor' movement
-;; even though that's a huge ingredient
-
-(ert-deftest erc-timestamp-intangible--left ()
- (let ((erc-timestamp-only-if-changed-flag nil)
- (erc-timestamp-intangible t) ; default changed to nil in 2014
- (erc-hide-timestamps t)
- (erc-insert-timestamp-function 'erc-insert-timestamp-left)
- (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp))
- msg
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
- (should (not cursor-sensor-inhibit))
-
- (erc-mode)
- (erc-tests-common-init-server-proc "true")
- (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*")
- (erc-mode)
- (erc--initialize-markers (point) nil)
- (erc-stamp--manage-local-options-state)
- (erc-display-message nil 'notice (current-buffer) "Welcome")
- ;;
- ;; Pretend `fill' is active and that these lines are
- ;; folded. Otherwise, there's an annoying issue on wrapped lines
- ;; (when visual-line-mode is off and stamps are visible) where
- ;; C-e sends you to the end of the previous line.
- (setq msg "Lorem ipsum dolor sit amet")
- (erc-display-message nil nil (current-buffer)
- (erc-format-privmessage "alyssa" msg nil t))
- (erc-display-message nil 'notice (current-buffer) "Home")
- (goto-char (point-min))
-
- ;; EOL is actually EOL (Bug#11706)
-
- (ert-info ("Notice before stamp, C-e") ; first line/stamp
- (should (search-forward "Welcome" nil t))
- (ert-simulate-command '(erc-bol))
- (should (looking-at (rx "[")))
- (let ((end (pos-eol))) ; `line-end-position' fails because fields
- (ert-simulate-command '(move-end-of-line 1))
- (should (= end (point)))))
-
- (ert-info ("Privmsg before stamp, C-e")
- (should (search-forward "Lorem" nil t))
- (goto-char (pos-bol))
- (should (looking-at (rx "[")))
- (let ((end (pos-eol)))
- (ert-simulate-command '(move-end-of-line 1))
- (should (= end (point)))))
-
- (ert-info ("Privmsg first line, C-e")
- (goto-char (pos-bol))
- (should (search-forward "ipsum" nil t))
- (let ((end (pos-eol)))
- (ert-simulate-command '(move-end-of-line 1))
- (should (= end (point)))))
-
- (when noninteractive
- (kill-buffer)))))
-
-(ert-deftest erc-echo-timestamp ()
- :tags (and (null (getenv "CI")) '(:unstable))
-
- (should-not erc-echo-timestamps)
- (should-not erc-stamp--last-stamp)
- (insert (propertize "a" 'erc--ts 433483200 'erc--msg 'msg) "bc")
- (goto-char (point-min))
- (let ((inhibit-message t)
- (erc-echo-timestamp-format "%Y-%m-%d %H:%M:%S %Z")
- (erc-echo-timestamp-zone (list (* 60 60 -4) "EDT")))
-
- ;; No-op when non-interactive and option is nil
- (should-not (erc--echo-ts-csf nil nil 'entered))
- (should-not erc-stamp--last-stamp)
-
- ;; Non-interactive (cursor sensor function)
- (let ((erc-echo-timestamps t))
- (should (equal (erc--echo-ts-csf nil nil 'entered)
- "1983-09-27 00:00:00 EDT")))
- (should (= 433483200 erc-stamp--last-stamp))
-
- ;; Interactive
- (should (equal (call-interactively #'erc-echo-timestamp)
- "1983-09-27 00:00:00 EDT"))
- ;; Interactive with zone
- (let ((current-prefix-arg '(4)))
- (should (member (call-interactively #'erc-echo-timestamp)
- '("1983-09-27 04:00:00 GMT"
- "1983-09-27 04:00:00 UTC"))))
- (let ((current-prefix-arg -7))
- (should (equal (call-interactively #'erc-echo-timestamp)
- "1983-09-26 21:00:00 -07")))))
-
-(defun erc-stamp-tests--assert-get-inserted-msg/stamp (test-fn)
- (let ((erc-insert-modify-hook erc-insert-modify-hook)
- (erc-insert-timestamp-function 'erc-insert-timestamp-right)
- (erc-timestamp-use-align-to 0)
- (erc-timestamp-format "[00:00]"))
- (cl-pushnew 'erc-add-timestamp erc-insert-modify-hook)
- (erc-tests-common-get-inserted-msg-setup))
- (goto-char 19)
- (should (looking-back (rx "<bob> hi [00:00]")))
- (erc-tests-common-assert-get-inserted-msg 3 19 test-fn))
-
-(ert-deftest erc--get-inserted-msg-beg/stamp ()
- (erc-stamp-tests--assert-get-inserted-msg/stamp
- (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))
-
-(ert-deftest erc--get-inserted-msg-beg/readonly/stamp ()
- (erc-tests-common-assert-get-inserted-msg-readonly-with
- #'erc-stamp-tests--assert-get-inserted-msg/stamp
- (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))
-
-(ert-deftest erc--get-inserted-msg-end/stamp ()
- (erc-stamp-tests--assert-get-inserted-msg/stamp
- (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg))))))
-
-(ert-deftest erc--get-inserted-msg-end/readonly/stamp ()
- (erc-tests-common-assert-get-inserted-msg-readonly-with
- #'erc-stamp-tests--assert-get-inserted-msg/stamp
- (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg))))))
-
-(ert-deftest erc--get-inserted-msg-bounds/stamp ()
- (erc-stamp-tests--assert-get-inserted-msg/stamp
- (lambda (arg)
- (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg))))))
-
-(ert-deftest erc--get-inserted-msg-bounds/readonly/stamp ()
- (erc-tests-common-assert-get-inserted-msg-readonly-with
- #'erc-stamp-tests--assert-get-inserted-msg/stamp
- (lambda (arg)
- (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg))))))
-
-(ert-deftest erc-stamp--dedupe-date-stamps-from-target-buffer ()
- (unless (>= emacs-major-version 29)
- (ert-skip "Requires hz-ticks lisp time format"))
- (let ((erc-modules erc-modules)
- (erc-stamp--tz t))
- (erc-tests-common-make-server-buf)
- (erc-stamp-mode +1)
-
- ;; Create two buffers with an overlapping date stamp.
- (with-current-buffer (erc--open-target "#chan@old")
- (let ((erc-stamp--current-time '(1690761600001 . 1000)))
- (erc-tests-common-display-message nil 'notice (current-buffer)
- "2023-07-31T00:00:00.001Z"))
- (let ((erc-stamp--current-time '(1690761601001 . 1000)))
- (erc-tests-common-display-message nil 'notice (current-buffer) "0.0"))
-
- (let ((erc-stamp--current-time '(1690848000001 . 1000)))
- (erc-tests-common-display-message nil 'notice (current-buffer)
- "2023-08-01T00:00:00.001Z"))
- (let ((erc-stamp--current-time '(1690848001001 . 1000)))
- (erc-tests-common-display-message nil 'notice (current-buffer) "1.0"))
- (let ((erc-stamp--current-time '(1690848060001 . 1000)))
- (erc-tests-common-display-message nil 'notice (current-buffer) "1.1"))
-
- (let ((erc-stamp--current-time '(1690934400001 . 1000)))
- (erc-tests-common-display-message nil 'notice (current-buffer)
- "2023-08-02T00:00:00.001Z"))
- (let ((erc-stamp--current-time '(1690934401001 . 1000)))
- (erc-tests-common-display-message nil 'notice (current-buffer) "2.0"))
- (let ((erc-stamp--current-time '(1690956000001 . 1000)))
- (erc-tests-common-display-message nil 'notice (current-buffer) "2.6")))
-
- (with-current-buffer (erc--open-target "#chan@new")
- (let ((erc-stamp--current-time '(1690956001001 . 1000)))
- (erc-tests-common-display-message nil 'notice (current-buffer)
- "2023-08-02T06:00:01.001Z"))
- (let ((erc-stamp--current-time '(1690963200001 . 1000)))
- (erc-tests-common-display-message nil 'notice (current-buffer) "2.8"))
-
- (let ((erc-stamp--current-time '(1691020800001 . 1000)))
- (erc-tests-common-display-message nil 'notice (current-buffer)
- "2023-08-03T00:00:00.001Z"))
- (let ((erc-stamp--current-time '(1691020801001 . 1000)))
- (erc-tests-common-display-message nil 'notice (current-buffer) "3.0"))
- (let ((erc-stamp--current-time '(1691053200001 . 1000)))
- (erc-tests-common-display-message nil 'notice (current-buffer) "3.9"))
-
- (let ((erc-stamp--current-time '(1691107200001 . 1000)))
- (erc-tests-common-display-message nil 'notice (current-buffer)
- "2023-08-04T00:00:00.001Z"))
- (let ((erc-stamp--current-time '(1691107201001 . 1000)))
- (erc-tests-common-display-message nil 'notice (current-buffer) "4.0"))
- (let ((erc-stamp--current-time '(1691110800001 . 1000)))
- (erc-tests-common-display-message nil 'notice (current-buffer) "4.1")))
-
- (erc-stamp--dedupe-date-stamps-from-target-buffer
- #'erc-networks--transplant-buffer-content
- (get-buffer "#chan@old")
- (get-buffer "#chan@new"))
-
- ;; Ensure the "model", `erc-stamp--date-stamps', matches reality
- ;; in the buffer's contents.
- (with-current-buffer "#chan@new"
- (let ((stamps erc-stamp--date-stamps))
- (goto-char 3)
- (should (looking-at (rx "\n[Mon Jul 31 2023]")))
- (should (= (erc--get-inserted-msg-beg (point))
- (erc-stamp--date-marker (pop stamps))))
- (goto-char (1+ (match-end 0)))
- (should (looking-at (rx "*** 2023-07-31T00:00:00.001Z")))
- (forward-line 1)
- (should (looking-at (rx "*** 0.0")))
- (forward-line 1)
-
- (should (looking-at (rx "\n[Tue Aug 1 2023]")))
- (should (= (erc--get-inserted-msg-beg (point))
- (erc-stamp--date-marker (pop stamps))))
- (goto-char (1+ (match-end 0)))
- (should (looking-at (rx "*** 2023-08-01T00:00:00.001Z")))
- (forward-line 1)
- (should (looking-at (rx "*** 1.0")))
- (forward-line 1)
- (should (looking-at (rx "*** 1.1")))
- (forward-line 1)
-
- (should (looking-at (rx "\n[Wed Aug 2 2023]")))
- (should (= (erc--get-inserted-msg-beg (point))
- (erc-stamp--date-marker (pop stamps))))
- (goto-char (1+ (match-end 0)))
- (should (looking-at (rx "*** 2023-08-02T00:00:00.001Z")))
- (forward-line 1)
- (should (looking-at (rx "*** 2.0")))
- (forward-line 1)
- (should (looking-at (rx "*** 2.6")))
- (forward-line 1)
- (should (looking-at
- (rx "*** Grafting buffer `#chan@new' onto `#chan@old'")))
- (forward-line 1)
- (should (looking-at (rx "*** 2023-08-02T06:00:01.001Z")))
- (forward-line 1)
- (should (looking-at (rx "*** 2.8")))
- (forward-line 1)
-
- (should (looking-at (rx "\n[Thu Aug 3 2023]")))
- (should (= (erc--get-inserted-msg-beg (point))
- (erc-stamp--date-marker (pop stamps))))
- (goto-char (1+ (match-end 0)))
- (should (looking-at (rx "*** 2023-08-03T00:00:00.001Z")))
- (forward-line 3) ; ...
-
- (should (looking-at (rx "\n[Fri Aug 4 2023]")))
- (should (= (erc--get-inserted-msg-beg (point))
- (erc-stamp--date-marker (pop stamps))))
- (should-not stamps))))
-
- (when noninteractive
- (erc-tests-common-kill-buffers)))
-
-;;; erc-stamp-tests.el ends here
+++ /dev/null
-;;; erc-tests.el --- Tests for erc. -*- lexical-binding:t -*-
-
-;; Copyright (C) 2020-2025 Free Software Foundation, Inc.
-
-;; Author: Lars Ingebrigtsen <larsi@gnus.org>
-
-;; 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 'erc-ring)
-
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-tests-common)))
-
-
-(ert-deftest erc--read-time-period ()
- (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "")))
- (should (equal (erc--read-time-period "foo: ") nil)))
-
- (cl-letf (((symbol-function 'read-string) (lambda (&rest _) " ")))
- (should (equal (erc--read-time-period "foo: ") nil)))
-
- (cl-letf (((symbol-function 'read-string) (lambda (&rest _) " 432 ")))
- (should (equal (erc--read-time-period "foo: ") 432)))
-
- (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "432")))
- (should (equal (erc--read-time-period "foo: ") 432)))
-
- (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1h")))
- (should (equal (erc--read-time-period "foo: ") 3600)))
-
- (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1h10s")))
- (should (equal (erc--read-time-period "foo: ") 3610)))
-
- (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d")))
- (should (equal (erc--read-time-period "foo: ") 86400))))
-
-(ert-deftest erc--format-time-period ()
- (should (equal (erc--format-time-period 59) "59s"))
- (should (equal (erc--format-time-period 59.9) "59s"))
- (should (equal (erc--format-time-period 60) "1m0s"))
- (should (equal (erc--format-time-period 119) "1m59s"))
- (should (equal (erc--format-time-period 119.9) "1m59s"))
- (should (equal (erc--format-time-period 120.9) "2m0s"))
- (should (equal (erc--format-time-period 3599.9) "59m59s"))
- (should (equal (erc--format-time-period 3600) "1h0m0s")))
-
-;; This asserts that the first pattern on file matching a supplied
-;; `user' parameter will be removed after confirmation.
-(ert-deftest erc-cmd-UNIGNORE ()
- ;; XXX these functions mutate `erc-ignore-list' via `delete'.
- (should (local-variable-if-set-p 'erc-ignore-list))
- (erc-tests-common-make-server-buf)
-
- (setq erc-ignore-list (list ".")) ; match anything
- (ert-simulate-keys (list ?\r)
- (erc-cmd-IGNORE "abc"))
- (should (equal erc-ignore-list (list "abc" ".")))
-
- (cl-letf (((symbol-function 'y-or-n-p) #'always))
- (erc-cmd-UNIGNORE "abcdef")
- (should (equal erc-ignore-list (list ".")))
- (erc-cmd-UNIGNORE "foo"))
- (should-not erc-ignore-list))
-
-(ert-deftest erc-with-all-buffers-of-server ()
- (let (proc-exnet
- proc-onet
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
-
- (with-current-buffer (get-buffer-create "OtherNet")
- (erc-mode)
- (setq proc-onet (start-process "sleep" (current-buffer) "sleep" "1")
- erc-server-process proc-onet
- erc-network 'OtherNet)
- (set-process-query-on-exit-flag erc-server-process nil))
-
- (with-current-buffer (get-buffer-create "ExampleNet")
- (erc-mode)
- (setq proc-exnet (start-process "sleep" (current-buffer) "sleep" "1")
- erc-server-process proc-exnet
- erc-network 'ExampleNet)
- (set-process-query-on-exit-flag erc-server-process nil))
-
- (with-current-buffer (get-buffer-create "#foo")
- (erc-mode)
- (setq erc-server-process proc-exnet)
- (setq erc--target (erc--target-from-string "#foo")))
-
- (with-current-buffer (get-buffer-create "#spam")
- (erc-mode)
- (setq erc-server-process proc-onet)
- (setq erc--target (erc--target-from-string "#spam")))
-
- (with-current-buffer (get-buffer-create "#bar")
- (erc-mode)
- (setq erc-server-process proc-onet)
- (setq erc--target (erc--target-from-string "#bar")))
-
- (with-current-buffer (get-buffer-create "#baz")
- (erc-mode)
- (setq erc-server-process proc-exnet)
- (setq erc--target (erc--target-from-string "#baz")))
-
- (should (eq (get-buffer-process "ExampleNet") proc-exnet))
- (erc-with-all-buffers-of-server (get-buffer-process "ExampleNet") nil
- (kill-buffer))
-
- (should-not (get-buffer "ExampleNet"))
- (should-not (get-buffer "#foo"))
- (should-not (get-buffer "#baz"))
- (should (get-buffer "OtherNet"))
- (should (get-buffer "#bar"))
- (should (get-buffer "#spam"))
-
- (let* ((test (lambda () (not (string= (buffer-name) "#spam"))))
- (calls 0)
- (get-test (lambda () (cl-incf calls) test)))
-
- (erc-with-all-buffers-of-server proc-onet (funcall get-test)
- (kill-buffer))
-
- (should (= calls 1)))
-
- (should-not (get-buffer "OtherNet"))
- (should-not (get-buffer "#bar"))
- (should (get-buffer "#spam"))
- (kill-buffer "#spam")))
-
-(ert-deftest erc-with-server-buffer ()
- (setq erc-away 1)
- (erc-tests-common-init-server-proc "sleep" "1")
-
- (let (mockingp calls)
- (advice-add 'buffer-local-value :after
- (lambda (&rest r) (when mockingp (push r calls)))
- '((name . erc-with-server-buffer)))
-
- (should (= 1 (prog2 (setq mockingp t)
- (erc-with-server-buffer erc-away)
- (setq mockingp nil))))
-
- (should (equal (pop calls) (list 'erc-away (current-buffer))))
-
- (should (= 1 (prog2 (setq mockingp t)
- (erc-with-server-buffer (ignore 'me) erc-away)
- (setq mockingp nil))))
- (should-not calls)
-
- (advice-remove 'buffer-local-value 'erc-with-server-buffer)))
-
-(ert-deftest erc--doarray ()
- (let ((array "abcdefg")
- out)
- ;; No return form.
- (should-not (erc--doarray (c array) (push c out)))
- (should (equal out '(?g ?f ?e ?d ?c ?b ?a)))
-
- ;; Return form evaluated upon completion.
- (setq out nil)
- (should (= 42 (erc--doarray (c array (+ 39 (length out)))
- (when (cl-evenp c) (push c out)))))
- (should (equal out '(?f ?d ?b)))))
-
-(ert-deftest erc-hide-prompt ()
- (let ((erc-hide-prompt erc-hide-prompt)
- ;;
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
-
- (with-current-buffer (get-buffer-create "ServNet")
- (erc-tests-common-prep-for-insertion)
- (goto-char erc-insert-marker)
- (should (looking-at-p (regexp-quote erc-prompt)))
- (erc-tests-common-init-server-proc "sleep" "1")
- (set-process-sentinel erc-server-process #'ignore)
- (setq erc-network 'ServNet)
- (set-process-query-on-exit-flag erc-server-process nil))
-
- (with-current-buffer (get-buffer-create "#chan")
- (erc-tests-common-prep-for-insertion)
- (goto-char erc-insert-marker)
- (should (looking-at-p (regexp-quote erc-prompt)))
- (setq erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "ServNet"))
- erc--target (erc--target-from-string "#chan")))
-
- (with-current-buffer (get-buffer-create "bob")
- (erc-tests-common-prep-for-insertion)
- (goto-char erc-insert-marker)
- (should (looking-at-p (regexp-quote erc-prompt)))
- (setq erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "ServNet"))
- erc--target (erc--target-from-string "bob")))
-
- (ert-info ("Value: t (default)")
- (should (eq erc-hide-prompt t))
- (with-current-buffer "ServNet"
- (should (= (point) erc-insert-marker))
- (erc--hide-prompt erc-server-process)
- (should (string= ">" (get-char-property (point) 'display))))
-
- (with-current-buffer "#chan"
- (goto-char erc-insert-marker)
- (should (string= ">" (get-char-property (point) 'display)))
- (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
- (goto-char erc-input-marker)
- (ert-simulate-command '(self-insert-command 1 ?/))
- (goto-char erc-insert-marker)
- (should-not (get-char-property (point) 'display))
- (should-not (memq #'erc--unhide-prompt-on-self-insert
- pre-command-hook)))
-
- (with-current-buffer "bob"
- (goto-char erc-insert-marker)
- (should (string= ">" (get-char-property (point) 'display)))
- (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
- (goto-char erc-input-marker)
- (ert-simulate-command '(self-insert-command 1 ?/))
- (goto-char erc-insert-marker)
- (should-not (get-char-property (point) 'display))
- (should-not (memq #'erc--unhide-prompt-on-self-insert
- pre-command-hook)))
-
- (with-current-buffer "ServNet"
- (should (get-char-property erc-insert-marker 'display))
- (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
- (erc--unhide-prompt)
- (should-not (memq #'erc--unhide-prompt-on-self-insert
- pre-command-hook))
- (should-not (get-char-property erc-insert-marker 'display))))
-
- (ert-info ("Value: server")
- (setq erc-hide-prompt '(server))
- (with-current-buffer "ServNet"
- (erc--hide-prompt erc-server-process)
- (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
- (should (string= ">" (get-char-property erc-insert-marker 'display))))
-
- (with-current-buffer "#chan"
- (should-not (get-char-property erc-insert-marker 'display)))
-
- (with-current-buffer "bob"
- (should-not (get-char-property erc-insert-marker 'display)))
-
- (with-current-buffer "ServNet"
- (erc--unhide-prompt)
- (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
- (should-not (get-char-property erc-insert-marker 'display))))
-
- (ert-info ("Value: channel")
- (setq erc-hide-prompt '(channel))
- (with-current-buffer "ServNet"
- (erc--hide-prompt erc-server-process)
- (should-not (get-char-property erc-insert-marker 'display)))
-
- (with-current-buffer "bob"
- (should-not (get-char-property erc-insert-marker 'display)))
-
- (with-current-buffer "#chan"
- (should (string= ">" (get-char-property erc-insert-marker 'display)))
- (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
- (erc--unhide-prompt)
- (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
- (should-not (get-char-property erc-insert-marker 'display))))
-
- (ert-info ("Value: query")
- (setq erc-hide-prompt '(query))
- (with-current-buffer "ServNet"
- (erc--hide-prompt erc-server-process)
- (should-not (get-char-property erc-insert-marker 'display)))
-
- (with-current-buffer "bob"
- (should (string= ">" (get-char-property erc-insert-marker 'display)))
- (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
- (erc--unhide-prompt)
- (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
- (should-not (get-char-property erc-insert-marker 'display)))
-
- (with-current-buffer "#chan"
- (should-not (get-char-property erc-insert-marker 'display))))
-
- (ert-info ("Value: nil")
- (setq erc-hide-prompt nil)
- (with-current-buffer "ServNet"
- (erc--hide-prompt erc-server-process)
- (should-not (get-char-property erc-insert-marker 'display)))
-
- (with-current-buffer "bob"
- (should-not (get-char-property erc-insert-marker 'display)))
-
- (with-current-buffer "#chan"
- (should-not (get-char-property erc-insert-marker 'display))
- (erc--unhide-prompt) ; won't blow up when prompt already showing
- (should-not (get-char-property erc-insert-marker 'display))))
-
- (when noninteractive
- (kill-buffer "#chan")
- (kill-buffer "bob")
- (kill-buffer "ServNet"))))
-
-(ert-deftest erc--refresh-prompt ()
- (let* ((counter 0)
- (erc-prompt (lambda ()
- (format "%s %d>"
- (erc-format-target-and/or-network)
- (cl-incf counter))))
- erc-accidental-paste-threshold-seconds
- erc-insert-modify-hook
- erc-send-modify-hook
- (erc-last-input-time 0)
- (erc-modules (remq 'stamp erc-modules))
- (erc-send-input-line-function #'ignore)
- (erc--input-review-functions erc--input-review-functions)
- erc-send-completed-hook)
-
- (ert-info ("Server buffer")
- (with-current-buffer (get-buffer-create "ServNet")
- (erc-tests-common-make-server-buf "ServNet")
- (goto-char erc-insert-marker)
- (should (looking-at-p "ServNet 3>"))
- (erc-tests-common-init-server-proc "sleep" "1")
- (set-process-sentinel erc-server-process #'ignore)
- (setq erc-server-current-nick "tester")
- ;; Incoming message redraws prompt
- (erc-display-message nil 'notice nil "Welcome")
- (should (looking-at-p (rx "*** Welcome")))
- (forward-line)
- (should (looking-at-p "ServNet 4>"))
- ;; Say something
- (goto-char erc-input-marker)
- (insert "Howdy")
- (erc-send-current-line)
- (save-excursion (forward-line -1)
- (should (looking-at (rx "*** No target")))
- (forward-line -1)
- (should (looking-at "<tester> Howdy")))
- (should (looking-back "ServNet 6> "))
- (should (= erc-input-marker (point)))
- ;; Space after prompt is unpropertized
- (should (get-text-property (1- erc-input-marker) 'erc-prompt))
- (should-not (get-text-property erc-input-marker 'erc-prompt))
- ;; No sign of old prompts
- (save-excursion
- (goto-char (point-min))
- (should-not (search-forward (rx (any "3-5") ">") nil t)))))
-
- (ert-info ("Channel buffer")
- ;; Create buffer manually instead of using `erc--open-target' in
- ;; order to show prompt before/after network is known.
- (with-current-buffer (get-buffer-create "#chan")
- (erc-tests-common-prep-for-insertion)
- (goto-char erc-insert-marker)
- (should (looking-at-p "#chan 9>"))
- (goto-char erc-input-marker)
- (setq erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "ServNet"))
- erc-networks--id (erc-with-server-buffer erc-networks--id)
- erc--target (erc--target-from-string "#chan")
- erc-default-recipients (list "#chan")
- erc-channel-users (make-hash-table :test 'equal))
- (erc-update-current-channel-member "alice" "alice")
- (erc-update-current-channel-member "bob" "bob")
- (erc-update-current-channel-member "tester" "tester")
- (erc-display-message nil nil (current-buffer)
- (erc-format-privmessage "alice" "Hi" nil t))
- (should (looking-back "#chan@ServNet 10> "))
- (goto-char erc-input-marker)
- (insert "Howdy")
- (erc-send-current-line)
- (save-excursion (forward-line -1)
- (should (looking-at "<tester> Howdy")))
- (should (looking-back "#chan@ServNet 11> "))
- (should (= (point) erc-input-marker))
- (insert "/query bob")
- (let (erc-modules)
- (erc-send-current-line))
- ;; Last command not inserted
- (save-excursion (forward-line -1)
- (should (looking-at "<tester> Howdy")))
- ;; Query does not redraw (nor /help, only message input)
- (should (looking-back "#chan@ServNet 11> "))
- ;; No sign of old prompts
- (save-excursion
- (goto-char (point-min))
- (should-not (search-forward (rx (or "9" "10") ">") nil t)))))
-
- (ert-info ("Query buffer")
- (with-current-buffer "bob"
- (goto-char erc-insert-marker)
- (should (looking-at-p "bob@ServNet 14>"))
- (goto-char erc-input-marker)
- (erc-display-message nil nil (current-buffer)
- (erc-format-privmessage "bob" "Hi" nil t))
- (should (looking-back "bob@ServNet 15> "))
- (goto-char erc-input-marker)
- (insert "Howdy")
- (erc-send-current-line)
- (save-excursion (forward-line -1)
- (should (looking-at "<tester> Howdy")))
- (should (looking-back "bob@ServNet 16> "))
- ;; No sign of old prompts
- (save-excursion
- (goto-char (point-min))
- (should-not (search-forward (rx (or "14" "15") ">") nil t)))))
-
- (when noninteractive
- (kill-buffer "#chan")
- (kill-buffer "bob")
- (kill-buffer "ServNet"))))
-
-(ert-deftest erc--initialize-markers ()
- (let ((proc (start-process "true" (current-buffer) "true"))
- erc-modules
- erc-connect-pre-hook
- erc-insert-modify-hook
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
- (set-process-query-on-exit-flag proc nil)
- (erc-mode)
- (setq erc-server-process proc
- erc-networks--id (erc-networks--id-create 'foonet))
- (erc-open "localhost" 6667 "tester" "Tester" nil
- "fake" nil "#chan" proc nil "user" nil)
- (with-current-buffer (should (get-buffer "#chan"))
- (should (= ?\n (char-after 1)))
- (should (= ?E (char-after erc-insert-marker)))
- (should (= 3 (marker-position erc-insert-marker)))
- (should (= 8 (marker-position erc-input-marker)))
- (should (= 8 (point-max)))
- (should (= 8 (point)))
- ;; These prompt properties are a continual source of confusion.
- ;; Including the literal defaults here can hopefully serve as a
- ;; quick reference for anyone operating in that area.
- (should (equal (buffer-string)
- #("\n\nERC> "
- 2 6 ( font-lock-face erc-prompt-face
- rear-nonsticky t
- erc-prompt t
- field erc-prompt
- front-sticky t
- read-only t)
- 6 7 ( rear-nonsticky t
- erc-prompt t
- field erc-prompt
- front-sticky t
- read-only t))))
-
- ;; Simulate some activity by inserting some text before and
- ;; after the prompt (multiline).
- (erc-display-error-notice nil "Welcome")
- (goto-char (point-max))
- (insert "Hello\nWorld")
- (goto-char 3)
- (should (looking-at-p (regexp-quote "*** Welcome"))))
-
- (ert-info ("Reconnect")
- (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")
- (with-current-buffer (should (get-buffer "#chan"))
- (should (= ?\n (char-after 1)))
- (should (= ?E (char-after erc-insert-marker)))
- (should (= 15 (marker-position erc-insert-marker)))
- (should (= 20 (marker-position erc-input-marker)))
- (should (= 3 (point))) ; point restored
- (should (equal (buffer-string)
- #("\n\n*** Welcome\nERC> Hello\nWorld"
- 2 13 (font-lock-face erc-error-face)
- 14 18 ( font-lock-face erc-prompt-face
- rear-nonsticky t
- erc-prompt t
- field erc-prompt
- front-sticky t
- read-only t)
- 18 19 ( rear-nonsticky t
- erc-prompt t
- field erc-prompt
- front-sticky t
- read-only t))))
- (when noninteractive
- (kill-buffer))))))
-
-(ert-deftest erc--switch-to-buffer ()
- (defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el
-
- (let ((proc (start-process "aNet" (current-buffer) "true"))
- (erc-modified-channels-alist `(("fake") (,(messages-buffer))))
- (inhibit-message noninteractive)
- (completion-fail-discreetly t) ; otherwise ^G^G printed to .log file
- ;;
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
-
- (with-current-buffer (get-buffer-create "server")
- (erc-mode)
- (set-process-buffer (setq erc-server-process proc) (current-buffer))
- (set-process-query-on-exit-flag erc-server-process nil)
- (with-current-buffer (get-buffer-create "#chan")
- (erc-mode)
- (setq erc-server-process proc))
- (with-current-buffer (get-buffer-create "#foo")
- (erc-mode)
- (setq erc-server-process proc))
-
- (ert-info ("Channel #chan selectable from server buffer")
- (ert-simulate-keys (list ?# ?c ?h ?a ?n ?\C-m)
- (should (string= "#chan" (erc--switch-to-buffer))))))
-
- (ert-info ("Channel #foo selectable from non-ERC buffer")
- (ert-simulate-keys (list ?# ?f ?o ?o ?\C-m)
- (should (string= "#foo" (erc--switch-to-buffer)))))
-
- (ert-info ("Default selectable")
- (ert-simulate-keys (list ?\C-m)
- (should (string= "*Messages*" (erc--switch-to-buffer)))))
-
- (ert-info ("Extant but non-ERC buffer not selectable")
- (get-buffer-create "#fake") ; not ours
- (ert-simulate-keys (kbd "#fake C-m C-a C-k C-m")
- ;; Initial query fails ~~~~~~^; clearing input accepts default
- (should (string= "*Messages*" (erc--switch-to-buffer)))))
-
- (with-current-buffer (get-buffer-create "other")
- (erc-mode)
- (setq erc-server-process (start-process "bNet" (current-buffer) "true"))
- (set-process-query-on-exit-flag erc-server-process nil))
-
- (ert-info ("Foreign ERC buffer not selectable")
- (ert-simulate-keys (kbd "other C-m C-a C-k C-m")
- (with-current-buffer "server"
- (should (string= "*Messages*" (erc--switch-to-buffer))))))
-
- (ert-info ("Any ERC-buffer selectable from non-ERC buffer")
- (should-not (eq major-mode 'erc-mode))
- (ert-simulate-keys (list ?o ?t ?h ?e ?r ?\C-m)
- (should (string= "other" (erc--switch-to-buffer)))))
-
- (dolist (b '("server" "other" "#chan" "#foo" "#fake"))
- (kill-buffer b))))
-
-(ert-deftest erc-setup-buffer--custom-action ()
- (erc-mode)
- (erc-tests-common-init-server-proc "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)))
-
- ;; Mimic simplistic version of example in "(erc) display-buffer".
- (when (>= emacs-major-version 29)
- (let ((proc erc-server-process))
- (with-temp-buffer
- (should-not (eq (window-buffer) (current-buffer)))
- (erc-mode)
- (setq erc-server-process proc)
-
- (cl-letf (((symbol-function 'erc--test-fun-p)
- (lambda (buf action)
- (should (eql 1 (alist-get 'erc-buffer-display action)))
- (push (cons 'erc--test-fun-p buf) calls)))
- ((symbol-function 'action-fn)
- (lambda (buf action)
- (should (eql 1 (alist-get 'erc-buffer-display action)))
- (should (eql 42 (alist-get 'foo action)))
- (push (cons 'action-fn buf) calls)
- (selected-window))))
-
- (let ((erc--display-context '((erc-buffer-display . 1)))
- (display-buffer-alist
- `(((and (major-mode . erc-mode) erc--test-fun-p)
- action-fn (foo . 42))))
- (erc-buffer-display 'display-buffer))
-
- (erc-setup-buffer (current-buffer))
- (should (equal 'action-fn (car (pop calls))))
- (should (equal 'erc--test-fun-p (car (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 "_`"))
-
- (should (string= "nick`" (erc-lurker-maybe-trim "nick`")))
-
- (setq erc-lurker-trim-nicks t)
- (should (string= "nick" (erc-lurker-maybe-trim "nick`")))
- (should (string= "ni`_ck" (erc-lurker-maybe-trim "ni`_ck__``")))
-
- (setq erc-lurker-ignore-chars "_-`") ; set of chars, not character alts
- (should (string= "nick" (erc-lurker-maybe-trim "nick-_`")))))
-
-(ert-deftest erc-parse-user ()
- (should (equal '("" "" "") (erc-parse-user "!@")))
- (should (equal '("" "!" "") (erc-parse-user "!!@")))
- (should (equal '("" "" "@") (erc-parse-user "!@@")))
- (should (equal '("" "!" "@") (erc-parse-user "!!@@")))
-
- (should (equal '("abc" "" "") (erc-parse-user "abc")))
- (should (equal '("" "123" "fake") (erc-parse-user "!123@fake")))
- (should (equal '("abc" "" "123") (erc-parse-user "abc!123")))
-
- (should (equal '("abc" "123" "fake") (erc-parse-user "abc!123@fake")))
- (should (equal '("abc" "!123" "@xy") (erc-parse-user "abc!!123@@xy")))
-
- (should (equal '("de" "fg" "xy") (erc-parse-user "abc\nde!fg@xy"))))
-
-(ert-deftest erc--parse-nuh ()
- (should (equal '(nil nil nil) (erc--parse-nuh "!@")))
- (should (equal '(nil nil nil) (erc--parse-nuh "@")))
- (should (equal '(nil nil nil) (erc--parse-nuh "!")))
- (should (equal '(nil "!" nil) (erc--parse-nuh "!!@")))
- (should (equal '(nil "@" nil) (erc--parse-nuh "!@@")))
- (should (equal '(nil "!@" nil) (erc--parse-nuh "!!@@")))
-
- (should (equal '("abc" nil nil) (erc--parse-nuh "abc!")))
- (should (equal '(nil "abc" nil) (erc--parse-nuh "abc@")))
- (should (equal '(nil "abc" nil) (erc--parse-nuh "!abc@")))
-
- (should (equal '("abc" "123" "fake") (erc--parse-nuh "abc!123@fake")))
- (should (equal '("abc" "!123@" "xy") (erc--parse-nuh "abc!!123@@xy")))
-
- ;; Missing leading components.
- (should (equal '(nil "abc" "123") (erc--parse-nuh "abc@123")))
- (should (equal '(nil "123" "fake") (erc--parse-nuh "!123@fake")))
- (should (equal '(nil nil "gnu.org") (erc--parse-nuh "@gnu.org")))
-
- ;; Host "wins" over nick and user (sans "@").
- (should (equal '(nil nil "abc") (erc--parse-nuh "abc")))
- (should (equal '(nil nil "gnu.org") (erc--parse-nuh "gnu.org")))
- (should (equal '(nil nil "gnu.org") (erc--parse-nuh "!gnu.org")))
- (should (equal '("abc" nil "123") (erc--parse-nuh "abc!123")))
-
- ;; No fallback behavior.
- (should-not (erc--parse-nuh "abc\nde!fg@xy")))
-
-(ert-deftest erc--parsed-prefix ()
- (erc-tests-common-make-server-buf (buffer-name))
-
- ;; Uses fallback values when no PREFIX parameter yet received, thus
- ;; ensuring caller can use slot accessors immediately instead of
- ;; checking if null beforehand.
- (should-not erc--parsed-prefix)
- (should (equal (erc--parsed-prefix)
- #s(erc--parsed-prefix nil "vhoaq" "+%@&~"
- ((?q . ?~) (?a . ?&)
- (?o . ?@) (?h . ?%) (?v . ?+)))))
- (let ((cached (should erc--parsed-prefix)))
- (should (eq (erc--parsed-prefix) cached)))
-
- ;; Cache broken. (Notice not setting `erc--parsed-prefix' to nil).
- (setq erc-server-parameters '(("PREFIX" . "(ov)@+")))
-
- (let ((proc erc-server-process)
- (expected '((?o . ?@) (?v . ?+)))
- cached)
-
- (with-temp-buffer
- (erc-mode)
- (setq erc-server-process proc)
- (should (equal expected
- (erc--parsed-prefix-alist (erc--parsed-prefix)))))
-
- (should (equal expected (erc--parsed-prefix-alist erc--parsed-prefix)))
- (setq cached erc--parsed-prefix)
- (should (equal cached
- #s(erc--parsed-prefix ("(ov)@+") "vo" "+@"
- ((?o . ?@) (?v . ?+)))))
- ;; Second target buffer reuses cached value.
- (with-temp-buffer
- (erc-mode)
- (setq erc-server-process proc)
- (should (eq cached (erc--parsed-prefix))))
-
- ;; New value computed when cache broken.
- (puthash 'PREFIX (list "(qh)~%") erc--isupport-params)
- (with-temp-buffer
- (erc-mode)
- (setq erc-server-process proc)
- (should-not (eq cached (erc--parsed-prefix)))
- (should (equal (erc--parsed-prefix-alist
- (erc-with-server-buffer erc--parsed-prefix))
- '((?q . ?~) (?h . ?%)))))))
-
-(ert-deftest erc--get-prefix-flag ()
- (erc-tests-common-make-server-buf (buffer-name))
- (should-not erc--parsed-prefix)
- (should (= (erc--get-prefix-flag ?v) 1))
- (should (= (erc--get-prefix-flag ?h) 2))
- (should (= (erc--get-prefix-flag ?o) 4))
- (should (= (erc--get-prefix-flag ?a) 8))
- (should (= (erc--get-prefix-flag ?q) 16))
-
- (ert-info ("With optional `from-prefix-p'")
- (should (= (erc--get-prefix-flag ?+ nil 'fpp) 1))
- (should (= (erc--get-prefix-flag ?% nil 'fpp) 2))
- (should (= (erc--get-prefix-flag ?@ nil 'fpp) 4))
- (should (= (erc--get-prefix-flag ?& nil 'fpp) 8))
- (should (= (erc--get-prefix-flag ?~ nil 'fpp) 16)))
- (should erc--parsed-prefix))
-
-(ert-deftest erc--init-cusr-fallback-status ()
- ;; Fallback behavior active because no `erc--parsed-prefix'.
- (should-not erc--parsed-prefix)
- (should (= 0 (erc--init-cusr-fallback-status nil nil nil nil nil)))
- (should (= 1 (erc--init-cusr-fallback-status t nil nil nil nil)))
- (should (= 4 (erc--init-cusr-fallback-status nil nil t nil nil)))
- (should-not erc--parsed-prefix) ; not created in non-ERC buffer.
-
- ;; Uses advertised server parameter.
- (erc-tests-common-make-server-buf (buffer-name))
- (setq erc-server-parameters '(("PREFIX" . "(YqaohvV)!~&@%+-")))
- (should (= 0 (erc--init-cusr-fallback-status nil nil nil nil nil)))
- (should (= 2 (erc--init-cusr-fallback-status t nil nil nil nil)))
- (should (= 8 (erc--init-cusr-fallback-status nil nil t nil nil)))
- (should erc--parsed-prefix))
-
-(ert-deftest erc--compute-cusr-fallback-status ()
- ;; Useless without an `erc--parsed-prefix'.
- (should (= 0 (erc--compute-cusr-fallback-status 0 nil nil nil nil nil)))
- (should (= 0 (erc--compute-cusr-fallback-status 0 'on 'on 'on 'on 'on)))
-
- (erc-tests-common-make-server-buf (buffer-name))
- (should (= 0 (erc--compute-cusr-fallback-status 0 nil nil nil nil nil)))
- (should (= 1 (erc--compute-cusr-fallback-status 0 'on nil nil nil nil)))
- (should (= 1 (erc--compute-cusr-fallback-status 0 'on 'off 'off 'off 'off)))
- (should (= 1 (erc--compute-cusr-fallback-status 1 'on 'off 'off 'off 'off)))
- (should (= 1 (erc--compute-cusr-fallback-status 1 nil nil nil nil nil)))
- (should (= 1 (erc--compute-cusr-fallback-status 3 nil 'off nil nil nil)))
- (should (= 1 (erc--compute-cusr-fallback-status 7 nil 'off 'off nil nil)))
- (should (= 4 (erc--compute-cusr-fallback-status 1 'off nil 'on nil nil))))
-
-(ert-deftest erc--cusr-status-p ()
- (erc-tests-common-make-server-buf (buffer-name))
- (should-not erc--parsed-prefix)
- (let ((cusr (make-erc-channel-user :voice t :op t)))
- (should-not (erc--cusr-status-p cusr ?q))
- (should-not (erc--cusr-status-p cusr ?a))
- (should-not (erc--cusr-status-p cusr ?h))
- (should (erc--cusr-status-p cusr ?o))
- (should (erc--cusr-status-p cusr ?v)))
- (should erc--parsed-prefix))
-
-(ert-deftest erc--cusr-change-status ()
- (erc-tests-common-make-server-buf (buffer-name))
- (let ((cusr (make-erc-channel-user)))
- (should-not (erc--cusr-status-p cusr ?o))
- (should-not (erc--cusr-status-p cusr ?v))
- (erc--cusr-change-status cusr ?o t)
- (erc--cusr-change-status cusr ?v t)
- (should (erc--cusr-status-p cusr ?o))
- (should (erc--cusr-status-p cusr ?v))
-
- (ert-info ("Reset with optional param")
- (erc--cusr-change-status cusr ?q t 'reset)
- (should-not (erc--cusr-status-p cusr ?o))
- (should-not (erc--cusr-status-p cusr ?v))
- (should (erc--cusr-status-p cusr ?q)))
-
- (ert-info ("Clear with optional param")
- (erc--cusr-change-status cusr ?v t)
- (should (erc--cusr-status-p cusr ?v))
- (erc--cusr-change-status cusr ?q nil 'reset)
- (should-not (erc--cusr-status-p cusr ?v))
- (should-not (erc--cusr-status-p cusr ?q)))))
-
-;; This exists as a reference to assert legacy behavior in order to
-;; preserve and incorporate it as a fallback in the 5.6+ replacement.
-(ert-deftest erc-parse-modes ()
- (with-suppressed-warnings ((obsolete erc-parse-modes))
- (should (equal (erc-parse-modes "+u") '(("u") nil nil)))
- (should (equal (erc-parse-modes "-u") '(nil ("u") nil)))
- (should (equal (erc-parse-modes "+o bob") '(nil nil (("o" on "bob")))))
- (should (equal (erc-parse-modes "-o bob") '(nil nil (("o" off "bob")))))
- (should (equal (erc-parse-modes "+uo bob") '(("u") nil (("o" on "bob")))))
- (should (equal (erc-parse-modes "+o-u bob") '(nil ("u") (("o" on "bob")))))
-
- (should (equal (erc-parse-modes "+uo-tv bob alice")
- '(("u") ("t") (("o" on "bob") ("v" off "alice")))))
- (should (equal (erc-parse-modes "+u-t+o-v bob alice")
- '(("u") ("t") (("o" on "bob") ("v" off "alice")))))
-
- (ert-info ("Modes of type B are always grouped as unary")
- (should (equal (erc-parse-modes "+k h2") '(nil nil (("k" on "h2")))))
- ;; Channel key args are thrown away.
- (should (equal (erc-parse-modes "-k *") '(nil nil (("k" off nil))))))
-
- (ert-info ("Modes of type C are grouped as unary even when disabling")
- (should (equal (erc-parse-modes "+l 3") '(nil nil (("l" on "3")))))
- (should (equal (erc-parse-modes "-l") '(nil nil (("l" off nil))))))))
-
-(ert-deftest erc--update-channel-modes ()
- (erc-tests-common-make-server-buf)
- (setq erc-channel-users (make-hash-table :test #'equal)
- erc--target (erc--target-from-string "#test"))
-
- (let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode))
- calls)
- (cl-letf (((symbol-function 'erc--handle-channel-mode)
- (lambda (&rest r) (push r calls) (apply orig-handle-fn r)))
- ((symbol-function 'erc-update-mode-line) #'ignore))
-
- (ert-info ("Unknown user not created")
- (erc--update-channel-modes "+o" "bob")
- (should-not (erc-get-channel-user "bob")))
-
- (ert-info ("Status updated when user known")
- (puthash "bob" (cons (erc-add-server-user
- "bob" (make-erc-server-user
- :nickname "bob"
- :buffers (list (current-buffer))))
- (make-erc-channel-user))
- erc-channel-users)
- ;; Also asserts fallback behavior for traditional prefixes.
- (should-not (erc-channel-user-op-p "bob"))
- (erc--update-channel-modes "+o" "bob")
- (should (erc-channel-user-op-p "bob"))
- (erc--update-channel-modes "-o" "bob") ; status revoked
- (should-not (erc-channel-user-op-p "bob")))
-
- (ert-info ("Unknown nullary added and removed")
- (should-not erc--channel-modes)
- (should-not erc-channel-modes)
- (erc--update-channel-modes "+u")
- (should (equal erc-channel-modes '("u")))
- (should (eq t (gethash ?u erc--channel-modes)))
- (should (equal (pop calls) '(?d ?u t nil)))
- (erc--update-channel-modes "-u")
- (should (equal (pop calls) '(?d ?u nil nil)))
- (should-not (gethash ?u erc--channel-modes))
- (should-not erc-channel-modes)
- (should-not calls))
-
- (ert-info ("Fallback for Type B includes mode letter k")
- (erc--update-channel-modes "+k" "h2")
- (should (equal (pop calls) '(?b ?k t "h2")))
- (should-not erc-channel-modes)
- (should (equal "h2" (gethash ?k erc--channel-modes)))
- (erc--update-channel-modes "-k" "*")
- (should (equal (pop calls) '(?b ?k nil "*")))
- (should-not calls)
- (should-not (gethash ?k erc--channel-modes))
- (should-not erc-channel-modes))
-
- (ert-info ("Fallback for Type C includes mode letter l")
- (erc--update-channel-modes "+l" "3")
- (should (equal (pop calls) '(?c ?l t "3")))
- (should-not erc-channel-modes)
- (should (equal "3" (gethash ?l erc--channel-modes)))
- (erc--update-channel-modes "-l" nil)
- (should (equal (pop calls) '(?c ?l nil nil)))
- (should-not (gethash ?l erc--channel-modes))
- (should-not erc-channel-modes))
-
- (ert-info ("Advertised supersedes heuristics")
- (setq erc-server-parameters
- '(("PREFIX" . "(ov)@+")
- ;; Add phony 5th type for this CHANMODES value for
- ;; robustness in case some server gets creative.
- ("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz,FAKE")))
- (erc--update-channel-modes "+qu" "fool!*@*")
- (should (equal (pop calls) '(?d ?u t nil)))
- (should (equal (pop calls) '(?a ?q t "fool!*@*")))
- (should (equal 1 (gethash ?q erc--channel-modes)))
- (should (eq t (gethash ?u erc--channel-modes)))
- (should (equal erc-channel-modes '("u")))
- (should-not (erc-channel-user-owner-p "bob"))
-
- ;; Remove fool!*@* from list mode "q".
- (erc--update-channel-modes "-uq" "fool!*@*")
- (should (equal (pop calls) '(?a ?q nil "fool!*@*")))
- (should (equal (pop calls) '(?d ?u nil nil)))
- (should-not (gethash ?u erc--channel-modes))
- (should-not erc-channel-modes)
- (should (equal 0 (gethash ?q erc--channel-modes))))
-
- (should-not calls))))
-
-(ert-deftest erc--channel-modes ()
- :tags (and (null (getenv "CI")) '(:unstable))
-
- (setq erc--isupport-params (make-hash-table)
- erc--target (erc--target-from-string "#test")
- erc--channel-banlist-synchronized-p t
- erc-server-parameters
- '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz")))
-
- (erc-tests-common-init-server-proc "sleep" "1")
-
- (cl-letf ((erc--parsed-response (make-erc-response
- :sender "chop!~u@gnu.org"))
- ((symbol-function 'erc-update-mode-line) #'ignore))
- (should-not erc-channel-banlist)
- (erc--update-channel-modes "+bbltk" "fool!*@*" "spam!*@*" "3" "h2")
- (should (equal erc-channel-banlist '(("chop!~u@gnu.org" . "spam!*@*")
- ("chop!~u@gnu.org" . "fool!*@*")))))
-
- (should (equal (erc--channel-modes 'string) "klt"))
- (should (equal (erc--channel-modes 'strings) '("k" "l" "t")))
- (should (equal (erc--channel-modes) '((?k . "h2") (?l . "3") (?t))))
- (should (equal (erc--channel-modes 3 ",") "klt h2,3"))
-
- ;; The function this tests behaves differently in different
- ;; environments. For example, on one GNU Linux system, it returns
- ;; truncation ellipsis when run interactively. Rather than have
- ;; hard-to-read "nondeterministic" comparisons against sets of
- ;; acceptable values, we use separate tests.
- (when (char-displayable-p ?…) (ert-pass))
-
- ;; Truncation cache populated and used.
- (let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types))
- first-run)
- (should (zerop (hash-table-count cache)))
- (should (equal (erc--channel-modes 1 ",") "klt h,3"))
- (should (equal (setq first-run (map-pairs cache)) '(((1 ?k "h2") . "h"))))
-
- ;; Second call uses cache.
- (cl-letf (((symbol-function 'truncate-string-to-width)
- (lambda (&rest _) (ert-fail "Shouldn't run"))))
- (should (equal (erc--channel-modes 1 ",") "klt h,3")))
-
- ;; Same key for only entry matches that of first result.
- (should (pcase (map-pairs cache)
- ((and '(((1 ?k "h2") . "h")) second-run)
- (eq (pcase first-run (`((,k . ,_)) k))
- (pcase second-run (`((,k . ,_)) k)))))))
-
- (should (equal (erc--channel-modes 0 ",") "klt ,"))
- (should (equal (erc--channel-modes 2) "klt h2 3"))
- (should (equal (erc--channel-modes 1) "klt h 3"))
- (should (equal (erc--channel-modes 0) "klt "))) ; 2 spaces
-
-(ert-deftest erc--channel-modes/graphic-p ()
- :tags `(:unstable ,@(and (getenv "ERC_TESTS_GRAPHICAL")
- '(:erc--graphical)))
- (unless (char-displayable-p ?…) (ert-skip "See non-/graphic-p variant"))
-
- (erc-tests-common-init-server-proc "sleep" "1")
- (setq erc--isupport-params (make-hash-table)
- erc--target (erc--target-from-string "#test")
- erc--channel-banlist-synchronized-p t
- erc-server-parameters
- '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz")))
-
- (cl-letf ((erc--parsed-response (make-erc-response
- :sender "chop!~u@gnu.org"))
- ((symbol-function 'erc-update-mode-line) #'ignore))
- (should-not erc-channel-banlist)
- (erc--update-channel-modes "+bltk" "fool!*@*" "3" "hun2")
- (should (equal erc-channel-banlist '(("chop!~u@gnu.org" . "fool!*@*")))))
-
- ;; Truncation cache populated and used.
- (let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types))
- first-run)
- (should (zerop (hash-table-count cache)))
- (should (equal (erc--channel-modes 2 ",") "klt h…,3" ))
- (should (equal (setq first-run (map-pairs cache))
- '(((2 ?k "hun2") . "h…"))))
-
- ;; Second call uses cache.
- (cl-letf (((symbol-function 'truncate-string-to-width)
- (lambda (&rest _) (ert-fail "Shouldn't run"))))
- (should (equal (erc--channel-modes 2 ",") "klt h…,3" )))
-
- ;; Same key for only entry matches that of first result.
- (should (pcase (map-pairs cache)
- ((and `(((2 ?k "hun2") . "h…")) second-run)
- (eq (pcase first-run (`((,k . ,_)) k))
- (pcase second-run (`((,k . ,_)) k)))))))
-
- ;; A max length of 0 is nonsensical anyway, so skip those.
- (should (equal (erc--channel-modes 3) "klt hu… 3"))
- (should (equal (erc--channel-modes 2) "klt h… 3"))
- (should (equal (erc--channel-modes 1) "klt … 3")))
-
-(ert-deftest erc--update-user-modes ()
- (let ((erc--user-modes (list ?a)))
- (should (equal (erc--update-user-modes "+a") '(?a)))
- (should (equal (erc--update-user-modes "-b") '(?a)))
- (should (equal erc--user-modes '(?a))))
-
- (let ((erc--user-modes (list ?b)))
- (should (equal (erc--update-user-modes "+ac") '(?a ?b ?c)))
- (should (equal (erc--update-user-modes "+a-bc") '(?a)))
- (should (equal erc--user-modes '(?a)))))
-
-(ert-deftest erc--user-modes ()
- (let ((erc--user-modes '(?a ?b)))
- (should (equal (erc--user-modes) '(?a ?b)))
- (should (equal (erc--user-modes 'string) "ab"))
- (should (equal (erc--user-modes 'strings) '("a" "b")))))
-
-(ert-deftest erc--parse-user-modes ()
- (should (equal (erc--parse-user-modes "a" '(?a)) '(() ())))
- (should (equal (erc--parse-user-modes "+a" '(?a)) '(() ())))
- (should (equal (erc--parse-user-modes "a" '()) '((?a) ())))
- (should (equal (erc--parse-user-modes "+a" '()) '((?a) ())))
- (should (equal (erc--parse-user-modes "-a" '()) '(() ())))
- (should (equal (erc--parse-user-modes "-a" '(?a)) '(() (?a))))
-
- (should (equal (erc--parse-user-modes "+a-b" '(?a)) '(() ())))
- (should (equal (erc--parse-user-modes "+a-b" '(?b)) '((?a) (?b))))
- (should (equal (erc--parse-user-modes "+ab-c" '(?b)) '((?a) ())))
- (should (equal (erc--parse-user-modes "+ab-c" '(?b ?c)) '((?a) (?c))))
- (should (equal (erc--parse-user-modes "+a-c+b" '(?b ?c)) '((?a) (?c))))
- (should (equal (erc--parse-user-modes "-c+ab" '(?b ?c)) '((?a) (?c))))
-
- ;; Param `extrap' returns groups of redundant chars.
- (should (equal (erc--parse-user-modes "+a" '() t) '((?a) () () ())))
- (should (equal (erc--parse-user-modes "+a" '(?a) t) '(() () (?a) ())))
- (should (equal (erc--parse-user-modes "-a" '() t) '(() () () (?a))))
- (should (equal (erc--parse-user-modes "-a" '(?a) t) '(() (?a) () ())))
-
- (should (equal (erc--parse-user-modes "+a-b" '(?a) t) '(() () (?a) (?b))))
- (should (equal (erc--parse-user-modes "-b+a" '(?a) t) '(() () (?a) (?b))))
- (should (equal (erc--parse-user-modes "+a-b" '(?b) t) '((?a) (?b) () ())))
- (should (equal (erc--parse-user-modes "-b+a" '(?b) t) '((?a) (?b) () ()))))
-
-(ert-deftest erc--parse-isupport-value ()
- (should (equal (erc--parse-isupport-value "a,b") '("a" "b")))
- (should (equal (erc--parse-isupport-value "a,b,c") '("a" "b" "c")))
-
- (should (equal (erc--parse-isupport-value "abc") '("abc")))
- (should (equal (erc--parse-isupport-value "\\x20foo") '(" foo")))
- (should (equal (erc--parse-isupport-value "foo\\x20") '("foo ")))
- (should (equal (erc--parse-isupport-value "a\\x20b\\x20c") '("a b c")))
- (should (equal (erc--parse-isupport-value "a\\x20b\\x20c\\x20") '("a b c ")))
- (should (equal (erc--parse-isupport-value "\\x20a\\x20b\\x20c") '(" a b c")))
- (should (equal (erc--parse-isupport-value "a\\x20\\x20c") '("a c")))
- (should (equal (erc--parse-isupport-value "\\x20\\x20\\x20") '(" ")))
- (should (equal (erc--parse-isupport-value "\\x5Co/") '("\\o/")))
- (should (equal (erc--parse-isupport-value "\\x7F,\\x19") '("\\x7F" "\\x19")))
- (should (equal (erc--parse-isupport-value "a\\x3Db") '("a=b")))
- (should (equal (erc--parse-isupport-value "a\\x2Cb,c") '("a,b" "c"))))
-
-(ert-deftest erc--get-isupport-entry ()
- (let ((erc--isupport-params (make-hash-table))
- (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C")
- ("SPAM" . "")))
- (items (lambda ()
- (cl-loop for k being the hash-keys of erc--isupport-params
- using (hash-values v) collect (cons k v)))))
-
- (should-not (erc--get-isupport-entry 'FAKE))
- (should-not (erc--get-isupport-entry 'FAKE 'single))
- (should (zerop (hash-table-count erc--isupport-params)))
-
- (should (equal (erc--get-isupport-entry 'BAR) '(BAR)))
- (should-not (erc--get-isupport-entry 'BAR 'single))
- (should (= 1 (hash-table-count erc--isupport-params)))
-
- (should (equal (erc--get-isupport-entry 'BAZ) '(BAZ "A" "B" "C")))
- (should (equal (erc--get-isupport-entry 'BAZ 'single) "A"))
- (should (= 2 (hash-table-count erc--isupport-params)))
-
- (should (equal (erc--get-isupport-entry 'FOO 'single) "1"))
- (should (equal (erc--get-isupport-entry 'FOO) '(FOO "1")))
-
- (should (equal (funcall items)
- '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1"))))
- (should (equal (erc--get-isupport-entry 'SPAM) '(SPAM)))
- (should-not (erc--get-isupport-entry 'SPAM 'single))))
-
-(ert-deftest erc-server-005 ()
- (let* ((hooked 0)
- (verify #'ignore)
- (hook (lambda (_ _) (funcall verify) (cl-incf hooked)))
- (erc-server-005-functions (list #'erc-server-005 hook #'ignore))
- erc-server-parameters
- erc--isupport-params
- erc-timer-hook
- calls
- args
- parsed)
-
- (cl-letf (((symbol-function 'erc-display-message)
- (lambda (_ _ _ line) (push line calls))))
-
- (ert-info ("Baseline")
- (setq args '("tester" "BOT=B" "CHANTYPES=" "EXCEPTS" "PREFIX=(ov)@+"
- "are supp...")
- parsed (make-erc-response :command-args args :command "005"))
-
- (setq verify
- (lambda ()
- (should (equal erc-server-parameters
- '(("PREFIX" . "(ov)@+") ("EXCEPTS")
- ;; Should be ("CHANTYPES") but
- ;; retained for compatibility.
- ("CHANTYPES" . "")
- ("BOT" . "B"))))
- (should (zerop (hash-table-count erc--isupport-params)))
- (should (equal "(ov)@+" (erc--get-isupport-entry 'PREFIX t)))
- (should (equal '(EXCEPTS) (erc--get-isupport-entry 'EXCEPTS)))
- (should (equal "B" (erc--get-isupport-entry 'BOT t)))
- (should (string=
- (pop calls)
- "BOT=B CHANTYPES= EXCEPTS PREFIX=(ov)@+ are supp..."))
- (should (equal args (erc-response.command-args parsed)))))
-
- (erc-call-hooks nil parsed))
-
- (ert-info ("Negated, updated")
- (setq args '("tester" "-EXCEPTS" "-CHANTYPES" "-FAKE" "PREFIX=(ohv)@%+"
- "are su...")
- parsed (make-erc-response :command-args args :command "005"))
-
- (setq verify
- (lambda ()
- (should (equal erc-server-parameters
- '(("PREFIX" . "(ohv)@%+") ("BOT" . "B"))))
- (should (string-prefix-p
- "-EXCEPTS -CHANTYPES -FAKE PREFIX=(ohv)@%+ "
- (pop calls)))
- (should (equal "(ohv)@%+" (erc--get-isupport-entry 'PREFIX t)))
- (should (equal "B" (erc--get-isupport-entry 'BOT t)))
- (should-not (erc--get-isupport-entry 'EXCEPTS))
- (should (equal args (erc-response.command-args parsed)))))
-
- (erc-call-hooks nil parsed))
- (should (= hooked 2)))))
-
-(ert-deftest erc-downcase ()
- (let ((erc--isupport-params (make-hash-table)))
-
- (puthash 'PREFIX '("(ov)@+") erc--isupport-params)
- (puthash 'BOT '("B") erc--isupport-params)
-
- (ert-info ("ascii")
- (puthash 'CASEMAPPING '("ascii") erc--isupport-params)
- (should (equal (erc-downcase "ABC 123 ΔΞΩΣ") "abc 123 ΔΞΩΣ"))
- (should (equal (erc-downcase "Bob[m]`") "bob[m]`"))
- (should (equal (erc-downcase "Tilde~") "tilde~" ))
- (should (equal (erc-downcase "\\O/") "\\o/" )))
-
- (ert-info ("rfc1459")
- (puthash 'CASEMAPPING '("rfc1459") erc--isupport-params)
- (should (equal (erc-downcase "ABC 123 ΔΞΩΣ") "abc 123 ΔΞΩΣ"))
- (should (equal (erc-downcase "Bob[m]`") "bob{m}`" ))
- (should (equal (erc-downcase "Tilde~") "tilde^" ))
- (should (equal (erc-downcase "\\O/") "|o/" )))
-
- (ert-info ("rfc1459-strict")
- (puthash 'CASEMAPPING '("rfc1459-strict") erc--isupport-params)
- (should (equal (erc-downcase "ABC 123 ΔΞΩΣ") "abc 123 ΔΞΩΣ"))
- (should (equal (erc-downcase "Bob[m]`") "bob{m}`"))
- (should (equal (erc-downcase "Tilde~") "tilde~" ))
- (should (equal (erc-downcase "\\O/") "|o/" )))))
-
-(ert-deftest erc-channel-p ()
- (erc-tests-common-make-server-buf)
-
- (should (erc-channel-p "#chan"))
- (should (erc-channel-p "##chan"))
- (should (erc-channel-p "&chan"))
- (should-not (erc-channel-p "+chan"))
- (should-not (erc-channel-p "!chan"))
- (should-not (erc-channel-p "@chan"))
-
- ;; Server sends "CHANTYPES=#&+!"
- (should-not erc-server-parameters)
- (setq erc-server-parameters '(("CHANTYPES" . "#&+!")))
- (should (erc-channel-p "#chan"))
- (should (erc-channel-p "&chan"))
- (should (erc-channel-p "+chan"))
- (should (erc-channel-p "!chan"))
-
- (with-current-buffer (erc--open-target "#chan")
- (should (erc-channel-p (current-buffer))))
- (with-current-buffer (erc--open-target "+chan")
- (should (erc-channel-p (current-buffer))))
- (should (erc-channel-p (get-buffer "#chan")))
- (should (erc-channel-p (get-buffer "+chan")))
-
- ;; Server sends "CHANTYPES=" because it's query only.
- (puthash 'CHANTYPES '("CHANTYPES") erc--isupport-params)
- (should-not (erc-channel-p "#spam"))
- (should-not (erc-channel-p "&spam"))
- (should-not (erc-channel-p (save-excursion (erc--open-target "#spam"))))
-
- (erc-tests-common-kill-buffers))
-
-(ert-deftest erc-query-buffer-p ()
- ;; Nil in a non-ERC buffer.
- (should-not (erc-query-buffer-p))
- (should-not (erc-query-buffer-p (current-buffer)))
- (should-not (erc-query-buffer-p (buffer-name)))
-
- (erc-tests-common-make-server-buf)
- ;; Nil in a server buffer.
- (should-not (erc-query-buffer-p))
- (should-not (erc-query-buffer-p (current-buffer)))
- (should-not (erc-query-buffer-p (buffer-name)))
-
- ;; Nil in a channel buffer.
- (with-current-buffer (erc--open-target "#chan")
- (should-not (erc-query-buffer-p))
- (should-not (erc-query-buffer-p (current-buffer)))
- (should-not (erc-query-buffer-p (buffer-name))))
-
- ;; Non-nil in a query buffer.
- (with-current-buffer (erc--open-target "alice")
- (should (erc-query-buffer-p))
- (should (erc-query-buffer-p (current-buffer)))
- (should (erc-query-buffer-p (buffer-name))))
-
- (should (erc-query-buffer-p (get-buffer "alice")))
- (should (erc-query-buffer-p "alice"))
-
- (erc-tests-common-kill-buffers))
-
-(ert-deftest erc--valid-local-channel-p ()
- (ert-info ("Local channels not supported")
- (let ((erc--isupport-params (make-hash-table)))
- (puthash 'CHANTYPES '("#") erc--isupport-params)
- (should-not (erc--valid-local-channel-p "#chan"))
- (should-not (erc--valid-local-channel-p "&local"))))
- (ert-info ("Local channels supported")
- (let ((erc--isupport-params (make-hash-table)))
- (puthash 'CHANTYPES '("&#") erc--isupport-params)
- (should-not (erc--valid-local-channel-p "#chan"))
- (should (erc--valid-local-channel-p "&local")))))
-
-(ert-deftest erc--target-from-string ()
- (should (equal (erc--target-from-string "#chan")
- #s(erc--target-channel "#chan" \#chan nil)))
-
- (should (equal (erc--target-from-string "Bob")
- #s(erc--target "Bob" bob)))
-
- (let ((erc--isupport-params (make-hash-table)))
- (puthash 'CHANTYPES '("&#") erc--isupport-params)
- (should (equal (erc--target-from-string "&Bitlbee")
- #s(erc--target-channel-local "&Bitlbee" &bitlbee nil)))))
-
-(ert-deftest erc--modify-local-map ()
- (when (and (bound-and-true-p erc-irccontrols-mode)
- (fboundp 'erc-irccontrols-mode))
- (erc-irccontrols-mode -1))
- (when (and (bound-and-true-p erc-match-mode)
- (fboundp 'erc-match-mode))
- (erc-match-mode -1))
- (let* (calls
- (inhibit-message noninteractive)
- (cmd-foo (lambda () (interactive) (push 'foo calls)))
- (cmd-bar (lambda () (interactive) (push 'bar calls))))
-
- (ert-info ("Add non-existing")
- (erc--modify-local-map t "C-c C-c" cmd-foo "C-c C-k" cmd-bar)
- (with-temp-buffer
- (set-window-buffer (selected-window) (current-buffer))
- (use-local-map erc-mode-map)
- (execute-kbd-macro "\C-c\C-c")
- (execute-kbd-macro "\C-c\C-k"))
- (should (equal calls '(bar foo))))
- (setq calls nil)
-
- (ert-info ("Add existing") ; Attempt to swap definitions fails
- (erc--modify-local-map t "C-c C-c" cmd-bar "C-c C-k" cmd-foo)
- (with-temp-buffer
- (set-window-buffer (selected-window) (current-buffer))
- (use-local-map erc-mode-map)
- (execute-kbd-macro "\C-c\C-c")
- (execute-kbd-macro "\C-c\C-k"))
- (should (equal calls '(bar foo))))
- (setq calls nil)
-
- (ert-info ("Remove existing")
- (ert-with-message-capture messages
- (erc--modify-local-map nil "C-c C-c" cmd-foo "C-c C-k" cmd-bar)
- (with-temp-buffer
- (set-window-buffer (selected-window) (current-buffer))
- (use-local-map erc-mode-map)
- (execute-kbd-macro "\C-c\C-c")
- (execute-kbd-macro "\C-c\C-k"))
- (should (string-search "C-c C-c is undefined" messages))
- (should (string-search "C-c C-k is undefined" messages))
- (should-not calls)))))
-
-(ert-deftest erc-ring-previous-command-base-case ()
- (ert-info ("Create ring when nonexistent and do nothing")
- (let (erc-input-ring
- erc-input-ring-index)
- (erc-previous-command)
- (should (ring-p erc-input-ring))
- (should (zerop (ring-length erc-input-ring)))
- (should-not erc-input-ring-index)))
- (should-not erc-input-ring))
-
-(ert-deftest erc-ring-previous-command ()
- (with-current-buffer (get-buffer-create "*#fake*")
- (erc-mode)
- (erc-tests-common-prep-for-insertion)
- (setq erc-server-current-nick "tester")
- (setq-local erc-last-input-time 0)
- (should-not (local-variable-if-set-p 'erc-send-completed-hook))
- (setq-local erc-send-completed-hook nil) ; skip t (globals)
- ;; Just in case erc-ring-mode is already on
- (setq-local erc--input-review-functions erc--input-review-functions)
- (add-hook 'erc--input-review-functions #'erc-add-to-input-ring)
- ;;
- (cl-letf (((symbol-function 'erc-process-input-line)
- (lambda (&rest _)
- (erc-display-message
- nil 'notice (current-buffer) "echo: one\n")))
- ((symbol-function 'erc-command-no-process-p)
- (lambda (&rest _) t)))
- (ert-info ("Create ring, populate, recall")
- (insert "/one")
- (erc-send-current-line)
- (should (ring-p erc-input-ring))
- (should (zerop (ring-member erc-input-ring "/one"))) ; equal
- (should (save-excursion (forward-line -1)
- (looking-at-p "[*]+ echo: one")))
- (should-not erc-input-ring-index)
- (erc-bol)
- (should (looking-at "$"))
- (erc-previous-command)
- (erc-bol)
- (should (looking-at "/one"))
- (should (zerop erc-input-ring-index)))
- (ert-info ("Back to one")
- (should (= (ring-length erc-input-ring) (1+ erc-input-ring-index)))
- (erc-previous-command)
- (should-not erc-input-ring-index)
- (erc-bol)
- (should (looking-at "$"))
- (should (equal (ring-ref erc-input-ring 0) "/one")))
- (ert-info ("Swap input after prompt with previous (#bug46339)")
- (insert "abc")
- (erc-previous-command)
- (should (= 1 erc-input-ring-index))
- (erc-bol)
- (should (looking-at "/one"))
- (should (equal (ring-ref erc-input-ring 0) "abc"))
- (should (equal (ring-ref erc-input-ring 1) "/one"))
- (erc-next-command)
- (erc-bol)
- (should (looking-at "abc")))))
- (when noninteractive
- (kill-buffer "*#fake*")))
-
-(ert-deftest erc--debug-irc-protocol-mask-secrets ()
- (should-not erc-debug-irc-protocol)
- (should erc--debug-irc-protocol-mask-secrets)
- (with-temp-buffer
- (setq erc-server-process (start-process "fake" (current-buffer) "true")
- erc-server-current-nick "tester"
- erc-session-server "myproxy.localhost"
- erc-session-port 6667)
- (let ((inhibit-message noninteractive))
- (erc-toggle-debug-irc-protocol)
- (erc-log-irc-protocol
- (concat "PASS :" (erc--unfun (lambda () "changeme")) "\r\n")
- 'outgoing)
- (set-process-query-on-exit-flag erc-server-process nil))
- (with-current-buffer "*erc-protocol*"
- (goto-char (point-min))
- (search-forward "\r\n\r\n")
- (search-forward "myproxy.localhost:6667 >> PASS :????????" (pos-eol)))
- (when noninteractive
- (kill-buffer "*erc-protocol*")
- (should-not erc-debug-irc-protocol))))
-
-(ert-deftest erc-log-irc-protocol ()
- (should-not erc-debug-irc-protocol)
- (with-temp-buffer
- (setq erc-server-process (start-process "fake" (current-buffer) "true")
- erc-server-current-nick "tester"
- erc-session-server "myproxy.localhost"
- erc-session-port 6667)
- (let ((inhibit-message noninteractive))
- (erc-toggle-debug-irc-protocol)
- (erc-log-irc-protocol "PASS changeme\r\n" 'outgoing)
- (setq erc-server-announced-name "irc.gnu.org")
- (erc-log-irc-protocol ":irc.gnu.org 001 tester :Welcome")
- (erc-log-irc-protocol ":irc.gnu.org 002 tester :Your host is irc.gnu.org")
- (setq erc-network 'FooNet)
- (setq erc-networks--id (erc-networks--id-create nil))
- (erc-log-irc-protocol ":irc.gnu.org 422 tester :MOTD missing")
- (setq erc-networks--id (erc-networks--id-create 'BarNet))
- (erc-log-irc-protocol ":irc.gnu.org 221 tester +i")
- (set-process-query-on-exit-flag erc-server-process nil)))
- (with-current-buffer "*erc-protocol*"
- (goto-char (point-min))
- (search-forward "Version")
- (search-forward "\r\n\r\n")
- (search-forward "myproxy.localhost:6667 >> PASS" (pos-eol))
- (forward-line)
- (search-forward "irc.gnu.org << :irc.gnu.org 001" (pos-eol))
- (forward-line)
- (search-forward "irc.gnu.org << :irc.gnu.org 002" (pos-eol))
- (forward-line)
- (search-forward "FooNet << :irc.gnu.org 422" (pos-eol))
- (forward-line)
- (search-forward "BarNet << :irc.gnu.org 221" (pos-eol)))
- (when noninteractive
- (kill-buffer "*erc-protocol*")
- (should-not erc-debug-irc-protocol)))
-
-(ert-deftest erc--split-line ()
- (let ((erc-split-line-length 0))
- (should (equal (erc--split-line "") '("")))
- (should (equal (erc--split-line " ") '(" ")))
- (should (equal (erc--split-line "1") '("1")))
- (should (equal (erc--split-line " 1") '(" 1")))
- (should (equal (erc--split-line "1 ") '("1 ")))
- (should (equal (erc--split-line "abc") '("abc"))))
-
- (let ((erc-default-recipients '("#chan"))
- (erc-split-line-length 10))
- (should (equal (erc--split-line "") '("")))
- (should (equal (erc--split-line "0123456789") '("0123456789")))
- (should (equal (erc--split-line "0123456789a") '("0123456789" "a")))
-
- (should (equal (erc--split-line "0123456789 ") '("0123456789" " ")))
- (should (equal (erc--split-line "01234567 89") '("01234567 " "89")))
- (should (equal (erc--split-line "0123456 789") '("0123456 " "789")))
- (should (equal (erc--split-line "0 123456789") '("0 " "123456789")))
- (should (equal (erc--split-line " 0123456789") '(" " "0123456789")))
- (should (equal (erc--split-line "012345678 9a") '("012345678 " "9a")))
- (should (equal (erc--split-line "0123456789 a") '("0123456789" " a")))
-
- ;; UTF-8 vs. KOI-8
- (should (= 10 (string-bytes "Русск"))) ; utf-8
- (should (equal (erc--split-line "Русск") '("Русск")))
- (should (equal (erc--split-line "РусскийТекст") '("Русск" "ийТек" "ст")))
- (should (equal (erc--split-line "Русский Текст") '("Русск" "ий " "Текст")))
- (let ((erc-encoding-coding-alist '(("#chan" . cyrillic-koi8))))
- (should (equal (erc--split-line "Русск") '("Русск")))
- (should (equal (erc--split-line "РусскийТекст") '("РусскийТек" "ст")))
- (should (equal (erc--split-line "Русский Текст") '("Русский " "Текст"))))
-
- ;; UTF-8 vs. Latin 1
- (should (= 17 (string-bytes "Hyvää päivää")))
- (should (equal (erc--split-line "Hyvää päivää") '("Hyvää " "päivää")))
- (should (equal (erc--split-line "HyvääPäivää") '("HyvääPä" "ivää")))
- (let ((erc-encoding-coding-alist '(("#chan" . latin-1))))
- (should (equal (erc--split-line "Hyvää päivää") '("Hyvää " "päivää")))
- (should (equal (erc--split-line "HyvääPäivää") '("HyvääPäivä" "ä"))))
-
- ;; Combining characters
- (should (= 10 (string-bytes "Åström")))
- (should (equal (erc--split-line "_Åström") '("_Åströ" "m")))
- (should (equal (erc--split-line "__Åström") '("__Åstr" "öm")))
- (should (equal (erc--split-line "___Åström") '("___Åstr" "öm")))
- (when (> emacs-major-version 27)
- (should (equal (erc--split-line "🏁🚩🎌🏴🏳️🏳️🌈🏳️⚧️🏴☠️")
- '("🏁🚩" "🎌🏴" "🏳️" "🏳️🌈" "🏳️⚧️" "🏴☠️"))))))
-
-(ert-deftest erc--input-line-delim-regexp ()
- (let ((p erc--input-line-delim-regexp))
- ;; none
- (should (equal '("a" "b") (split-string "a\r\nb" p)))
- (should (equal '("a" "b") (split-string "a\nb" p)))
- (should (equal '("a" "b") (split-string "a\rb" p)))
-
- ;; one
- (should (equal '("") (split-string "" p)))
- (should (equal '("a" "" "b") (split-string "a\r\rb" p)))
- (should (equal '("a" "" "b") (split-string "a\n\rb" p)))
- (should (equal '("a" "" "b") (split-string "a\n\nb" p)))
- (should (equal '("a" "" "b") (split-string "a\r\r\nb" p)))
- (should (equal '("a" "" "b") (split-string "a\n\r\nb" p)))
- (should (equal '("a" "") (split-string "a\n" p)))
- (should (equal '("a" "") (split-string "a\r" p)))
- (should (equal '("a" "") (split-string "a\r\n" p)))
- (should (equal '("" "b") (split-string "\nb" p)))
- (should (equal '("" "b") (split-string "\rb" p)))
- (should (equal '("" "b") (split-string "\r\nb" p)))
-
- ;; two
- (should (equal '("" "") (split-string "\r" p)))
- (should (equal '("" "") (split-string "\n" p)))
- (should (equal '("" "") (split-string "\r\n" p)))
-
- ;; three
- (should (equal '("" "" "") (split-string "\r\r" p)))
- (should (equal '("" "" "") (split-string "\n\n" p)))
- (should (equal '("" "" "") (split-string "\n\r" p)))))
-
-(ert-deftest erc--check-prompt-input-functions ()
- (erc-tests-common-with-process-input-spy
- (lambda (next)
- (erc-tests-common-prep-for-insertion)
-
- (ert-info ("Errors when point not in prompt area") ; actually just dings
- (insert "/msg #chan hi")
- (forward-line -1)
- (let ((e (should-error (erc-send-current-line))))
- (should (equal "Point is not in the input area" (cadr e))))
- (goto-char (point-max))
- (ert-info ("Input remains untouched")
- (should (save-excursion (erc-bol) (looking-at "/msg #chan hi")))))
-
- (ert-info ("Errors when server buffer absent")
- (let ((e (should-error (erc-send-current-line))))
- (should (equal "Server buffer missing" (cadr e))))
- (ert-info ("Input remains untouched")
- (should (save-excursion (erc-bol) (looking-at "/msg #chan hi")))))
-
- (ert-info ("Errors when line contains empty newline")
- (erc-bol)
- (delete-region (point) (point-max))
- (insert "one\n")
- (let ((e (should-error (erc-send-current-line))))
- (should (string-prefix-p "Trailing line detected" (cadr e))))
- (goto-char (point-max))
- (ert-info ("Input remains untouched")
- (should (save-excursion (goto-char erc-input-marker)
- (looking-at "one\n")))))
-
- (should (= 0 erc-last-input-time))
- (should-not (funcall next)))))
-
-;; These also indirectly tests `erc-send-input'
-
-(ert-deftest erc-send-current-line ()
- (erc-tests-common-with-process-input-spy
- (lambda (next)
- (erc-tests-common-make-server-buf (buffer-name))
- (should (= 0 erc-last-input-time))
-
- (ert-info ("Simple command")
- (insert "/msg #chan hi")
- (erc-send-current-line)
- (ert-info ("Prompt restored")
- (forward-line 0)
- (should (looking-at-p erc-prompt)))
- (ert-info ("Input cleared")
- (erc-bol)
- (should (eq (point) (point-max))))
- ;; The `force' argument is irrelevant here because it can't
- ;; influence dispatched handlers, such as `erc-cmd-MSG'.
- (should (pcase (funcall next) (`("/msg #chan hi\n" ,_ nil) t))))
-
- (ert-info ("Simple non-command")
- (insert "hi")
- (erc-send-current-line)
- (should (eq (point) (point-max)))
- (should (save-excursion (forward-line -1)
- (search-forward "<tester> hi")))
- ;; Non-commands are forced only when `erc-flood-protect' is
- ;; nil, which conflates two orthogonal concerns.
- (should (equal (funcall next) '("hi\n" nil t))))
-
- (should (consp erc-last-input-time)))))
-
-(ert-deftest erc--discard-trailing-multiline-nulls ()
- (pcase-dolist (`(,input ,want) '((("") (""))
- (("" "") (""))
- (("a") ("a"))
- (("a" "") ("a"))
- (("" "a") ("" "a"))
- (("" "a" "") ("" "a"))))
- (ert-info ((format "Input: %S, want: %S" input want))
- (let ((s (make-erc--input-split :lines input)))
- (erc--discard-trailing-multiline-nulls s)
- (should (equal (erc--input-split-lines s) want))))))
-
-(ert-deftest erc--count-blank-lines ()
- (pcase-dolist (`(,input ,want) '((() (0 0 0))
- (("") (1 1 0))
- (("" "") (2 1 1))
- (("" "" "") (3 1 2))
- ((" " "") (2 0 1))
- ((" " "" "") (3 0 2))
- (("" " " "") (3 1 1))
- (("" "" " ") (3 2 0))
- (("a") (0 0 0))
- (("a" "") (1 0 1))
- (("a" " " "") (2 0 1))
- (("a" "" "") (2 0 2))
- (("a" "b") (0 0 0))
- (("a" "" "b") (1 1 0))
- (("a" " " "b") (1 0 0))
- (("" "a") (1 1 0))
- ((" " "a") (1 0 0))
- (("" "a" "") (2 1 1))
- (("" " " "a" "" " ") (4 2 0))
- (("" " " "a" "" " " "") (5 2 1))))
- (ert-info ((format "Input: %S, want: %S" input want))
- (should (equal (erc--count-blank-lines input) want)))))
-
-;; Opt `wb': `erc-warn-about-blank-lines'
-;; Opt `sw': `erc-send-whitespace-lines'
-;; `s': " \n",`a': "a\n",`b': "b\n"
-(defvar erc-tests--check-prompt-input--expect
- ;; opts "" " " "\n" "\n " " \n" "\n\n" "a\n" "a\n " "a\n \nb"
- '(((+wb -sw) err err err err err err err err err)
- ((-wb -sw) nop nop nop nop nop nop nop nop nop)
- ((+wb +sw) err (s) (0 s) (1 s s) (s) (0 s) (0 a) (a s) (a s b))
- ((-wb +sw) nop (s) (s) (s s) (s) (s) (a) (a s) (a s b))))
-
-;; Help messages echoed (not IRC message) was emitted
-(defvar erc-tests--check-prompt-input-messages
- '("Stripping" "Padding"))
-
-(ert-deftest erc--check-prompt-input-for-multiline-blanks ()
- :tags '(:expensive-test)
- (ert-with-message-capture messages
- (erc-tests-common-with-process-input-spy
- (lambda (next)
- (erc-tests-common-make-server-buf (buffer-name))
-
- (should-not erc-send-whitespace-lines)
- (should erc-warn-about-blank-lines)
-
- (pcase-dolist (`((,wb ,sw) . ,ex) erc-tests--check-prompt-input--expect)
- (let ((print-escape-newlines t)
- (erc-warn-about-blank-lines (eq wb '+wb))
- (erc-send-whitespace-lines (eq sw '+sw))
- (samples '("" " " "\n" "\n " " \n" "\n\n"
- "a\n" "a\n " "a\n \nb")))
- (setq ex `(,@ex (a) (a b)) ; baseline, same for all combos
- samples `(,@samples "a" "a\nb"))
- (dolist (input samples)
- (insert input)
- (ert-info ((format "Opts: %S, Input: %S, want: %S"
- (list wb sw) input (car ex)))
- (setq messages "")
- (pcase-exhaustive (pop ex)
- ('err (let ((e (should-error (erc-send-current-line))))
- (should (string-match (rx (| "trailing" "blank"))
- (cadr e))))
- (should (equal (erc-user-input) input))
- (should-not (funcall next)))
- ('nop (erc-send-current-line)
- (should (equal (erc-user-input) input))
- (should-not (funcall next)))
- ((and (pred consp) v)
- (erc-send-current-line)
- (should (string-empty-p (erc-user-input)))
- (setq v (reverse v)) ; don't use `nreverse' here
- (while v
- (pcase (pop v)
- ((and (pred integerp) n)
- (should (string-search
- (nth n erc-tests--check-prompt-input-messages)
- messages)))
- ('s (should (equal " \n" (car (funcall next)))))
- ('a (should (equal "a\n" (car (funcall next)))))
- ('b (should (equal "b\n" (car (funcall next)))))))
- (should-not (funcall next)))))
- (delete-region erc-input-marker (point-max)))))))))
-
-(ert-deftest erc--check-prompt-input-for-multiline-blanks/explanations ()
- (should erc-warn-about-blank-lines)
- (should-not erc-send-whitespace-lines)
-
- (let ((erc-send-whitespace-lines t))
- (pcase-dolist (`(,input ,msg)
- '((("") "Padding (1) blank line")
- (("" " ") "Padding (1) blank line")
- ((" " "") "Stripping (1) blank line")
- (("a" "") "Stripping (1) blank line")
- (("" "") "Stripping (1) and padding (1) blank lines")
- (("" "" "") "Stripping (2) and padding (1) blank lines")
- (("" "a" "" "b" "" "c" "" "")
- "Stripping (2) and padding (3) blank lines")))
- (ert-info ((format "Input: %S, Msg: %S" input msg))
- (let (erc--check-prompt-explanation)
- (should-not (erc--check-prompt-input-for-multiline-blanks nil input))
- (should (equal (list msg) erc--check-prompt-explanation))))))
-
- (pcase-dolist (`(,input ,msg)
- '((("") "Blank line detected")
- (("" " ") "2 blank lines detected")
- ((" " "") "2 blank (1 trailing) lines detected")
- (("a" "") "Trailing line detected")
- (("" "") "2 blank (1 trailing) lines detected")
- (("a" "" "") "2 trailing lines detected")
- (("" "a" "" "b" "" "c" "" "")
- "5 blank (2 trailing) lines detected")))
- (ert-info ((format "Input: %S, Msg: %S" input msg))
- (let ((rv (erc--check-prompt-input-for-multiline-blanks nil input)))
- (should (equal (concat msg " (see `erc-send-whitespace-lines')")
- rv ))))))
-
-(ert-deftest erc-send-whitespace-lines ()
- (erc-tests-common-with-process-input-spy
- (lambda (next)
- (erc-tests-common-make-server-buf (buffer-name))
-
- (setq-local erc-send-whitespace-lines t)
-
- (ert-info ("Multiline hunk with blank line correctly split")
- (insert "one\n\ntwo")
- (erc-send-current-line)
- (ert-info ("Prompt restored")
- (forward-line 0)
- (should (looking-at-p erc-prompt)))
- (ert-info ("Input cleared")
- (erc-bol)
- (should (eq (point) (point-max))))
- (should (equal (funcall next) '("two\n" nil t)))
- (should (equal (funcall next) '(" \n" nil t)))
- (should (equal (funcall next) '("one\n" nil t))))
-
- (ert-info ("Multiline hunk with trailing newline filtered")
- (insert "hi\n")
- (erc-send-current-line)
- (ert-info ("Input cleared")
- (erc-bol)
- (should (eq (point) (point-max))))
- (should (equal (funcall next) '("hi\n" nil t)))
- (should-not (funcall next)))
-
- (ert-info ("Multiline hunk with trailing carriage filtered")
- (insert "hi\r")
- (erc-send-current-line)
- (ert-info ("Input cleared")
- (erc-bol)
- (should (eq (point) (point-max))))
- (should (equal (funcall next) '("hi\n" nil t)))
- (should-not (funcall next)))
-
- (ert-info ("Multiline command with trailing blank filtered")
- (dolist (p '("/a b" "/a b\n" "/a b\n\n" "/a b\n\n\n"))
- (insert p)
- (erc-send-current-line)
- (erc-bol)
- (should (eq (point) (point-max)))
- (should (pcase (funcall next) (`(,cmd ,_ nil) (equal cmd "/a b\n"))))
- (should-not (funcall next))))
-
- (ert-info ("Multiline command with non-blanks errors")
- (dolist (p '("/a b\nc\n\n" "/a b\n/c\n\n" "/a b\n\nc\n\n"
- "/a\n c\n" "/a\nb\n" "/a\n/b\n" "/a \n \n"))
- (insert p)
- (should-error (erc-send-current-line))
- (goto-char erc-input-marker)
- (delete-region (point) (point-max))
- (should-not (funcall next))))
-
- (ert-info ("Multiline hunk with trailing whitespace not filtered")
- (insert "there\n ")
- (erc-send-current-line)
- (should (equal (funcall next) '(" \n" nil t)))
- (should (equal (funcall next) '("there\n" nil t)))
- (should-not (funcall next))))))
-
-(ert-deftest erc--check-prompt-input-for-excess-lines ()
- (ert-info ("Without `erc-inhibit-multiline-input'")
- (should-not erc-inhibit-multiline-input)
- (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b"))))
-
- (ert-info ("With `erc-inhibit-multiline-input' as t (2)")
- (let ((erc-inhibit-multiline-input t))
- (should-not (erc--check-prompt-input-for-excess-lines "" '("a")))
- ;; Does not trim trailing blanks.
- (should (erc--check-prompt-input-for-excess-lines "" '("a" "")))
- (should (erc--check-prompt-input-for-excess-lines "" '("a" "b")))))
-
- (ert-info ("With `erc-inhibit-multiline-input' as 3")
- (let ((erc-inhibit-multiline-input 3))
- (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b")))
- (should (erc--check-prompt-input-for-excess-lines "" '("a" "b" "")))
- (should (erc--check-prompt-input-for-excess-lines "" '("a" "b" "c")))))
-
- (ert-info ("With `erc-ask-about-multiline-input'")
- (let ((erc-inhibit-multiline-input t)
- (erc-ask-about-multiline-input t))
- (ert-simulate-keys '(?n ?\r ?y ?\r)
- (should (erc--check-prompt-input-for-excess-lines "" '("a" "b")))
- (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b")))))
- (should-not erc-ask-about-multiline-input)))
-
-(ert-deftest erc-extract-command-from-line ()
- ;; FIXME when next modifying `erc-command-regexp's default value,
- ;; move the single quote in the first group's character alternative
- ;; to the front, i.e., [A-Za-z'] -> ['A-Za-z], so we can assert
- ;; equivalence with this more readable `rx' form.
- (rx bol
- "/"
- (group (+ (in "'A-Za-z")))
- (group (| (: (+ (syntax whitespace)) (* nonl))
- (* (syntax whitespace))))
- eol)
- (erc-mode) ; for `erc-mode-syntax-table'
-
- ;; Non-command.
- (should-not (erc-extract-command-from-line "FAKE\n"))
- ;; Unknown command.
- (should (equal (erc-extract-command-from-line "/FAKE\n")
- '(erc-cmd-default "/FAKE\n")))
-
- (ert-info ("With `do-not-parse-args'")
- (should (equal (erc-extract-command-from-line "/MSG\n")
- '(erc-cmd-MSG "\n")))
- (should (equal (erc-extract-command-from-line "/MSG \n")
- '(erc-cmd-MSG " \n")))
- (should (equal (erc-extract-command-from-line "/MSG \n\n")
- '(erc-cmd-MSG " \n\n")))
- (should (equal (erc-extract-command-from-line "/MSG foo\n")
- '(erc-cmd-MSG " foo")))
- (should (equal (erc-extract-command-from-line "/MSG foo\n\n")
- '(erc-cmd-MSG " foo")))
- (should (equal (erc-extract-command-from-line "/MSG foo\n \n")
- '(erc-cmd-MSG " foo")))
- (should (equal (erc-extract-command-from-line "/MSG foo\n")
- '(erc-cmd-MSG " foo")))))
-
-;; The point of this test is to ensure output is handled identically
-;; regardless of whether a command handler is summoned.
-
-(ert-deftest erc-process-input-line ()
- (erc-tests-common-make-server-buf)
- (let ((orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG))
- (pop-flood-queue (lambda () (erc-with-server-buffer
- (pop erc-server-flood-queue))))
- calls)
- (setq erc-server-current-nick "tester")
- (with-current-buffer (erc--open-target "#chan")
- (cl-letf (((symbol-function 'erc-cmd-MSG)
- (lambda (line)
- (push line calls)
- (should erc--called-as-input-p)
- (funcall orig-erc-cmd-MSG line)))
- ((symbol-function 'erc-server-send-queue)
- #'ignore))
-
- (ert-info ("Dispatch to user command handler")
-
- (ert-info ("Baseline")
- (erc-process-input-line "/msg #chan hi\n")
- (should (equal (pop calls) " #chan hi"))
- (should (equal (funcall pop-flood-queue)
- '("PRIVMSG #chan :hi\r\n" . utf-8))))
-
- (ert-info ("Quote preserves line intact")
- (erc-process-input-line "/QUOTE FAKE foo bar\n")
- (should (equal (funcall pop-flood-queue)
- '("FAKE foo bar\r\n" . utf-8))))
-
- (ert-info ("Unknown command respected")
- (erc-process-input-line "/FAKE foo bar\n")
- (should (equal (funcall pop-flood-queue)
- '("FAKE foo bar\r\n" . utf-8))))
-
- (ert-info ("Spaces preserved")
- (erc-process-input-line "/msg #chan hi you\n")
- (should (equal (pop calls) " #chan hi you"))
- (should (equal (funcall pop-flood-queue)
- '("PRIVMSG #chan :hi you\r\n" . utf-8))))
-
- (ert-info ("Empty line honored")
- (erc-process-input-line "/msg #chan\n")
- (should (equal (pop calls) " #chan"))
- (should (equal (funcall pop-flood-queue)
- '("PRIVMSG #chan :\r\n" . utf-8)))))
-
- (ert-info ("Implicit cmd via `erc-send-input-line-function'")
-
- (ert-info ("Baseline")
- (erc-process-input-line "hi\n")
- (should (equal (funcall pop-flood-queue)
- '("PRIVMSG #chan :hi\r\n" . utf-8))))
-
- (ert-info ("Spaces preserved")
- (erc-process-input-line "hi you\n")
- (should (equal (funcall pop-flood-queue)
- '("PRIVMSG #chan :hi you\r\n" . utf-8))))
-
- (ert-info ("Empty line transmitted with injected-space kludge")
- (erc-process-input-line "\n")
- (should (equal (funcall pop-flood-queue)
- '("PRIVMSG #chan : \r\n" . utf-8))))
-
- (should-not calls)))))
- (erc-tests-common-kill-buffers))
-
-(ert-deftest erc--get-inserted-msg-beg/basic ()
- (erc-tests-common-assert-get-inserted-msg/basic
- (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))
-
-(ert-deftest erc--get-inserted-msg-beg/truncated ()
- (erc-tests-common-assert-get-inserted-msg/truncated
- (lambda (arg) (should (= 1 (erc--get-inserted-msg-beg arg))))))
-
-(ert-deftest erc--get-inserted-msg-end/basic ()
- (erc-tests-common-assert-get-inserted-msg/basic
- (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg))))))
-
-(ert-deftest erc--get-inserted-msg-bounds/basic ()
- (erc-tests-common-assert-get-inserted-msg/basic
- (lambda (arg)
- (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg))))))
-
-(ert-deftest erc--insert-before-markers-transplanting-hidden ()
- (with-current-buffer (get-buffer-create "*erc-test*")
- (erc-mode)
- (erc-tests-common-prep-for-insertion)
-
- ;; Create a message that has a foreign invisibility property on
- ;; its trailing newline that's not claimed by the next message.
- (let ((erc-insert-post-hook
- (lambda ()
- (put-text-property (point-min) (point-max) 'invisible 'b))))
- (erc-display-message nil 'notice (current-buffer) "before"))
- (should (eq 'b (get-text-property (1- erc-insert-marker) 'invisible)))
-
- ;; Insert a message that's hidden with `erc--hide-message'. It
- ;; advertises `invisible' value `a', applied on the trailing
- ;; newline of the previous message.
- (let ((erc-insert-post-hook (lambda () (erc--hide-message 'a))))
- (erc-display-message nil 'notice (current-buffer) "after"))
-
- (goto-char (point-min))
- (should (search-forward "*** before\n" nil t))
- (should (equal '(a b) (get-text-property (1- (point)) 'invisible)))
-
- ;; Splice in a new message.
- (let ((erc--insert-line-function
- #'erc--insert-before-markers-transplanting-hidden)
- (erc--insert-marker (copy-marker (point))))
- (goto-char (point-max))
- (erc-display-message nil 'notice (current-buffer) "middle"))
-
- (goto-char (point-min))
- (should (search-forward "*** before\n" nil t))
- (should (eq 'b (get-text-property (1- (point)) 'invisible)))
- (should (looking-at (rx "*** middle\n")))
- (should (eq 'a (get-text-property (pos-eol) 'invisible)))
- (forward-line)
- (should (looking-at (rx "*** after\n")))
-
- (setq buffer-invisibility-spec nil)
- (when noninteractive (kill-buffer))))
-
-(ert-deftest erc--delete-inserted-message-naively ()
- (erc-mode)
- (erc--initialize-markers (point) nil)
- ;; Put unique invisible properties on the line endings.
- (erc-display-message nil 'notice nil "one")
- (put-text-property (1- erc-insert-marker) erc-insert-marker 'invisible 'a)
- (let ((erc--msg-prop-overrides '((erc--msg . datestamp) (erc--ts . 0))))
- (erc-display-message nil nil nil
- (propertize "\n[date]" 'field 'erc-timestamp)))
- (put-text-property (1- erc-insert-marker) erc-insert-marker 'invisible 'b)
- (erc-display-message nil 'notice nil "two")
-
- (ert-info ("Date stamp deleted cleanly")
- (goto-char 11)
- (should (looking-at (rx "\n[date]")))
- (should (eq 'datestamp (get-text-property (point) 'erc--msg)))
- (should (eq (point) (field-beginning (1+ (point)))))
-
- (erc--delete-inserted-message-naively (point))
-
- ;; Preceding line ending clobbered, replaced by trailing.
- (should (looking-back (rx "*** one\n")))
- (should (looking-at (rx "*** two")))
- (should (eq 'b (get-text-property (1- (point)) 'invisible))))
-
- (ert-info ("Markers at pos-bol preserved")
- (erc-display-message nil 'notice nil "three")
- (should (looking-at (rx "*** two")))
-
- (let ((m (point-marker))
- (n (point-marker))
- (p (point)))
- (set-marker-insertion-type m t)
- (goto-char (point-max))
- (erc--delete-inserted-message-naively p)
- (should (= (marker-position n) p))
- (should (= (marker-position m) p))
- (goto-char p)
- (set-marker m nil)
- (set-marker n nil)
- (should (looking-back (rx "*** one\n")))
- (should (looking-at (rx "*** three")))))
-
- (ert-info ("Compat")
- (erc-display-message nil 'notice nil "four")
- (should (looking-at (rx "*** three\n")))
- (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
- (let ((erc-legacy-invisible-bounds-p t))
- (erc--delete-inserted-message-naively (point))))
- (should (looking-at (rx "*** four\n"))))
-
- (ert-info ("Deleting most recent message preserves markers")
- (let ((m (point-marker))
- (n (point-marker))
- (p (point)))
- (should (equal "*** four\n" (buffer-substring p erc-insert-marker)))
- (set-marker-insertion-type m t)
- (goto-char (point-max))
- (erc--delete-inserted-message-naively p)
- (should (= (marker-position m) p))
- (should (= (marker-position n) p))
- (goto-char p)
- (should (looking-back (rx "*** one\n")))
- (should (looking-at erc-prompt))
- (erc--assert-input-bounds)
-
- ;; However, `m' is now forever "trapped" at `erc-insert-marker'.
- (erc-display-message nil 'notice nil "two")
- (should (= m erc-insert-marker))
- (goto-char n)
- (should (looking-at (rx "*** two\n")))
- (set-marker m nil)
- (set-marker n nil))))
-
-(ert-deftest erc--order-text-properties-from-hash ()
- (let ((table (map-into '((a . 1)
- (erc--ts . 0)
- (erc--msg . s005)
- (b . 2)
- (erc--cmd . 5)
- (erc--spkr . "X")
- (c . 3))
- 'hash-table)))
- (with-temp-buffer
- (erc-mode)
- (insert "abc\n")
- (add-text-properties 1 2 (erc--order-text-properties-from-hash table))
- (should (equal '( erc--msg s005
- erc--spkr "X"
- erc--ts 0
- erc--cmd 5
- a 1
- b 2
- c 3)
- (text-properties-at (point-min)))))))
-
-(ert-deftest erc--check-msg-prop ()
- (let ((erc--msg-props (map-into '((a . 1) (b . x)) 'hash-table)))
- (should (eq 1 (erc--check-msg-prop 'a)))
- (should (erc--check-msg-prop 'a 1))
- (should-not (erc--check-msg-prop 'a 2))
-
- (should (eq 'x (erc--check-msg-prop 'b)))
- (should (erc--check-msg-prop 'b 'x))
- (should-not (erc--check-msg-prop 'b 1))
-
- (should (erc--check-msg-prop 'a '(1 42)))
- (should-not (erc--check-msg-prop 'a '(2 42)))
-
- (let ((props '(42 x)))
- (should (erc--check-msg-prop 'b props)))
- (let ((v '(42 y)))
- (should-not (erc--check-msg-prop 'b v)))))
-
-(ert-deftest erc--memq-msg-prop ()
- (let ((erc--msg-props (map-into '((a . 1) (b x y)) 'hash-table)))
- (should-not (erc--memq-msg-prop 'a 1))
- (should-not (erc--memq-msg-prop 'b 'z))
- (should (erc--memq-msg-prop 'b 'x))
- (should (erc--memq-msg-prop 'b 'y))))
-
-(ert-deftest erc--merge-prop ()
- (with-current-buffer (get-buffer-create "*erc-test*")
- ;; Baseline.
- (insert "abc\n")
- (erc--merge-prop 1 3 'erc-test 'x)
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("abc" 0 2 (erc-test x))))
- (erc--merge-prop 1 3 'erc-test 'y)
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("abc" 0 2 (erc-test (y x)))))
-
- ;; Multiple intervals.
- (goto-char (point-min))
- (insert "def\n")
- (erc--merge-prop 1 2 'erc-test 'x)
- (erc--merge-prop 2 3 'erc-test 'y)
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4)
- #("def" 0 1 (erc-test x) 1 2 (erc-test y))))
- (erc--merge-prop 1 3 'erc-test 'z)
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4)
- #("def" 0 1 (erc-test (z x)) 1 2 (erc-test (z y)))))
-
- ;; New val as list.
- (goto-char (point-min))
- (insert "ghi\n")
- (erc--merge-prop 2 3 'erc-test '(y z))
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("ghi" 1 2 (erc-test (y z)))))
- (erc--merge-prop 1 3 'erc-test '(w x))
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4)
- #("ghi" 0 1 (erc-test (w x)) 1 2 (erc-test (w x y z)))))
-
- ;; Flag `erc--merge-prop-behind-p'.
- (goto-char (point-min))
- (insert "jkl\n")
- (erc--merge-prop 2 3 'erc-test '(y z))
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("jkl" 1 2 (erc-test (y z)))))
- (let ((erc--merge-prop-behind-p t))
- (erc--merge-prop 1 3 'erc-test '(w x)))
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4)
- #("jkl" 0 1 (erc-test (w x)) 1 2 (erc-test (y z w x)))))
-
- (when noninteractive
- (kill-buffer))))
-
-(ert-deftest erc--remove-from-prop-value-list ()
- (with-current-buffer (get-buffer-create "*erc-test*")
- ;; Non-list match.
- (insert "abc\n")
- (put-text-property 1 2 'erc-test 'a)
- (put-text-property 2 3 'erc-test 'b)
- (put-text-property 3 4 'erc-test 'c)
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("abc"
- 0 1 (erc-test a)
- 1 2 (erc-test b)
- 2 3 (erc-test c))))
-
- (erc--remove-from-prop-value-list 1 4 'erc-test 'b)
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("abc"
- 0 1 (erc-test a)
- 2 3 (erc-test c))))
- (erc--remove-from-prop-value-list 1 4 'erc-test 'a)
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
- (erc--remove-from-prop-value-list 1 4 'erc-test 'c)
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) "abc"))
-
- ;; List match.
- (goto-char (point-min))
- (insert "def\n")
- (put-text-property 1 2 'erc-test '(d x))
- (put-text-property 2 3 'erc-test '(e y))
- (put-text-property 3 4 'erc-test '(f z))
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("def"
- 0 1 (erc-test (d x))
- 1 2 (erc-test (e y))
- 2 3 (erc-test (f z)))))
- (erc--remove-from-prop-value-list 1 4 'erc-test 'y)
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("def"
- 0 1 (erc-test (d x))
- 1 2 (erc-test e)
- 2 3 (erc-test (f z)))))
- (erc--remove-from-prop-value-list 1 4 'erc-test 'd)
- (erc--remove-from-prop-value-list 1 4 'erc-test 'f)
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("def"
- 0 1 (erc-test x)
- 1 2 (erc-test e)
- 2 3 (erc-test z))))
- (erc--remove-from-prop-value-list 1 4 'erc-test 'e)
- (erc--remove-from-prop-value-list 1 4 'erc-test 'z)
- (erc--remove-from-prop-value-list 1 4 'erc-test 'x)
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) "def"))
-
- ;; List match.
- (goto-char (point-min))
- (insert "ghi\n")
- (put-text-property 1 2 'erc-test '(g x))
- (put-text-property 2 3 'erc-test '(h x))
- (put-text-property 3 4 'erc-test '(i y))
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("ghi"
- 0 1 (erc-test (g x))
- 1 2 (erc-test (h x))
- 2 3 (erc-test (i y)))))
- (erc--remove-from-prop-value-list 1 4 'erc-test 'x)
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("ghi"
- 0 1 (erc-test g)
- 1 2 (erc-test h)
- 2 3 (erc-test (i y)))))
- (erc--remove-from-prop-value-list 1 2 'erc-test 'g) ; narrowed
- (erc--remove-from-prop-value-list 3 4 'erc-test 'i) ; narrowed
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("ghi"
- 1 2 (erc-test h)
- 2 3 (erc-test y))))
-
- ;; Pathological (,c) case (hopefully not created by ERC)
- (goto-char (point-min))
- (insert "jkl\n")
- (put-text-property 1 2 'erc-test '(j x))
- (put-text-property 2 3 'erc-test '(k))
- (put-text-property 3 4 'erc-test '(k))
- (erc--remove-from-prop-value-list 1 4 'erc-test 'k)
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("jkl" 0 1 (erc-test (j x)))))
-
- (when noninteractive
- (kill-buffer))))
-
-(ert-deftest erc--remove-from-prop-value-list/many ()
- (with-current-buffer (get-buffer-create "*erc-test*")
- ;; Non-list match.
- (insert "abc\n")
- (put-text-property 1 2 'erc-test 'a)
- (put-text-property 2 3 'erc-test 'b)
- (put-text-property 3 4 'erc-test 'c)
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("abc"
- 0 1 (erc-test a)
- 1 2 (erc-test b)
- 2 3 (erc-test c))))
-
- (erc--remove-from-prop-value-list 1 4 'erc-test '(a b))
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
- (erc--remove-from-prop-value-list 1 4 'erc-test 'a)
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
- (erc--remove-from-prop-value-list 1 4 'erc-test '(c))
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) "abc"))
-
- ;; List match.
- (goto-char (point-min))
- (insert "def\n")
- (put-text-property 1 2 'erc-test '(d x y))
- (put-text-property 2 3 'erc-test '(e y))
- (put-text-property 3 4 'erc-test '(f z))
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("def"
- 0 1 (erc-test (d x y))
- 1 2 (erc-test (e y))
- 2 3 (erc-test (f z)))))
- (erc--remove-from-prop-value-list 1 4 'erc-test '(d y f))
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("def"
- 0 1 (erc-test x)
- 1 2 (erc-test e)
- 2 3 (erc-test z))))
- (erc--remove-from-prop-value-list 1 4 'erc-test '(e z x))
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) "def"))
-
- ;; Narrowed beg.
- (goto-char (point-min))
- (insert "ghi\n")
- (put-text-property 1 2 'erc-test '(g x))
- (put-text-property 2 3 'erc-test '(h x))
- (put-text-property 3 4 'erc-test '(i x))
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("ghi"
- 0 1 (erc-test (g x))
- 1 2 (erc-test (h x))
- 2 3 (erc-test (i x)))))
- (erc--remove-from-prop-value-list 1 3 'erc-test '(x g i))
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("ghi"
- 1 2 (erc-test h)
- 2 3 (erc-test (i x)))))
-
- ;; Narrowed middle.
- (goto-char (point-min))
- (insert "jkl\n")
- (put-text-property 1 2 'erc-test '(j x))
- (put-text-property 2 3 'erc-test '(k))
- (put-text-property 3 4 'erc-test '(l y z))
- (erc--remove-from-prop-value-list 3 4 'erc-test '(k x y z))
- (should (erc-tests-common-equal-with-props
- (buffer-substring 1 4) #("jkl"
- 0 1 (erc-test (j x))
- 1 2 (erc-test (k))
- 2 3 (erc-test l))))
-
- (when noninteractive
- (kill-buffer))))
-
-(ert-deftest erc--restore-important-text-props ()
- (erc-mode)
- (let ((erc--msg-props (map-into '((erc--important-prop-names a))
- 'hash-table)))
- (insert (propertize "foo" 'a 'A 'b 'B 'erc--important-props '(a A))
- " "
- (propertize "bar" 'c 'C 'a 'A 'b 'B
- 'erc--important-props '(a A c C)))
-
- ;; Attempt to restore a and c when only a is registered.
- (remove-list-of-text-properties (point-min) (point-max) '(a c))
- (erc--restore-important-text-props '(a c))
- (should (erc-tests-common-equal-with-props
- (buffer-string)
- #("foo bar"
- 0 3 (a A b B erc--important-props (a A))
- 4 7 (a A b B erc--important-props (a A c C)))))
-
- ;; Add d between 3 and 6.
- (erc--reserve-important-text-props 3 6 '(d D))
- (put-text-property 3 6 'd 'D)
- (should (erc-tests-common-equal-with-props
- (buffer-string)
- #("foo bar" ; #1
- 0 2 (a A b B erc--important-props (a A))
- 2 3 (d D a A b B erc--important-props (d D a A))
- 3 4 (d D erc--important-props (d D))
- 4 5 (d D a A b B erc--important-props (d D a A c C))
- 5 7 (a A b B erc--important-props (a A c C)))))
- ;; Remove a and d, and attempt to restore d.
- (remove-list-of-text-properties (point-min) (point-max) '(a d))
- (erc--restore-important-text-props '(d))
- (should (erc-tests-common-equal-with-props
- (buffer-string)
- #("foo bar"
- 0 2 (b B erc--important-props (a A))
- 2 3 (d D b B erc--important-props (d D a A))
- 3 4 (d D erc--important-props (d D))
- 4 5 (d D b B erc--important-props (d D a A c C))
- 5 7 (b B erc--important-props (a A c C)))))
-
- ;; Restore a only.
- (erc--restore-important-text-props '(a))
- (should (erc-tests-common-equal-with-props
- (buffer-string)
- #("foo bar" ; same as #1 above
- 0 2 (a A b B erc--important-props (a A))
- 2 3 (d D a A b B erc--important-props (d D a A))
- 3 4 (d D erc--important-props (d D))
- 4 5 (d D a A b B erc--important-props (d D a A c C))
- 5 7 (a A b B erc--important-props (a A c C)))))))
-
-(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
-;; part of the original prompt submission:
-;;
-;; 5.4: both seen and sent
-;; 5.5: seen but not sent*
-;; 5.6: neither seen nor sent*
-;;
-;; * requires `erc-send-whitespace-lines' for hook to run
-;;
-;; Two aspects that have remained consistent are
-;;
-;; - a final nonempty line in any submission is always sent
-;; - a trailing newline appended by a hook member is always sent
-;;
-;; The last bullet would seem to contradict the "not sent" behavior of
-;; 5.5 and 5.6, but what's actually happening is that exactly one
-;; trailing newline is culled, so anything added always goes through.
-;; Also, in ERC 5.6, all empty lines are actually padded, but this is
-;; merely incidental WRT the above.
-;;
-;; Note that this test doesn't run any input-prep hooks and thus can't
-;; account for the "seen" dimension noted above.
-
-(ert-deftest erc--run-send-hooks ()
- (with-suppressed-warnings ((obsolete erc-send-this)
- (obsolete erc-send-pre-hook))
- (should erc-insert-this)
- (should erc-send-this) ; populates `erc--input-split-sendp'
-
- (let (erc-pre-send-functions erc-send-pre-hook)
-
- (ert-info ("String preserved, lines rewritten, empties padded")
- (setq erc-pre-send-functions
- (lambda (o) (setf (erc-input-string o) "bar\n\nbaz\n")))
- (should (pcase (erc--run-send-hooks (make-erc--input-split
- :string "foo" :lines '("foo")))
- ((cl-struct erc--input-split
- (string "foo") (sendp 't) (insertp 't)
- (lines '("bar" " " "baz" " ")) (cmdp 'nil))
- t))))
-
- (ert-info ("Multiline commands rejected")
- (should-error (erc--run-send-hooks (make-erc--input-split
- :string "/mycmd foo"
- :lines '("/mycmd foo")
- :cmdp t))))
-
- (ert-info ("Single-line commands pass")
- (setq erc-pre-send-functions
- (lambda (o) (setf (erc-input-sendp o) nil
- (erc-input-string o) "/mycmd bar")))
- (should (pcase (erc--run-send-hooks (make-erc--input-split
- :string "/mycmd foo"
- :lines '("/mycmd foo")
- :cmdp t))
- ((cl-struct erc--input-split
- (string "/mycmd foo") (sendp 'nil) (insertp 't)
- (lines '("/mycmd bar")) (cmdp 't))
- t))))
-
- (ert-info ("Legacy hook respected, special vars confined")
- (setq erc-send-pre-hook (lambda (_) (setq erc-send-this nil))
- erc-pre-send-functions (lambda (o) ; propagates
- (should-not (erc-input-sendp o))))
- (should (pcase (erc--run-send-hooks (make-erc--input-split
- :string "foo" :lines '("foo")))
- ((cl-struct erc--input-split
- (string "foo") (sendp 'nil) (insertp 't)
- (lines '("foo")) (cmdp 'nil))
- t)))
- (should erc-send-this))
-
- (ert-info ("Request to resplit honored")
- (setq erc-send-pre-hook nil
- erc-pre-send-functions
- (lambda (o) (setf (erc-input-string o) "foo bar baz"
- (erc-input-refoldp o) t)))
- (let* ((split (make-erc--input-split :string "foo" :lines '("foo")))
- (erc--current-line-input-split split)
- (erc-split-line-length 8))
- (should
- (pcase (erc--run-send-hooks split)
- ((cl-struct erc--input-split
- (string "foo") (sendp 't) (insertp 't)
- (lines '("foo bar " "baz")) (cmdp 'nil))
- t))))))))
-
-;; Note: if adding an erc-backend-tests.el, please relocate this there.
-
-(ert-deftest erc-message ()
- (should-not erc-server-last-peers)
- (let (server-proc
- calls
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
- (cl-letf (((symbol-function 'erc-display-message)
- (lambda (_ _ _ msg &rest args)
- (ignore (push (apply #'erc-format-message msg args) calls))))
- ((symbol-function 'erc-server-send)
- (lambda (line _) (push line calls)))
- ((symbol-function 'erc-server-buffer)
- (lambda () (process-buffer server-proc))))
- (with-current-buffer (get-buffer-create "ExampleNet")
- (erc-mode)
- (setq erc-server-current-nick "tester"
- server-proc (start-process "sleep" (current-buffer) "sleep" "1")
- erc-server-process server-proc
- erc-server-last-peers (cons nil nil)
- erc-server-users (make-hash-table :test 'equal)
- erc-network 'ExampleNet)
- (set-process-query-on-exit-flag erc-server-process nil))
-
- (with-current-buffer (get-buffer-create "#chan")
- (erc-mode)
- (setq erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "ExampleNet"))
- erc--target (erc--target-from-string "#chan")
- erc-default-recipients '("#chan")
- erc-channel-users (make-hash-table :test 'equal)
- erc-network 'ExampleNet)
- (erc-update-current-channel-member "alice" "alice")
- (erc-update-current-channel-member "tester" "tester"))
-
- (with-current-buffer "ExampleNet"
- (erc-server-PRIVMSG erc-server-process
- (make-erc-response
- :sender "alice!~u@fsf.org"
- :command "PRIVMSG"
- :command-args '("#chan" "hi")
- :unparsed ":alice!~u@fsf.org PRIVMSG #chan :hi"))
- (should (equal erc-server-last-peers '("alice")))
- (should (string-match "<alice>" (pop calls))))
-
- (with-current-buffer "#chan"
- (ert-info ("Shortcuts usable in target buffers")
- (should-not (local-variable-p 'erc-server-last-peers))
- (should-not erc-server-last-peers)
- (erc-message "PRIVMSG" ". hi")
- (should-not erc-server-last-peers)
- (should (equal "No target" (pop calls)))
- (erc-message "PRIVMSG" ", hi")
- (should-not erc-server-last-peers)
- (should (string-match "alice :hi" (pop calls)))))
-
- (with-current-buffer "ExampleNet"
- (ert-info ("Shortcuts local in server bufs")
- (should (equal erc-server-last-peers '("alice" . "alice")))
- (erc-message "PRIVMSG" ", hi")
- (should (equal erc-server-last-peers '("alice" . "alice")))
- (should (string-match "PRIVMSG alice :hi" (pop calls)))
- (setcdr erc-server-last-peers "bob")
- (erc-message "PRIVMSG" ". hi")
- (should (equal erc-server-last-peers '("alice" . "bob")))
- (should (string-match "PRIVMSG bob :hi" (pop calls)))))
-
- (with-current-buffer "#chan"
- (ert-info ("Non-shortcuts are local to server buffer")
- (should-not (local-variable-p 'erc-server-last-peers))
- (should-not erc-server-last-peers)
- (erc-message "PRIVMSG" "#chan hola")
- (should-not erc-server-last-peers)
- (should-not (default-value 'erc-server-last-peers))
- (should (equal (buffer-local-value 'erc-server-last-peers
- (get-buffer "ExampleNet"))
- '("alice" . "#chan")))
- (should (string-match "hola" (pop calls))))))
-
- (should-not erc-server-last-peers)
- (should-not calls)
- (kill-buffer "ExampleNet")
- (kill-buffer "#chan")))
-
-(ert-deftest erc-get-channel-membership-prefix ()
- (ert-info ("Uses default prefixes when `erc--parsed-prefix' not available")
- (should-not (erc--parsed-prefix))
- ;; Baseline.
- (should-not (erc-get-channel-membership-prefix nil))
- (should (equal (erc-get-channel-membership-prefix "Bob") ""))
- (should (equal (erc-get-channel-membership-prefix (make-erc-channel-user))
- ""))
- ;; Defaults.
- (should
- (erc-tests-common-equal-with-props
- (erc-get-channel-membership-prefix (make-erc-channel-user :owner t))
- #("~" 0 1 (help-echo "owner"))))
- (should
- (erc-tests-common-equal-with-props
- (erc-get-channel-membership-prefix (make-erc-channel-user :admin t))
- #("&" 0 1 (help-echo "admin"))))
- (should
- (erc-tests-common-equal-with-props
- (erc-get-channel-membership-prefix (make-erc-channel-user :op t))
- #("@" 0 1 (help-echo "operator"))))
- (should
- (erc-tests-common-equal-with-props
- (erc-get-channel-membership-prefix (make-erc-channel-user :halfop t))
- #("%" 0 1 (help-echo "half-op"))))
- (should
- (erc-tests-common-equal-with-props
- (erc-get-channel-membership-prefix (make-erc-channel-user :voice t))
- #("+" 0 1 (help-echo "voice")))))
-
- (ert-info ("Uses advertised prefixes when `erc--parsed-prefix' is available")
- (erc-tests-common-make-server-buf (buffer-name))
- (push '("PREFIX" . "(ov)@+") erc-server-parameters)
- (should (erc--parsed-prefix))
-
- (with-current-buffer (erc--open-target "#chan")
- (erc-update-current-channel-member "Bob" nil t nil nil 'on)
-
- ;; Baseline.
- (should-not (erc-get-channel-membership-prefix nil))
- (should (string-empty-p (erc-get-channel-membership-prefix
- (make-erc-channel-user))))
-
- ;; Defaults.
- (should (string-empty-p (erc-get-channel-membership-prefix
- (make-erc-channel-user :owner t))))
- (should (string-empty-p (erc-get-channel-membership-prefix
- (make-erc-channel-user :admin t))))
- (should (string-empty-p (erc-get-channel-membership-prefix
- (make-erc-channel-user :halfop t))))
-
- (should (erc-tests-common-equal-with-props
- (erc-get-channel-membership-prefix "Bob")
- #("@" 0 1 (help-echo "operator"))))
- (should (erc-tests-common-equal-with-props
- (erc-get-channel-membership-prefix
- (make-erc-channel-user :voice t))
- #("+" 0 1 (help-echo "voice"))))
-
- (kill-buffer))))
-
-;; This is an adapter that uses formatting templates from the
-;; `-speaker' catalog to mimic `erc-format-privmessage', for testing
-;; purposes.
-(defun erc-tests--format-privmessage (nick msg privp msgp &optional inputp pfx)
- (let ((erc-current-message-catalog erc--message-speaker-catalog))
- (apply #'erc-format-message
- (erc--determine-speaker-message-format-args nick msg privp msgp
- inputp nil pfx))))
-
-;; This test demonstrates that ERC uses the same string for the
-;; `erc--spkr' and `erc--speaker' text properties, which it gets from
-;; the `nickname' shot of the speaker's server user.
-(ert-deftest erc--speakerize-nick ()
- (erc-tests-common-make-server-buf)
- (setq erc-server-current-nick "tester")
-
- (let ((sentinel "alice"))
- (with-current-buffer (erc--open-target "#chan")
- (erc-update-current-channel-member "bob" "bob" t nil nil nil nil nil
- "example.org" "~u" "bob")
- (erc-update-current-channel-member "alice" sentinel t nil nil nil nil nil
- "fsf.org" "~u" "alice"))
-
- (erc-call-hooks nil (make-erc-response
- :sender "alice!~u@fsf.org"
- :command "PRIVMSG"
- :command-args '("#chan" "one")
- :contents "one"
- :unparsed ":alice!~u@fsf.org PRIVMSG #chan :one"))
- (erc-call-hooks nil (make-erc-response
- :sender "bob!~u@example.org"
- :command "PRIVMSG"
- :command-args '("#chan" "hi")
- :contents "hi"
- :unparsed ":bob!~u@example.org PRIVMSG #chan :hi"))
- (erc-call-hooks nil (make-erc-response
- :sender "alice!~u@fsf.org"
- :command "PRIVMSG"
- :command-args '("#chan" "two")
- :contents "two"
- :unparsed ":alice!~u@fsf.org PRIVMSG #chan :two"))
-
- (with-current-buffer (get-buffer "#chan")
- (should (eq sentinel
- (erc-server-user-nickname (erc-get-server-user "alice"))))
- (goto-char (point-min))
-
- (should (search-forward "<a" nil t))
- (should (looking-at "lice> one"))
- (should (eq (get-text-property (point) 'erc--speaker) sentinel))
- (should (eq (erc--get-inserted-msg-prop 'erc--spkr) sentinel))
-
- (should (search-forward "<bob> hi" nil t))
-
- (should (search-forward "<a" nil t))
- (should (looking-at "lice> two"))
- (should (eq (get-text-property (point) 'erc--speaker) sentinel))
- (should (eq (erc--get-inserted-msg-prop 'erc--spkr) sentinel))
-
- (when noninteractive (kill-buffer)))))
-
-;; This asserts that `erc--determine-speaker-message-format-args'
-;; behaves identically to `erc-format-privmessage', the function whose
-;; role it basically replaced.
-(ert-deftest erc--determine-speaker-message-format-args ()
- ;; Basic PRIVMSG.
- (let ((expect #("<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)))
- (args (list (concat "bob") (concat "oh my") nil 'msgp)))
- (should (erc-tests-common-equal-with-props
- (apply #'erc-format-privmessage args)
- expect))
- (should (erc-tests-common-equal-with-props
- (apply #'erc-tests--format-privmessage args)
- expect)))
-
- ;; Basic NOTICE.
- (let ((expect #("-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)))
- (args (list (copy-sequence "bob") (copy-sequence "oh my") nil nil)))
- (should (erc-tests-common-equal-with-props
- (apply #'erc-format-privmessage args)
- expect))
- (should (erc-tests-common-equal-with-props
- (apply #'erc-tests--format-privmessage args)
- expect)))
-
- ;; Status-prefixed PRIVMSG.
- (let* ((expect
- #("<@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)))
- (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)
-
- (with-suppressed-warnings ((obsolete erc-format-@nick))
- (should (erc-tests-common-equal-with-props
- (erc-format-privmessage (erc-format-@nick user cuser)
- (copy-sequence "oh my")
- nil 'msgp)
- expect)))
- (let ((nick "Bob")
- (msg "oh my"))
- (should (erc-tests-common-equal-with-props
- (erc-tests--format-privmessage nick msg nil 'msgp nil cuser)
- expect)) ; overloaded on PREFIX arg
- (should (erc-tests-common-equal-with-props
- (erc-tests--format-privmessage nick msg nil 'msgp nil t)
- expect))
- ;; The new version makes a copy instead of adding properties to
- ;; the input.
- (should-not
- (text-property-not-all 0 (length nick) 'font-lock-face nil nick))
- (should-not
- (text-property-not-all 0 (length msg) 'font-lock-face nil msg)))))
-
-(ert-deftest erc--determine-speaker-message-format-args/queries-as-channel ()
- (should erc-format-query-as-channel-p)
-
- (with-current-buffer (get-buffer-create "bob")
- (erc-mode)
- (setq erc--target (erc--target-from-string "alice"))
-
- (insert "PRIVMSG\n"
- (erc-tests--format-privmessage "bob" "oh my" 'queryp 'msgp))
- (should (erc-tests-common-equal-with-props
- #("<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))
- (buffer-substring (pos-bol) (pos-eol))))
-
- (insert "\nNOTICE\n"
- (erc-tests--format-privmessage "bob" "oh my" 'queryp nil))
- (should (erc-tests-common-equal-with-props
- #("-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))
- (buffer-substring (pos-bol) (pos-eol))))
-
- (insert "\nInput PRIVMSG\n"
- (erc-tests--format-privmessage "bob" "oh my"
- 'queryp 'privmsgp 'inputp))
- (should (erc-tests-common-equal-with-props
- #("<bob> oh my"
- 0 1 (font-lock-face erc-default-face)
- 1 4 (erc--speaker "bob" font-lock-face erc-my-nick-face)
- 4 6 (font-lock-face erc-default-face)
- 6 11 (font-lock-face erc-input-face))
- (buffer-substring (pos-bol) (pos-eol))))
-
- (insert "\nInput NOTICE\n"
- (erc-tests--format-privmessage "bob" "oh my" 'queryp nil 'inputp))
- (should (erc-tests-common-equal-with-props
- #("-bob- oh my"
- 0 1 (font-lock-face erc-default-face)
- 1 4 (erc--speaker "bob" font-lock-face erc-my-nick-face)
- 4 6 (font-lock-face erc-default-face)
- 6 11 (font-lock-face erc-input-face))
- (buffer-substring (pos-bol) (pos-eol))))
-
- (when noninteractive (kill-buffer))))
-
-(ert-deftest erc--determine-speaker-message-format-args/queries ()
- (should erc-format-query-as-channel-p)
-
- (with-current-buffer (get-buffer-create "bob")
- (erc-mode)
- (setq-local erc-format-query-as-channel-p nil)
- (setq erc--target (erc--target-from-string "alice"))
-
- (insert "PRIVMSG\n"
- (erc-tests--format-privmessage "bob" "oh my" 'queryp 'msgp))
- (should (erc-tests-common-equal-with-props
- #("*bob* oh my"
- 0 1 (font-lock-face erc-direct-msg-face)
- 1 4 (erc--speaker "bob" font-lock-face erc-nick-msg-face)
- 4 11 (font-lock-face erc-direct-msg-face))
- (buffer-substring (pos-bol) (pos-eol))))
-
- (insert "\nNOTICE\n"
- (erc-tests--format-privmessage "bob" "oh my" 'queryp nil))
- (should (erc-tests-common-equal-with-props
- #("-bob- oh my"
- 0 1 (font-lock-face erc-direct-msg-face)
- 1 4 (erc--speaker "bob" font-lock-face erc-nick-msg-face)
- 4 11 (font-lock-face erc-direct-msg-face))
- (buffer-substring (pos-bol) (pos-eol))))
-
- (insert "\nInput PRIVMSG\n"
- (erc-tests--format-privmessage "bob" "oh my"
- 'queryp 'privmsgp 'inputp))
- (should (erc-tests-common-equal-with-props
- #("*bob* oh my"
- 0 1 (font-lock-face erc-direct-msg-face)
- 1 4 (erc--speaker "bob" font-lock-face erc-my-nick-face)
- 4 6 (font-lock-face erc-direct-msg-face)
- 6 11 (font-lock-face erc-input-face))
- (buffer-substring (pos-bol) (pos-eol))))
-
- (insert "\nInput NOTICE\n"
- (erc-tests--format-privmessage "bob" "oh my" 'queryp nil 'inputp))
- (should (erc-tests-common-equal-with-props
- #("-bob- oh my"
- 0 1 (font-lock-face erc-direct-msg-face)
- 1 4 (erc--speaker "bob" font-lock-face erc-my-nick-face)
- 4 6 (font-lock-face erc-direct-msg-face)
- 6 11 (font-lock-face erc-input-face))
- (buffer-substring (pos-bol) (pos-eol))))
-
- (when noninteractive (kill-buffer))))
-
-(defun erc-tests--format-my-nick (message)
- (concat (erc-format-my-nick)
- (propertize message 'font-lock-face 'erc-input-face)))
-
-;; This tests that the default behavior of the replacement formatting
-;; function for prompt input, `erc--format-speaker-input-message'
-;; matches that of the original being replaced, `erc-format-my-nick',
-;; though it only handled the speaker portion.
-(ert-deftest erc--format-speaker-input-message ()
- ;; No status prefix.
- (let ((erc-server-current-nick "tester")
- (expect #("<tester> oh my"
- 0 1 (font-lock-face erc-default-face)
- 1 7 (font-lock-face erc-my-nick-face erc--speaker "tester")
- 7 9 (font-lock-face erc-default-face)
- 9 14 (font-lock-face erc-input-face))))
- (should (equal (erc-tests--format-my-nick "oh my") expect))
- (should (equal (erc--format-speaker-input-message "oh my") expect)))
-
- ;; With channel-operator status prefix.
- (let* ((erc-server-current-nick "tester")
- (cmem (cons (make-erc-server-user :nickname "tester")
- (make-erc-channel-user :op t)))
- (erc-channel-users (map-into (list "tester" cmem)
- '(hash-table :test equal)))
- (expect #("<@tester> oh my"
- 0 1 (font-lock-face erc-default-face)
- 1 2 (font-lock-face erc-my-nick-prefix-face)
- 2 5 (font-lock-face erc-my-nick-face erc--speaker "bob")
- 5 7 (font-lock-face erc-default-face)
- 7 12 (font-lock-face erc-input-face))))
- (should (equal (erc-tests--format-my-nick "oh my") expect))
- (should (equal (erc--format-speaker-input-message "oh my") expect))))
-
-(ert-deftest erc-update-undo-list ()
- ;; Remove `stamp' so this can run in any locale. Alternatively, we
- ;; could explicitly enable it and bind its format options to strings
- ;; that lack specifiers (perhaps in a separate test).
- (let ((erc-modules (remq 'stamp erc-modules))
- (erc-mode-hook erc-mode-hook)
- (erc-insert-modify-hook erc-insert-modify-hook)
- (erc-send-modify-hook erc-send-modify-hook)
- (inhibit-message noninteractive)
- marker)
-
- (erc-stamp-mode -1)
- (erc-tests-common-make-server-buf)
- (setq erc-server-current-nick "tester")
-
- (with-current-buffer (erc--open-target "#chan")
- ;; Add some filler to simulate more realistic values.
- (erc-tests-common-simulate-line
- ":irc.foonet.org 353 tester = #chan :bob tester alice")
- (erc-tests-common-simulate-line
- ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (should (erc-get-server-user "bob"))
-
- (goto-char (point-max))
- (should (= (point) 45))
-
- ;; Populate undo list with contrived values.
- (let ((kill-ring (list "abc"))
- interprogram-paste-function)
- (yank))
- (push nil buffer-undo-list)
- (push (point-max) buffer-undo-list)
- (setq marker (point-marker))
- (put-text-property 46 47 'face 'warning)
- (call-interactively #'delete-backward-char 1)
- (push nil buffer-undo-list)
- (should (= (point) 47))
- (should (equal buffer-undo-list `(nil
- ("c" . -47)
- (,marker . -1)
- (nil face nil 46 . 47)
- 48
- nil
- (45 . 48))))
-
- ;; The first char after the prompt is at buffer pos 45.
- (should (= 40 (- 45 (length (erc-prompt))) erc-insert-marker))
-
- ;; A new message arrives, growing the buffer by 11 chars.
- (erc-tests-common-simulate-privmsg "bob" "test")
- (should (equal (buffer-substring 40 erc-insert-marker) "<bob> test\n"))
- (should (= (point-max) 58))
- (should (= 11 (length "<bob> test\n") (- (point) 47)))
-
- ;; The list remains unchanged relative to the end of the buffer.
- (should (equal buffer-undo-list `(nil
- ("c" . -58)
- (,marker . -1)
- (nil face nil 57 . 58)
- 59
- nil
- (56 . 59))))
-
- ;; Undo behavior works as expected.
- (undo nil)
- (should (erc-tests-common-equal-with-props
- (buffer-substring erc-input-marker (point-max))
- #("abc" 1 2 (face nil))))
- (should (equal (take 4 buffer-undo-list)
- `((nil face warning 57 . 58)
- (58 . 59)
- nil
- ("c" . -58))))
- (undo 2)
- (should (string-empty-p (erc-user-input)))))
-
- (when noninteractive
- (erc-tests-common-kill-buffers)))
-
-(ert-deftest erc--route-insertion ()
- (erc-tests-common-prep-for-insertion)
- (erc-tests-common-init-server-proc "sleep" "1")
- (setq erc-networks--id (erc-networks--id-create 'foonet))
-
- (let* ((erc-modules) ; for `erc--open-target'
- (server-buffer (current-buffer))
- (spam-buffer (save-excursion (erc--open-target "#spam")))
- (chan-buffer (save-excursion (erc--open-target "#chan")))
- calls)
- (cl-letf (((symbol-function 'erc-insert-line)
- (lambda (&rest r) (push (cons 'line-1 r) calls))))
-
- (with-current-buffer chan-buffer
-
- (ert-info ("Null `buffer' routes to live server-buffer")
- (erc--route-insertion "null" nil)
- (should (equal (pop calls) `(line-1 "null" ,server-buffer)))
- (should-not calls))
-
- (ert-info ("Cons `buffer' routes to live members")
- ;; Copies a let-bound `erc--msg-props' before mutating.
- (let* ((table (map-into '(erc--msg msg) 'hash-table))
- (erc--msg-props table))
- (erc--route-insertion "cons" (list server-buffer spam-buffer))
- (should-not (eq table erc--msg-props)))
- (should (equal (pop calls) `(line-1 "cons" ,spam-buffer)))
- (should (equal (pop calls) `(line-1 "cons" ,server-buffer)))
- (should-not calls))
-
- (ert-info ("Variant `all' inserts in all session buffers")
- (erc--route-insertion "all" 'all)
- (should (equal (pop calls) `(line-1 "all" ,chan-buffer)))
- (should (equal (pop calls) `(line-1 "all" ,spam-buffer)))
- (should (equal (pop calls) `(line-1 "all" ,server-buffer)))
- (should-not calls))
-
- (ert-info ("Variant `active' routes to active buffer if alive")
- (should (eq chan-buffer (erc-with-server-buffer erc-active-buffer)))
- (erc-set-active-buffer spam-buffer)
- (erc--route-insertion "act" 'active)
- (should (equal (pop calls) `(line-1 "act" ,spam-buffer)))
- (should (eq (erc-active-buffer) spam-buffer))
- (should-not calls))
-
- (ert-info ("Variant `active' falls back to current buffer")
- (should (eq spam-buffer (erc-active-buffer)))
- (kill-buffer "#spam")
- (erc--route-insertion "nact" 'active)
- (should (equal (pop calls) `(line-1 "nact" ,server-buffer)))
- (should (eq (erc-with-server-buffer erc-active-buffer)
- server-buffer))
- (should-not calls))
-
- (ert-info ("Dead single buffer defaults to live server-buffer")
- (should-not (get-buffer "#spam"))
- (erc--route-insertion "dead" 'spam-buffer)
- (should (equal (pop calls) `(line-1 "dead" ,server-buffer)))
- (should-not calls))))
-
- (should-not (buffer-live-p spam-buffer))
- (kill-buffer chan-buffer)))
-
-(ert-deftest erc-normalize-port ()
- ;; The empty string, nil, and unsupported types become nil.
- (should-not (erc-normalize-port ""))
- (should-not (erc-normalize-port nil))
- (should-not (erc-normalize-port (current-buffer)))
-
- ;; Unrecognized names are coerced to 0.
- (should (equal 0 (erc-normalize-port "fake")))
-
- ;; Numbers pass through, but numeric strings are coerced.
- (should (equal 6667 (erc-normalize-port 6667)))
- (should (equal 6697 (erc-normalize-port "6697")))
-
- ;; Strange IANA mappings recognized.
- (should (equal 6665 (erc-normalize-port "ircu"))))
-
-(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"
- "1:2:3:4:5:6:77:88" "::ffff:255.255.255.255"
- "fe08::7:8" "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff"
- "1:2:3:4:5:6:7:8" "1::" "1:2:3:4:5:6:7::" "1::8"
- "1:2:3:4:5:6::8" "1:2:3:4:5:6::8" "1::7:8" "1:2:3:4:5::7:8"
- "1:2:3:4:5::8" "1::6:7:8" "1:2:3:4::6:7:8" "1:2:3:4::8"
- "1::5:6:7:8" "1:2:3::5:6:7:8" "1:2:3::8" "1::4:5:6:7:8"
- "1:2::4:5:6:7:8" "1:2::8" "1::3:4:5:6:7:8" "1::3:4:5:6:7:8"
- "1::8" "::2:3:4:5:6:7:8" "::2:3:4:5:6:7:8" "::8"
- "::" "fe08::7:8%eth0" "fe08::7:8%1" "::255.255.255.255"
- "::ffff:255.255.255.255" "::ffff:0:255.255.255.255"
- "2001:db8:3:4::192.0.2.33" "64:ff9b::192.0.2.33"))
-
-(ert-deftest erc--server-connect-dumb-ipv6-regexp ()
- (dolist (a erc-tests--ipv6-examples)
- (should-not (string-match erc--server-connect-dumb-ipv6-regexp a))
- (should (string-match erc--server-connect-dumb-ipv6-regexp
- (concat "[" a "]")))))
-
-(ert-deftest erc--with-entrypoint-environment ()
- (let ((env '((erc-join-buffer . foo)
- (erc-server-connect-function . bar))))
- (erc--with-entrypoint-environment env
- (should (eq erc-join-buffer 'foo))
- (should (eq erc-server-connect-function 'bar)))))
-
-(ert-deftest erc-select-read-args ()
-
- (ert-info ("Prompts for switch to TLS by default")
- (should (equal (ert-simulate-keys "\r\r\r\ry\r"
- (erc-select-read-args))
- (list :server "irc.libera.chat"
- :port 6697
- :nick (user-login-name)
- '--interactive-env--
- '((erc-server-connect-function . erc-open-tls-stream)
- (erc-join-buffer . window))))))
-
- (ert-info ("Switches to TLS when port matches default TLS port")
- (should (equal (ert-simulate-keys "irc.gnu.org\r6697\r\r\r"
- (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))))))
-
- (ert-info ("Switches to TLS when URL is ircs://")
- (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
-
- (ert-info ("Opt out of non-TLS warning manually")
- (should (equal (ert-simulate-keys "\r\r\r\rn\r"
- (erc-select-read-args))
- (list :server "irc.libera.chat"
- :port 6667
- :nick (user-login-name)))))
-
- (ert-info ("Override default TLS")
- (should (equal (ert-simulate-keys "irc://irc.libera.chat\r\r\r\r"
- (erc-select-read-args))
- (list :server "irc.libera.chat"
- :port 6667
- :nick (user-login-name)))))
-
- (ert-info ("Address includes port")
- (should (equal (ert-simulate-keys "localhost:6667\rnick\r\r"
- (erc-select-read-args))
- (list :server "localhost"
- :port 6667
- :nick "nick"))))
-
- (ert-info ("Address includes nick, password skipped via option")
- (should (equal (ert-simulate-keys "nick@localhost:6667\r"
- (let (erc-prompt-for-password)
- (erc-select-read-args)))
- (list :server "localhost"
- :port 6667
- :nick "nick"))))
-
- (ert-info ("Address includes nick and password")
- (should (equal (ert-simulate-keys "nick:sesame@localhost:6667\r\r"
- (erc-select-read-args))
- (list :server "localhost"
- :port 6667
- :nick "nick"
- :password "sesame"))))
-
- (ert-info ("IPv6 address plain")
- (should (equal (ert-simulate-keys "::1\r\r\r\r"
- (erc-select-read-args))
- (list :server "[::1]"
- :port 6667
- :nick (user-login-name)))))
-
- (ert-info ("IPv6 address with port")
- (should (equal (ert-simulate-keys "[::1]:6667\r\r\r"
- (erc-select-read-args))
- (list :server "[::1]"
- :port 6667
- :nick (user-login-name)))))
-
- (ert-info ("IPv6 address includes nick")
- (should (equal (ert-simulate-keys "nick@[::1]:6667\r\r"
- (erc-select-read-args))
- (list :server "[::1]"
- :port 6667
- :nick "nick"))))
-
- (ert-info ("Extra args use URL nick by default")
- (should (equal (ert-simulate-keys "nick:sesame@localhost:6667\r\r\r\r"
- (let ((current-prefix-arg '(4)))
- (erc-select-read-args)))
- (list :server "localhost"
- :port 6667
- :nick "nick"
- :user "nick"
- :password "sesame"
- :full-name "nick")))))
-
-(ert-deftest erc-tls ()
- (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 ("Defaults")
- (erc-tls)
- (should (equal (pop calls)
- '("irc.libera.chat" 6697 "tester" "unknown" t
- nil nil nil nil nil "user" nil)))
- (should (equal (pop env)
- '((erc-join-buffer bury)
- (erc--display-context (erc-buffer-display . erc-tls))
- (erc-server-connect-function erc-open-tls-stream)))))
-
- (ert-info ("Full")
- (erc-tls :server "irc.gnu.org"
- :port 7000
- :user "bobo"
- :nick "bob"
- :full-name "Bob's Name"
- :password "bob:changeme"
- :client-certificate t
- :id 'GNU.org)
- (should (equal (pop calls)
- '("irc.gnu.org" 7000 "bob" "Bob's Name" t
- "bob:changeme" nil nil nil t "bobo" GNU.org)))
- (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
- ;; null params. This is why `erc-open' recomputes almost
- ;; everything.
- (ert-info ("Fallback")
- (let ((erc-nick "bob")
- (erc-server "irc.gnu.org")
- (erc-email-userid "bobo")
- (erc-user-full-name "Bob's Name"))
- (erc-tls :server nil
- :port 7000
- :nick nil
- :password "bob:changeme"))
- (should (equal (pop calls)
- '(nil 7000 nil "Bob's Name" t
- "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")
- (ert-simulate-keys "nick:sesame@localhost:6667\r\r"
- (call-interactively #'erc-tls))
- (should (equal (pop calls)
- '("localhost" 6667 "nick" "unknown" t "sesame"
- nil nil nil nil "user" nil)))
- (should (equal (pop env)
- '((erc-join-buffer window)
- (erc--display-context
- (erc-interactive-display . erc-tls))
- (erc-server-connect-function erc-open-tls-stream)))))
-
- (ert-info ("Custom connect function")
- (let ((erc-server-connect-function 'my-connect-func))
- (erc-tls)
- (should (equal (pop calls)
- '("irc.libera.chat" 6697 "tester" "unknown" t
- nil nil nil nil nil "user" nil)))
- (should (equal (pop env)
- '((erc-join-buffer bury)
- (erc--display-context
- (erc-buffer-display . erc-tls))
- (erc-server-connect-function my-connect-func))))))
-
- (ert-info ("Advised default function overlooked") ; intentional
- (advice-add 'erc-server-connect-function :around #'ignore
- '((name . erc-tests--erc-tls)))
- (erc-tls)
- (should (equal (pop calls)
- '("irc.libera.chat" 6697 "tester" "unknown" t
- nil nil nil nil nil "user" nil)))
- (should (equal (pop env)
- '((erc-join-buffer bury)
- (erc--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))
-
- (ert-info ("Advised non-default function honored")
- (let ((f (lambda (&rest r) (ignore r))))
- (cl-letf (((symbol-value 'erc-server-connect-function) f))
- (advice-add 'erc-server-connect-function :around #'ignore
- '((name . erc-tests--erc-tls)))
- (erc-tls)
- (should (equal (pop calls)
- '("irc.libera.chat" 6697 "tester" "unknown" t
- nil nil nil nil nil "user" nil)))
- (should (equal (pop env) `((erc-join-buffer bury)
- (erc--display-context
- (erc-buffer-display . erc-tls))
- (erc-server-connect-function ,f))))
- (advice-remove 'erc-server-connect-function
- 'erc-tests--erc-tls)))))))
-
-;; See `erc-select-read-args' above for argument parsing.
-;; This only tests the "hidden" arguments.
-
-(ert-deftest erc--interactive ()
- (let (calls env)
- (cl-letf (((symbol-function 'user-login-name)
- (lambda (&optional _) "tester"))
- ((symbol-function 'erc-open)
- (lambda (&rest r)
- (push `((erc-join-buffer ,erc-join-buffer)
- (erc--display-context ,@erc--display-context)
- (erc-server-connect-function
- ,erc-server-connect-function))
- env)
- (push r calls))))
-
- (ert-info ("Default click-through accept TLS upgrade")
- (ert-simulate-keys "\r\r\r\ry\r"
- (call-interactively #'erc))
- (should (equal (pop calls)
- '("irc.libera.chat" 6697 "tester" "unknown" t nil
- nil nil nil nil "user" nil)))
- (should (equal (pop env)
- '((erc-join-buffer 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"
- (call-interactively #'erc))
- (should (equal (pop calls)
- '("irc.libera.chat" 6667 "dummy" "unknown" t nil
- nil nil nil nil "user" nil)))
- (should (equal (pop env)
- '((erc-join-buffer 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))))))))
-
-(ert-deftest erc-handle-irc-url ()
- (let* (calls
- rvbuf
- erc-networks-alist
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook
- (erc-url-connect-function
- (lambda (&rest r)
- (push r calls)
- (if (functionp rvbuf) (funcall rvbuf) rvbuf))))
-
- (cl-letf (((symbol-function 'erc-cmd-JOIN)
- (lambda (&rest r) (push r calls))))
-
- (with-current-buffer (erc-tests-common-make-server-buf "foonet")
- (setq rvbuf (current-buffer)))
- (erc-tests-common-make-server-buf "barnet")
- (erc-tests-common-make-server-buf "baznet")
-
- (ert-info ("Unknown network")
- (erc-handle-irc-url "irc.foonet.org" 6667 "#chan" nil nil "irc")
- (should (equal '("#chan" nil) (pop calls)))
- (should-not calls))
-
- (ert-info ("Unknown network, no port")
- (erc-handle-irc-url "irc.foonet.org" nil "#chan" nil nil "irc")
- (should (equal '("#chan" nil) (pop calls)))
- (should-not calls))
-
- (ert-info ("Known network, no port")
- (setq erc-networks-alist '((foonet "irc.foonet.org")))
- (erc-handle-irc-url "irc.foonet.org" nil "#chan" nil nil "irc")
- (should (equal '("#chan" nil) (pop calls)))
- (should-not calls))
-
- (ert-info ("Known network, different port")
- (erc-handle-irc-url "irc.foonet.org" 6697 "#chan" nil nil "irc")
- (should (equal '("#chan" nil) (pop calls)))
- (should-not calls))
-
- (ert-info ("Known network, existing chan with key")
- (save-excursion
- (with-current-buffer "foonet" (erc--open-target "#chan")))
- (erc-handle-irc-url "irc.foonet.org" nil "#chan?sec" nil nil "irc")
- (should (equal '("#chan" "sec") (pop calls)))
- (should-not calls))
-
- (ert-info ("Unknown network, connect, no chan")
- (erc-handle-irc-url "irc.gnu.org" nil nil nil nil "irc")
- (should (equal '("irc" :server "irc.gnu.org") (pop calls)))
- (should-not calls))
-
- (ert-info ("Unknown network, connect, chan")
- (with-current-buffer "foonet"
- (should-not (local-variable-p 'erc-after-connect)))
- (setq rvbuf (lambda () (erc-tests-common-make-server-buf "gnu")))
- (erc-handle-irc-url "irc.gnu.org" nil "#spam" nil nil "irc")
- (should (equal '("irc" :server "irc.gnu.org") (pop calls)))
- (should-not calls)
- (with-current-buffer "gnu"
- (should (local-variable-p 'erc-after-connect))
- (funcall (car erc-after-connect))
- (should (equal '("#spam" nil) (pop calls)))
- (should-not (local-variable-p 'erc-after-connect)))
- (should-not calls))))
-
- (when noninteractive
- (erc-tests-common-kill-buffers)))
-
-(ert-deftest erc-channel-user ()
- ;; Traditional and alternate constructor swapped for compatibility.
- (should (= 0 (erc-channel-user-status (erc-channel-user--make))))
- (should-not (erc-channel-user-last-message-time (erc-channel-user--make)))
-
- (should (= 42 (erc-channel-user-last-message-time
- (make-erc-channel-user :last-message-time 42))))
-
- (should (zerop (erc-channel-user-status (make-erc-channel-user))))
-
- (let ((u (make-erc-channel-user)))
-
- (ert-info ("Add voice status to user")
- (should (= 0 (erc-channel-user-status u)))
- (should-not (erc-channel-user-voice u))
- (should (eq t (setf (erc-channel-user-voice u) t)))
- (should (eq t (erc-channel-user-voice u))))
-
- (ert-info ("Add op status to user")
- (should (= 1 (erc-channel-user-status u)))
- (should-not (erc-channel-user-op u))
- (should (eq t (setf (erc-channel-user-op u) t)))
- (should (eq t (erc-channel-user-op u))))
-
- (ert-info ("Add owner status to user")
- (should (= 5 (erc-channel-user-status u)))
- (should-not (erc-channel-user-owner u))
- (should (eq t (setf (erc-channel-user-owner u) t)))
- (should (eq t (erc-channel-user-owner u))))
-
- (ert-info ("Remove owner status from user")
- (should (= 21 (erc-channel-user-status u)))
- (should-not (setf (erc-channel-user-owner u) nil))
- (should-not (erc-channel-user-owner u)))
-
- (ert-info ("Remove op status from user")
- (should (= 5 (erc-channel-user-status u)))
- (should-not (setf (erc-channel-user-op u) nil))
- (should-not (erc-channel-user-op u)))
-
- (ert-info ("Remove voice status from user")
- (should (= 1 (erc-channel-user-status u)))
- (should-not (setf (erc-channel-user-voice u) nil))
- (should-not (erc-channel-user-voice u)))
-
- (ert-info ("Remove voice status from zeroed user")
- (should (= 0 (erc-channel-user-status u)))
- (should-not (setf (erc-channel-user-voice u) nil))
- (should-not (erc-channel-user-voice u))
- (should (= 0 (erc-channel-user-status u))))))
-
-(defconst erc-tests--modules
- '( autoaway autojoin bufbar button capab-identify
- command-indicator completion dcc fill identd
- imenu irccontrols keep-place list log match menu move-to-prompt netsplit
- networks nickbar nicks noncommands notifications notify page readonly
- replace ring sasl scrolltobottom services smiley sound
- spelling stamp track truncate unmorse xdcc))
-
-;; Ensure that `:initialize' doesn't change the ordering of the
-;; members because otherwise the widget's state is "edited".
-
-(ert-deftest erc-modules--initialize ()
- ;; This is `custom--standard-value' from Emacs 28.
- (should (equal (eval (car (get 'erc-modules 'standard-value)) t)
- erc-modules)))
-
-;; Ensure the `:initialize' function for `erc-modules' successfully
-;; tags all built-in modules with the internal property `erc--module'.
-
-(ert-deftest erc-modules--internal-property ()
- (let (ours)
- (mapatoms (lambda (s)
- (when-let ((v (get s 'erc--module))
- ((eq v s)))
- (push s ours))))
- (should (equal (sort ours #'string-lessp) erc-tests--modules))))
-
-(ert-deftest erc--normalize-module-symbol ()
- (dolist (mod erc-tests--modules)
- (should (eq (erc--normalize-module-symbol mod) mod)))
- (should (eq (erc--normalize-module-symbol 'pcomplete) 'completion))
- (should (eq (erc--normalize-module-symbol 'Completion) 'completion))
- (should (eq (erc--normalize-module-symbol 'ctcp-page) 'page))
- (should (eq (erc--normalize-module-symbol 'ctcp-sound) 'sound))
- (should (eq (erc--normalize-module-symbol 'timestamp) 'stamp))
- (should (eq (erc--normalize-module-symbol 'nickserv) 'services)))
-
-(defun erc-tests--assert-printed-in-subprocess (code expected)
- "Assert result emitted to standard output from CODE matches EXPECTED.
-Expect CODE to print result using `prin1' as a list beginning with the
-keyword :result."
- (with-current-buffer
- (get-buffer-create
- (concat "*" (symbol-name (ert-test-name (ert-running-test))) "*"))
- (unwind-protect
- (let ((proc (erc-tests-common-create-subprocess code '("-batch") nil)))
- (while (accept-process-output proc 10))
- (goto-char (point-min))
- (search-forward "(:result " nil t)
- (unless (equal (ignore-errors (read (current-buffer))) expected)
- (ert-fail (list "Mismatch"
- :expected expected
- :buffer-string (buffer-string)))))
- (when noninteractive
- (kill-buffer)))))
-
-;; Worrying about which library a module comes from is mostly not
-;; worth the hassle so long as ERC can find its minor mode. However,
-;; bugs involving multiple modules living in the same library may slip
-;; by because a module's loading problems may remain hidden on account
-;; of its place in the default ordering.
-
-(ert-deftest erc--find-mode ()
- (erc-tests--assert-printed-in-subprocess
- '(let ((mods (mapcar #'cadddr (cdddr (get 'erc-modules 'custom-type))))
- moded)
- (setq mods (sort mods (lambda (a b) (if (zerop (random 2)) a b))))
- (dolist (mod mods)
- (unless (keywordp mod)
- (push (if-let ((mode (erc--find-mode mod))) mod (list :missing mod))
- moded)))
- (prin1 (list :result
- (sort moded (lambda (a b)
- (string< (symbol-name a) (symbol-name b)))))))
- erc-tests--modules))
-
-(ert-deftest erc--essential-hook-ordering ()
- (erc-tests--assert-printed-in-subprocess
- '(progn
- (erc-update-modules)
- (prin1 (list :result
- (list :erc-insert-modify-hook erc-insert-modify-hook
- :erc-send-modify-hook erc-send-modify-hook))))
-
- '( :erc-insert-modify-hook (erc-controls-highlight ; 0
- erc-button-add-buttons ; 30
- erc-match-message ; 50
- erc-fill ; 60
- erc-add-timestamp) ; 70
-
- :erc-send-modify-hook ( erc-controls-highlight ; 0
- erc-button-add-buttons ; 30
- erc-fill ; 40
- erc-add-timestamp)))) ; 70
-
-(ert-deftest erc-migrate-modules ()
- (should (equal (erc-migrate-modules '(autojoin timestamp button))
- '(autojoin stamp button)))
- ;; Default unchanged
- (should (equal (erc-migrate-modules erc-modules) erc-modules)))
-
-(ert-deftest erc--find-group ()
- ;; These two are loaded by default
- (should (eq (erc--find-group 'keep-place nil) 'erc))
- (should (eq (erc--find-group 'networks nil) 'erc-networks))
- ;; These are fake
- (cl-letf (((get 'erc-bar 'group-documentation) "")
- ((get 'baz 'erc-group) 'erc-foo))
- (should (eq (erc--find-group 'foo 'bar) 'erc-bar))
- (should (eq (erc--find-group 'bar 'foo) 'erc-bar))
- (should (eq (erc--find-group 'bar nil) 'erc-bar))
- (should (eq (erc--find-group 'foo nil) 'erc))
- (should (eq (erc--find-group 'fake 'baz) 'erc-foo))))
-
-(ert-deftest erc--find-group--real ()
- :tags '(:unstable)
- (require 'erc-services)
- (require 'erc-stamp)
- (require 'erc-sound)
- (require 'erc-page)
- (require 'erc-join)
- (require 'erc-capab)
- (require 'erc-pcomplete)
- (should (eq (erc--find-group 'services 'nickserv) 'erc-services))
- (should (eq (erc--find-group 'stamp 'timestamp) 'erc-stamp))
- (should (eq (erc--find-group 'sound 'ctcp-sound) 'erc-sound))
- (should (eq (erc--find-group 'page 'ctcp-page) 'erc-page))
- (should (eq (erc--find-group 'autojoin) 'erc-autojoin))
- (should (eq (erc--find-group 'pcomplete 'Completion) 'erc-pcomplete))
- (should (eq (erc--find-group 'capab-identify) 'erc-capab))
- (should (eq (erc--find-group 'completion) 'erc-pcomplete))
- ;; No group specified.
- (should (eq (erc--find-group 'smiley nil) 'erc))
- (should (eq (erc--find-group 'unmorse nil) 'erc)))
-
-(ert-deftest erc--sort-modules ()
- (should (equal (erc--sort-modules '(networks foo fill bar fill stamp bar))
- ;; Third-party mods appear in original order.
- '(fill networks stamp foo bar))))
-
-(defun erc-tests--update-modules (fn)
- (let* ((calls nil)
- (custom-modes nil)
- (on-load nil)
- (text-quoting-style 'grave)
-
- (get-calls (lambda () (prog1 (nreverse calls) (setq calls nil))))
-
- (add-onload (lambda (m k v)
- (put (intern m) 'erc--feature k)
- (push (cons k (lambda () (funcall v m))) on-load)))
-
- (mk-cmd (lambda (module)
- (let ((mode (intern (format "erc-%s-mode" module))))
- (fset mode (lambda (n) (push (cons mode n) calls))))))
-
- (mk-builtin (lambda (module-string)
- (let ((s (intern module-string)))
- (put s 'erc--module s))))
-
- (mk-global (lambda (module)
- (push (intern (format "erc-%s-mode" module))
- custom-modes))))
-
- (cl-letf (((symbol-function 'require)
- (lambda (s &rest _)
- ;; Simulate library being loaded, things defined.
- (when-let ((h (alist-get s on-load))) (funcall h))
- (push (cons 'req s) calls)))
-
- ;; Spoof global module detection.
- ((symbol-function 'custom-variable-p)
- (lambda (v) (memq v custom-modes))))
-
- (funcall fn get-calls add-onload mk-cmd mk-builtin mk-global))
- (should-not erc--aberrant-modules)))
-
-(ert-deftest erc--update-modules/unknown ()
- (erc-tests--update-modules
-
- (lambda (get-calls _ mk-cmd _ mk-global)
-
- (ert-info ("Baseline")
- (let* ((erc-modules '(foo))
- (obarray (obarray-make))
- (err (should-error (erc--update-modules erc-modules))))
- (should (equal (cadr err) "`foo' is not a known ERC module"))
- (should (equal (mapcar #'prin1-to-string (funcall get-calls))
- '("(req . erc-foo)")))))
-
- ;; Module's mode command exists but lacks an associated file.
- (ert-info ("Bad autoload flagged as suspect")
- (should-not erc--aberrant-modules)
- (let* ((erc--aberrant-modules nil)
- (obarray (obarray-make))
- (erc-modules (list (intern "foo"))))
-
- ;; Create a mode-activation command and make mode-var global.
- (funcall mk-cmd "foo")
- (funcall mk-global "foo")
-
- ;; No local modules to return.
- (should-not (erc--update-modules erc-modules))
- (should (equal (mapcar #'prin1-to-string erc--aberrant-modules)
- '("foo")))
- ;; ERC requires the library via prefixed module name.
- (should (equal (mapcar #'prin1-to-string (funcall get-calls))
- '("(req . erc-foo)" "(erc-foo-mode . 1)"))))))))
-
-;; A local module (here, `lo2') lacks a mode toggle, so ERC tries to
-;; load its defining library, first via the symbol property
-;; `erc--feature', and then via an "erc-" prefixed symbol.
-(ert-deftest erc--update-modules/local ()
- (erc-tests--update-modules
-
- (lambda (get-calls add-onload mk-cmd mk-builtin mk-global)
-
- (let* ((obarray (obarray-make 20))
- (erc-modules (mapcar #'intern '("glo" "lo1" "lo2"))))
-
- ;; Create a global and a local module.
- (mapc mk-cmd '("glo" "lo1"))
- (mapc mk-builtin '("glo" "lo1"))
- (funcall mk-global "glo")
- (funcall add-onload "lo2" 'explicit-feature-lib mk-cmd)
-
- ;; Returns local modules.
- (should (equal (mapcar #'symbol-name (erc--update-modules erc-modules))
- '("erc-lo2-mode" "erc-lo1-mode")))
-
- ;; Requiring `erc-lo2' defines `erc-lo2-mode'.
- (should (equal (mapcar #'prin1-to-string (funcall get-calls))
- `("(erc-glo-mode . 1)"
- "(req . explicit-feature-lib)")))))))
-
-(ert-deftest erc--update-modules/realistic ()
- (let ((calls nil)
- ;; Module `pcomplete' "resolves" to `completion'.
- (erc-modules '(pcomplete autojoin networks)))
- (cl-letf (((symbol-function 'require)
- (lambda (s &rest _) (push (cons 'req s) calls)))
-
- ;; Spoof global module detection.
- ((symbol-function 'custom-variable-p)
- (lambda (v)
- (memq v '(erc-autojoin-mode erc-networks-mode
- erc-completion-mode))))
- ;; Mock and spy real builtins.
- ((symbol-function 'erc-autojoin-mode)
- (lambda (n) (push (cons 'autojoin n) calls)))
- ((symbol-function 'erc-networks-mode)
- (lambda (n) (push (cons 'networks n) calls)))
- ((symbol-function 'erc-completion-mode)
- (lambda (n) (push (cons 'completion n) calls))))
-
- (should-not (erc--update-modules erc-modules)) ; no locals
- (should (equal (nreverse calls)
- '((completion . 1) (autojoin . 1) (networks . 1)))))))
-
-(ert-deftest erc--merge-local-modes ()
- (cl-letf (((get 'erc-b-mode 'erc-module) 'b)
- ((get 'erc-c-mode 'erc-module) 'c)
- ((get 'erc-d-mode 'erc-module) 'd)
- ((get 'erc-e-mode 'erc-module) 'e))
-
- (ert-info ("No existing modes")
- (let ((old '((a) (b . t)))
- (new '(erc-c-mode erc-d-mode)))
- (should (equal (erc--merge-local-modes new old)
- '((erc-c-mode erc-d-mode))))))
-
- (ert-info ("Active existing added, inactive existing removed, deduped")
- (let ((old '((a) (erc-b-mode) (c . t) (erc-d-mode . t) (erc-e-mode . t)))
- (new '(erc-b-mode erc-d-mode)))
- (should (equal (erc--merge-local-modes new old)
- '((erc-d-mode erc-e-mode) . (erc-b-mode))))))
-
- (ert-info ("Non-module erc-prefixed mode ignored")
- (let ((old '((erc-b-mode) (erc-f-mode . t) (erc-d-mode . t)))
- (new '(erc-b-mode)))
- (should (equal (erc--merge-local-modes new old)
- '((erc-d-mode) . (erc-b-mode))))))))
-
-(ert-deftest define-erc-module--global ()
- (let ((global-module '(define-erc-module mname malias
- "Some docstring."
- ((ignore a) (ignore b))
- ((ignore c) (ignore d)))))
-
- (should (equal (cl-letf (((symbol-function
- 'erc--prepare-custom-module-type)
- #'symbol-name))
- (macroexpand global-module))
- `(progn
-
- (define-minor-mode erc-mname-mode
- "Toggle ERC mname mode.
-If called interactively, enable `erc-mname-mode' if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
-Some docstring."
- :global t
- :group (erc--find-group 'mname 'malias)
- :require 'nil
- :type "mname"
- (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."
- (interactive)
- (unless (or erc--inside-mode-toggle-p
- (memq 'mname erc-modules))
- (let ((erc--inside-mode-toggle-p t))
- (erc--favor-changed-reverted-modules-state
- 'mname #'cons)))
- (setq erc-mname-mode t)
- (ignore a) (ignore b))
-
- (defun erc-mname-disable ()
- "Disable ERC mname mode."
- (interactive)
- (unless (or erc--inside-mode-toggle-p
- (not (memq 'mname erc-modules)))
- (let ((erc--inside-mode-toggle-p t))
- (erc--favor-changed-reverted-modules-state
- 'mname #'delq)))
- (setq erc-mname-mode nil)
- (ignore c) (ignore d))
-
- (defalias 'erc-malias-mode #'erc-mname-mode)
- (put 'erc-malias-mode 'erc-module 'mname)
-
- (put 'erc-mname-mode 'erc-module 'mname)
- (put 'erc-mname-mode 'definition-name 'mname)
- (put 'erc-mname-enable 'definition-name 'mname)
- (put 'erc-mname-disable 'definition-name 'mname))))))
-
-(ert-deftest define-erc-module--local ()
- (let* ((global-module '(define-erc-module mname nil ; no alias
- "Some docstring."
- ((ignore a) (ignore b))
- ((ignore c) (ignore d))
- 'local))
- (got (macroexpand global-module))
- (arg-en (cadr (nth 2 (nth 2 got))))
- (arg-dis (cadr (nth 2 (nth 3 got)))))
-
- (should (equal got
- `(progn
- (define-minor-mode erc-mname-mode
- "Toggle ERC mname mode locally.
-If called interactively, enable `erc-mname-mode' if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
-Some docstring."
- :global nil
- :group (erc--find-group 'mname nil)
- (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 locally.
-When called interactively, do so in all buffers for the current
-connection."
- (interactive "p")
- (when (derived-mode-p 'erc-mode)
- (if ,arg-en
- (erc-with-all-buffers-of-server
- erc-server-process nil
- (erc-mname-enable))
- (setq erc-mname-mode t)
- (ignore a) (ignore b))))
-
- (defun erc-mname-disable (&optional ,arg-dis)
- "Disable ERC mname mode locally.
-When called interactively, do so in all buffers for the current
-connection."
- (interactive "p")
- (when (derived-mode-p 'erc-mode)
- (if ,arg-dis
- (erc-with-all-buffers-of-server
- erc-server-process nil
- (erc-mname-disable))
- (setq erc-mname-mode nil)
- (ignore c) (ignore d))))
-
- (put 'erc-mname-mode 'erc-module 'mname)
- (put 'erc-mname-mode 'definition-name 'mname)
- (put 'erc-mname-enable 'definition-name 'mname)
- (put 'erc-mname-disable 'definition-name 'mname))))))
-
-(ert-deftest erc-tests-common-string-to-propertized-parts ()
- :tags '(:unstable) ; only run this locally
- (unless (>= emacs-major-version 28) (ert-skip "Missing `object-intervals'"))
-
- (should (equal (erc-tests-common-string-to-propertized-parts
- #("abc"
- 0 1 (face default foo 1)
- 1 3 (face (default italic) bar "2")))
- '(concat (propertize "a" 'foo 1 'face 'default)
- (propertize "bc" 'bar "2" 'face '(default italic)))))
- (should (equal #("abc"
- 0 1 (face default foo 1)
- 1 3 (face (default italic) bar "2"))
- (concat (propertize "a" 'foo 1 'face 'default)
- (propertize "bc" 'bar "2" 'face '(default italic))))))
-
-(ert-deftest erc--make-message-variable-name ()
- (should (erc--make-message-variable-name 'english 'QUIT 'softp))
- (should (erc--make-message-variable-name 'english 'QUIT nil))
-
- (let ((obarray (obarray-make)))
- (should-not (erc--make-message-variable-name 'testcat 'testkey 'softp))
- (should (erc--make-message-variable-name 'testcat 'testkey nil))
- (should (intern-soft "erc-message-testcat-testkey" obarray))
- (should-not (erc--make-message-variable-name 'testcat 'testkey 'softp))
- (set (intern "erc-message-testcat-testkey" obarray) "hello world")
- (should (equal (symbol-value
- (erc--make-message-variable-name 'testcat 'testkey nil))
- "hello world")))
-
- ;; Hyphenated (internal catalog).
- (let ((obarray (obarray-make)))
- (should-not (erc--make-message-variable-name '-testcat 'testkey 'softp))
- (should (erc--make-message-variable-name '-testcat 'testkey nil))
- (should (intern-soft "erc--message-testcat-testkey" obarray))
- (should-not (erc--make-message-variable-name '-testcat 'testkey 'softp))
- (set (intern "erc--message-testcat-testkey" obarray) "hello world")
- (should (equal (symbol-value
- (erc--make-message-variable-name '-testcat 'testkey nil))
- "hello world"))))
-
-(ert-deftest erc-retrieve-catalog-entry ()
- (should (eq 'english erc-current-message-catalog))
- (should (equal (erc-retrieve-catalog-entry 's221) "User modes for %n: %m"))
-
- ;; Local binding.
- (with-temp-buffer
- (should (equal (erc-retrieve-catalog-entry 's221) "User modes for %n: %m"))
- (setq erc-current-message-catalog 'test)
- ;; No catalog named `test'.
- (should (equal (erc-retrieve-catalog-entry 's221) "User modes for %n: %m"))
-
- (let ((obarray (obarray-make)))
- (set (intern "erc-message-test-s221") "test 221 val")
- (should (equal (erc-retrieve-catalog-entry 's221) "test 221 val"))
- (set (intern "erc-message-english-s221") "eng 221 val")
-
- (let ((erc-current-message-catalog 'english))
- (should (equal (erc-retrieve-catalog-entry 's221) "eng 221 val")))
-
- (with-temp-buffer
- (should (equal (erc-retrieve-catalog-entry 's221) "eng 221 val"))
- (let ((erc-current-message-catalog 'test))
- (should (equal (erc-retrieve-catalog-entry 's221) "test 221 val"))))
-
- (should (equal (erc-retrieve-catalog-entry 's221) "test 221 val")))
-
- (should (equal (erc-retrieve-catalog-entry 's221) "User modes for %n: %m"))
- (should (equal erc-current-message-catalog 'test)))
-
- ;; Default top-level value.
- (set-default-toplevel-value 'erc-current-message-catalog 'test-top)
- (should (equal (erc-retrieve-catalog-entry 's221) "User modes for %n: %m"))
- (set (intern "erc-message-test-top-s221") "test-top 221 val")
- (should (equal (erc-retrieve-catalog-entry 's221) "test-top 221 val"))
-
- (setq erc-current-message-catalog 'test-local)
- (should (equal (erc-retrieve-catalog-entry 's221) "test-top 221 val"))
-
- (makunbound (intern "erc-message-test-top-s221"))
- (unintern "erc-message-test-top-s221" obarray)
-
- ;; Inheritance.
- (let ((obarray (obarray-make)))
- (set (intern "erc-message-test1-abc") "val test1 abc")
- (set (intern "erc-message-test2-abc") "val test2 abc")
- (set (intern "erc-message-test2-def") "val test2 def")
- (put (intern "test0") 'erc--base-format-catalog (intern "test1"))
- (put (intern "test1") 'erc--base-format-catalog (intern "test2"))
- (should (equal (erc-retrieve-catalog-entry 'abc (intern "test0"))
- "val test1 abc"))
- (should (equal (erc-retrieve-catalog-entry 'def (intern "test0"))
- "val test2 def"))
- ;; Terminates.
- (should-not (erc-retrieve-catalog-entry 'ghi (intern "test0")))))
-
-;;; erc-tests.el ends here
+++ /dev/null
-;;; erc-track-tests.el --- Tests for erc-track. -*- lexical-binding:t -*-
-
-;; Copyright (C) 2016-2025 Free Software Foundation, Inc.
-
-;; Author: Mario Lang <mlang@delysid.org>
-;; Author: Vivek Dasmohapatra <vivek@etla.org>
-
-;; 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 'erc-track)
-(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (ert-resource-directory) load-path)))
- (require 'erc-tests-common)))
-
-
-(ert-deftest erc-track--shorten-aggressive-nil ()
- "Test non-aggressive erc track buffer name shortening."
- (let (erc-track-shorten-aggressively)
- (should
- (equal (erc-unique-channel-names '("#emacs" "#vi" "#electronica" "#folk")
- '("#emacs" "#vi"))
- '("#em" "#vi")))
- (should
- (equal (erc-unique-channel-names '("#linux-de" "#linux-fr")
- '("#linux-de" "#linux-fr"))
- '("#linux-de" "#linux-fr")))
- (should
- (equal (erc-unique-channel-names
- '("#dunnet" "#lisp" "#sawfish" "#fsf" "#guile" "#testgnome"
- "#gnu" "#fsbot" "#hurd" "#hurd-bunny" "#emacs")
- '("#hurd-bunny" "#hurd" "#sawfish" "#lisp"))
- '("#hurd-" "#hurd" "#s" "#l")))
- (should
- (equal (erc-unique-substrings '("#emacs" "#vi" "#electronica" "#folk"))
- '("#em" "#vi" "#el" "#f")))
- (should
- (equal (erc-unique-channel-names
- '("#emacs" "#burse" "+linux.de" "#starwars"
- "#bitlbee" "+burse" "#ratpoison")
- '("+linux.de" "#starwars" "#burse"))
- '("+l" "#s" "#bu")))
- (should
- (equal (erc-unique-channel-names '("fsbot" "#emacs" "deego") '("fsbot"))
- '("fs")))
- (should
- (equal (erc-unique-channel-names '("fsbot" "#emacs" "deego")
- '("fsbot")
- (lambda (s) (> (length s) 4)) 1)
- '("f")))
- (should
- (equal (erc-unique-channel-names '("fsbot" "#emacs" "deego")
- '("fsbot")
- (lambda (s) (> (length s) 4)) 2)
- '("fs")))
- (should
- (equal (erc-unique-channel-names '("deego" "#hurd" "#hurd-bunny" "#emacs")
- '("#hurd" "#hurd-bunny"))
- '("#hurd" "#hurd-")))
- (should
- (and
- (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd")
- (not (erc-unique-substring-1 "a" '("xyz" "xab")))
- (equal (erc-unique-substrings '("abc" "xyz" "xab")) '("abc" "xyz" "xab"))
- (equal (erc-unique-substrings '("abc" "abcdefg")) '("abc" "abcd")))) ))
-
-(ert-deftest erc-track--shorten-aggressive-t ()
- "Test aggressive erc track buffer name shortening."
- (let ((erc-track-shorten-aggressively t))
- (should
- (equal (erc-unique-channel-names '("#emacs" "#vi" "#electronica" "#folk")
- '("#emacs" "#vi"))
- '("#em" "#v")))
- (should
- (equal (erc-unique-channel-names '("#linux-de" "#linux-fr")
- '("#linux-de" "#linux-fr"))
- '("#linux-d" "#linux-f")))
- (should
- (equal (erc-unique-substrings '("#emacs" "#vi" "#electronica" "#folk"))
- '("#em" "#v" "#el" "#f")))
- (should
- (and
- (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd")
- (not (erc-unique-substring-1 "a" '("xyz" "xab")))
- (equal (erc-unique-substrings '("abc" "xyz" "xab")) '("ab" "xy" "xa"))
- (equal (erc-unique-substrings '("abc" "abcdefg")) '("abc" "abcd")))) ))
-
-(ert-deftest erc-track--shorten-aggressive-max ()
- "Test maximally aggressive erc track buffer name shortening."
- (let ((erc-track-shorten-aggressively 'max))
- (should
- (equal (erc-unique-channel-names '("#emacs" "#vi" "#electronica" "#folk")
- '("#emacs" "#vi"))
- '("#e" "#v"))) ))
-
-(ert-deftest erc-track--shortened-names ()
- (let (erc-track--shortened-names
- erc-track--shortened-names-current-hash
- results)
-
- (with-memoization (erc-track--shortened-names-get
- '("apple" "banana" "cherries"))
- '("a" "b" "c"))
- (should (integerp (car erc-track--shortened-names)))
- (should (equal (cdr erc-track--shortened-names) '("a" "b" "c")))
- (push erc-track--shortened-names results)
-
- ;; Redundant call doesn't run.
- (with-memoization (erc-track--shortened-names-get
- '("apple" "banana" "cherries"))
- (should-not 'run)
- '("a" "b" "c"))
- (should (equal erc-track--shortened-names (car results)))
-
- ;; Change in environment or context forces run.
- (with-temp-buffer
- (with-memoization (erc-track--shortened-names-get
- '("apple" "banana" "cherries"))
- '("x" "y" "z")))
- (should (and (integerp (car erc-track--shortened-names))
- (/= (car erc-track--shortened-names) (caar results))))
- (should (equal (cdr erc-track--shortened-names) '("x" "y" "z")))
- (push erc-track--shortened-names results)
-
- (with-memoization (erc-track--shortened-names-get
- '("apple" "banana" "cherries"))
- '("1" "2" "3"))
- (should (and (integerp (car erc-track--shortened-names))
- (/= (car erc-track--shortened-names) (caar results))))
- (should (equal (cdr erc-track--shortened-names) '("1" "2" "3")))))
-
-(ert-deftest erc-track--erc-faces-in ()
- "`erc-faces-in' should pick up both 'face and 'font-lock-face properties."
- (let ((str0 (copy-sequence "is bold"))
- (str1 (copy-sequence "is bold")))
- ;; Turn on Font Lock mode: this initialize `char-property-alias-alist'
- ;; to '((face font-lock-face)). Note that `font-lock-mode' don't
- ;; turn on the mode if the test is run on batch mode or if the
- ;; buffer name starts with ?\s (Bug#23954).
- (unless font-lock-mode (font-lock-default-function 1))
- (put-text-property 3 (length str0) 'font-lock-face
- '(bold erc-current-nick-face) str0)
- (put-text-property 3 (length str1) 'face
- '(bold erc-current-nick-face) str1)
- (should (erc-faces-in str0))
- (should (erc-faces-in str1)) ))
-
-;; This simulates an alternating bold/non-bold [#c] in the mode-line,
-;; i.e., an `erc-modified-channels-alist' that vacillates between
-;;
-;; ((#<buffer #chan> 42 . erc-default-face))
-;;
-;; and
-;;
-;; ((#<buffer #chan> 42 erc-nick-default-face erc-default-face))
-;;
-;; This is a fairly typical scenario where consecutive messages
-;; feature speaker and addressee button highlighting and otherwise
-;; plain message bodies. This mapping of phony to real faces
-;; describes the picture in 5.6:
-;;
-;; `1': (erc-button erc-default-face) ; URL
-;; `2': (erc-nick-default-face erc-default-face) ; mention
-;; `3': erc-default-face ; body
-;; `_': (erc-nick-default-face erc-nick-default-face) ; speaker
-;;
-;; The `_' represents a commonly occurring face (a <speaker>) that's
-;; not present in either option's default (standard) value. It's a
-;; no-op from the POV of `erc-track-select-mode-line-face'.
-
-(ert-deftest erc-track-select-mode-line-face ()
-
- ;; Observed (see key above).
- (let ((erc-track-faces-priority-list '(1 2 3))
- (erc-track-faces-normal-list '(1 2 3)))
-
- (should (equal 2 (erc-track-select-mode-line-face 3 '(2 _ 3))))
- (should (equal 2 (erc-track-select-mode-line-face 2 '(2 _ 3))))
- (should (equal 3 (erc-track-select-mode-line-face 2 '(_ 3))))
- (should (equal 2 (erc-track-select-mode-line-face 3 '(2 3))))
- (should (equal 3 (erc-track-select-mode-line-face 2 '(3))))
-
- (should (equal 1 (erc-track-select-mode-line-face 1 '(2 1 3))))
- (should (equal 1 (erc-track-select-mode-line-face 1 '(1 3))))
- (should (equal 1 (erc-track-select-mode-line-face 1 '(1 3 2))))
- (should (equal 1 (erc-track-select-mode-line-face 1 '(3 1)))))
-
- ;; When the current face outranks all new faces and doesn't appear
- ;; among them, it's eligible to be replaced with a fellow "normal"
- ;; from those new faces. But if it does appear among them, it's
- ;; never replaced.
- (let ((erc-track-faces-priority-list '(a b))
- (erc-track-faces-normal-list '(a b)))
-
- (should (equal 'a (erc-track-select-mode-line-face 'a '(b a))))
- (should (equal 'a (erc-track-select-mode-line-face 'a '(a b))))
- (should (equal 'a (erc-track-select-mode-line-face 'b '(b a))))
- (should (equal 'a (erc-track-select-mode-line-face 'b '(a b))))
-
- (should (equal 'a (erc-track-select-mode-line-face 'b '(a))))
- (should (equal 'b (erc-track-select-mode-line-face 'a '(b)))))
-
- ;; The ordering of the "normal" list doesn't matter.
- (let ((erc-track-faces-priority-list '(a b))
- (erc-track-faces-normal-list '(b a)))
-
- (should (equal 'a (erc-track-select-mode-line-face 'a '(b a))))
- (should (equal 'a (erc-track-select-mode-line-face 'a '(a b))))
- (should (equal 'a (erc-track-select-mode-line-face 'b '(b a))))
- (should (equal 'a (erc-track-select-mode-line-face 'b '(a b))))))
-
-(defun erc-track-tests--select-mode-line-face (ranked normals cases)
- (setq normals (map-into (mapcar (lambda (f) (cons f t)) normals)
- '(hash-table :test equal)))
-
- (setq ranked (cons (map-into (mapcar (let ((i 0))
- (lambda (f) (cons f (cl-incf i))))
- ranked)
- '(hash-table :test equal))
- ranked))
-
- (pcase-dolist (`(,want ,cur-face ,new-faces) cases)
-
- (ert-info ((format "Observed: {cur: %S, new: %S, want: %S}"
- cur-face new-faces want))
- (setq new-faces (cons (map-into
- (mapcar (lambda (f) (cons f t)) new-faces)
- '(hash-table :test equal))
- (reverse new-faces)))
- (should (equal want (erc-track--select-mode-line-face
- cur-face new-faces ranked normals))))))
-
-;; The main difference between these variants is that with the above,
-;; when given alternating lines like
-;;
-;; CUR NEW CHOICE
-;; text (mention $speaker text) => mention
-;; mention ($speaker text) => text
-;;
-;; we see the effect of alternating faces in the indicator. But when
-;; given consecutive lines with a similar composition, like
-;;
-;; text (mention $speaker text) => mention
-;; text (mention $speaker text) => mention
-;;
-;; we lose the effect. With the variant below, we get
-;;
-;; text (mention $speaker text) => mention
-;; text (mention $speaker text) => text
-;;
-
-(ert-deftest erc-track--select-mode-line-face ()
- (should-not erc-track-ignore-normal-contenders-p)
-
- ;; These are the same test cases from the previous test. The syntax
- ;; is (expected cur-face new-faces).
- (erc-track-tests--select-mode-line-face
- '(1 2 3) '(1 2 3)
- '((2 3 (2 _ 3))
- (3 2 (2 _ 3))
- (3 2 (_ 3))
- (2 3 (2 3))
- (3 2 (3))
- (2 1 (2 1 3))
- (3 1 (1 3))
- (2 1 (1 3 2))
- (3 1 (3 1))))
-
- (erc-track-tests--select-mode-line-face
- '(a b) '(a b)
- '((b a (b a))
- (b a (a b))
- (a b (b a))
- (a b (a b))
- (a b (a))
- (b a (b))))
-
- (erc-track-tests--select-mode-line-face
- '(a b) '(b a)
- '((b a (b a))
- (b a (a b))
- (a b (b a))
- (a b (a b)))))
-
-(ert-deftest erc-track--collect-faces-in ()
- (with-current-buffer (get-buffer-create "*erc-track--get-faces-in*")
- (erc-tests-common-prep-for-insertion)
- (goto-char (point-min))
- (skip-chars-forward "\n")
-
- (let ((ts #("[04:37]"
- 0 1 ( erc--msg 0 field erc-timestamp
- font-lock-face erc-timestamp-face)
- 1 7 ( field erc-timestamp
- font-lock-face erc-timestamp-face)))
- bounds)
-
- (with-silent-modifications
-
- (push (list (point)) bounds)
- (insert ; JOIN
- ts " " ; initial `fill' indentation lacks properties
- #("*** You have joined channel #chan" 0 33
- (font-lock-face erc-notice-face))
- "\n")
- (setcdr (car bounds) (point))
-
- (push (list (point)) bounds)
- (insert ; 353
- ts " "
- #("*** Users on #chan: bob alice dummy tester"
- 0 30 (font-lock-face erc-notice-face)
- 30 35 (font-lock-face erc-current-nick-face)
- 35 42 (font-lock-face erc-notice-face))
- "\n" #(" @fsbot" ; but intervening HAS properties
- 0 23 (font-lock-face erc-notice-face)))
- (setcdr (car bounds) (point))
-
- (push (list (point)) bounds)
- (insert ; PRIVMSG
- "\n" ts " "
- #("<alice> bob: Thou canst not come to me: I come to"
- 0 1 (font-lock-face erc-default-face)
- ;; erc-dangerous-host-face -> erc-nicks-alice-face (undefined)
- 1 6 (font-lock-face (erc-dangerous-host-face erc-nick-default-face))
- 6 8 (font-lock-face erc-default-face)
- ;; erc-pal-face -> erc-nicks-bob-face (undefined)
- 8 11 (font-lock-face (erc-pal-face erc-default-face))
- 11 49 (font-lock-face erc-default-face))
- "\n" #(" thee."
- 0 22 (font-lock-face erc-default-face))
- "\n")
- (setcdr (car bounds) (point)))
-
- (goto-char (point-max))
- (should (equal (setq bounds (nreverse bounds))
- '((3 . 50) (50 . 129) (129 . 212))))
-
- ;; For these result assertions, the insertion order of the table
- ;; elements should mirror that of the consed lists.
-
- ;; Baseline
- (narrow-to-region 1 3)
- (let ((result (erc-track--collect-faces-in)))
- (should-not (map-pairs (car result)))
- (should-not (cdr result)))
-
- ;; JOIN
- (narrow-to-region (car (nth 0 bounds)) (cdr (nth 0 bounds)))
- (let ((result (erc-track--collect-faces-in)))
- (should (seq-set-equal-p
- (map-pairs (car result)) '((erc-timestamp-face . t)
- (erc-notice-face . t))))
- (should (equal (cdr result) '(erc-notice-face erc-timestamp-face))))
-
- ;; 353
- (narrow-to-region (car (nth 1 bounds)) (cdr (nth 1 bounds)))
- (let ((result (erc-track--collect-faces-in)))
- (should (seq-set-equal-p (map-pairs (car result))
- '((erc-timestamp-face . t)
- (erc-notice-face . t)
- (erc-current-nick-face . t))))
- (should (equal (cdr result) '(erc-current-nick-face
- erc-notice-face
- erc-timestamp-face))))
-
- ;; PRIVMSG
- (narrow-to-region (car (nth 2 bounds)) (cdr (nth 2 bounds)))
- (let ((result (erc-track--collect-faces-in)))
- (should (seq-set-equal-p
- (map-pairs (car result))
- '((erc-timestamp-face . t)
- (erc-default-face . t)
- ((erc-dangerous-host-face erc-nick-default-face) . t)
- ((erc-pal-face erc-default-face) . t))))
- (should (equal (cdr result)
- '((erc-pal-face erc-default-face)
- (erc-dangerous-host-face erc-nick-default-face)
- erc-default-face
- erc-timestamp-face))))
-
- ;; Entire buffer.
- (narrow-to-region (car (nth 0 bounds)) erc-insert-marker)
- (let ((result (erc-track--collect-faces-in)))
- (should (seq-set-equal-p
- (map-pairs (car result))
- '((erc-timestamp-face . t)
- (erc-notice-face . t)
- (erc-current-nick-face . t)
- (erc-default-face . t)
- ((erc-dangerous-host-face erc-nick-default-face) . t)
- ((erc-pal-face erc-default-face) . t))))
- (should (equal (cdr result)
- '((erc-pal-face erc-default-face)
- (erc-dangerous-host-face erc-nick-default-face)
- erc-default-face
- erc-current-nick-face
- erc-notice-face
- erc-timestamp-face)))))
-
- (widen)
- (when noninteractive
- (kill-buffer))))
-
-(defun erc-track-tests--modified-channels/baseline (set-faces)
- ;; Simulate a JOIN, PART, etc. that's displayed in `erc-notice-face'.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(1 . erc-notice-face)))
-
- ;; Someone speaks, and the mode-line face goes from ERC's generic
- ;; "notice" face, `erc-notice-face', to the first face in the
- ;; inserted message that outranks it, which happens to be the
- ;; `button' module's composite face for buttonized speakers:
- ;; (erc-button-nick-default-face erc-nick-default-face). It
- ;; outranks both the previous occupant, `erc-notice-face', and its
- ;; one cohabitant in the message text, `erc-default-face', in
- ;; `erc-track-faces-priority-list'. Note that in the following
- ;; list, `erc-default-face' appears first because it's used for the
- ;; opening speaker bracket "<". The timestamp appears last because
- ;; it's a right-sided stamp appended to the message body.
- (funcall set-faces '(erc-timestamp-face
- (erc-button-nick-default-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(2 erc-button-nick-default-face erc-nick-default-face)))
-
- ;; The speaker speaks again immediately, and the segment changes to
- ;; `erc-default-face', which appears later in the message, as
- ;; normal body text. This happens because both `erc-default-face'
- ;; and (erc-button-nick-default-face erc-nick-default-face) appear
- ;; in `erc-track-faces-normal-list', meaning the lower-ranked
- ;; former can replace the higher-ranked latter in the mode-line for
- ;; the purpose of indicating channel activity.
- (funcall set-faces '(erc-timestamp-face
- (erc-button-nick-default-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(3 . erc-default-face)))
-
- ;; Note: if (erc-button-nick-default-face erc-nick-default-face)
- ;; were removed from `erc-track-faces-priority-list' but kept in
- ;; `erc-track-faces-normal-list', then replaying the sequence would
- ;; result in the previous two results being switched:
- ;; `erc-default-face' would replace `erc-notice-face' before being
- ;; replaced by the buttonized composite.
-
- ;; The speaker speaks yet again, and the segment goes back to the
- ;; higher ranking face.
- (funcall set-faces '(erc-timestamp-face
- (erc-button-nick-default-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(4 erc-button-nick-default-face erc-nick-default-face)))
-
- ;; Finally, another notice arrives. Although lower ranked, it also
- ;; appears in `erc-track-faces-normal-list' and so is eligible to
- ;; replace the incumbent.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(5 . erc-notice-face))))
-
-(ert-deftest erc-track-modified-channels/baseline ()
- (erc-tests-common-track-modified-channels
- #'erc-track-tests--modified-channels/baseline))
-
-(ert-deftest erc-track-modified-channels/baseline/mention ()
- (erc-tests-common-track-modified-channels
- (lambda (set-faces)
- ;; Note: these messages don't have timestamps.
-
- ;; Simulate a JOIN, PART, etc. that's displayed in `erc-notice-face'.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(1 . erc-notice-face)))
-
- ;; Someone speaks, mentioning someone else, and the mode-line
- ;; changes to (erc-button-nick-default-face erc-nick-default-face)
- ;; rather than (erc-button-nick-default-face erc-default-face)
- ;; based on their rankings in `erc-track-faces-priority-list'.
- (funcall set-faces '((erc-button-nick-default-face erc-default-face)
- (erc-button-nick-default-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(2 erc-button-nick-default-face erc-nick-default-face)))
-
- ;; Someone else speaks, again with a mention and additional body text.
- (funcall set-faces '((erc-button-nick-default-face erc-default-face)
- (erc-button-nick-default-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(3 erc-button-nick-default-face erc-default-face)))
-
- ;; And yet again, which results in the indicator going back to one.
- (funcall set-faces '((erc-button-nick-default-face erc-default-face)
- (erc-button-nick-default-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(4 erc-button-nick-default-face erc-nick-default-face)))
-
- ;; Finally, another notice arrives.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(5 . erc-notice-face))))))
-
-;; The compat-oriented option `erc-track-ignore-normal-contenders-p'
-;; blinds track to `erc-track-faces-normal-list' for certain consecutive
-;; messages with an identical face makeup.
-(ert-deftest erc-track-modified-channels/baseline/ignore ()
- (let ((erc-track-ignore-normal-contenders-p t))
- (erc-tests-common-track-modified-channels
- (lambda (set-faces)
- ;; Simulate a JOIN, PART, etc. that's displayed in `erc-notice-face'.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(1 . erc-notice-face)))
-
- ;; Someone speaks, and the mode-line indicator's face changes to
- ;; that of a buttonized speaker.
- (funcall set-faces
- '(erc-timestamp-face
- (erc-button-nick-default-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(2 erc-button-nick-default-face erc-nick-default-face)))
-
- ;; The speaker speaks again immediately, and the segment doesn't
- ;; change.
- (funcall set-faces
- '(erc-timestamp-face
- (erc-button-nick-default-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(3 erc-button-nick-default-face erc-nick-default-face)))
-
- ;; Finally, another notice arrives.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(4 . erc-notice-face)))))))
-
-;; Compat-oriented option `erc-track-ignore-normal-contenders-p'.
-(ert-deftest erc-track-modified-channels/baseline/mention/ignore ()
- (let ((erc-track-ignore-normal-contenders-p t))
- (erc-tests-common-track-modified-channels
- (lambda (set-faces)
-
- ;; Simulate a JOIN, PART, etc. that's displayed in `erc-notice-face'.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(1 . erc-notice-face)))
-
- ;; Someone speaks, and the mode-line indicator's face changes to
- ;; that of a buttonized speaker.
- (funcall set-faces
- '((erc-button-nick-default-face erc-default-face)
- (erc-button-nick-default-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(2 erc-button-nick-default-face erc-nick-default-face)))
-
- ;; Someone else speaks, again with a mention and additional body
- ;; text, but the indicator stays the same.
- (funcall set-faces
- '((erc-button-nick-default-face erc-default-face)
- (erc-button-nick-default-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(3 erc-button-nick-default-face erc-nick-default-face)))
-
- ;; Finally, another notice arrives.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(4 . erc-notice-face)))))))
-
-;; Option `erc-track-priority-faces-only' does not affect the behavior
-;; of the baseline "normals" scenario because all faces appear in
-;; `erc-track-faces-priority-list'.
-(ert-deftest erc-track-modified-channels/priority-only-all/baseline ()
- (let ((erc-track-priority-faces-only 'all))
- (erc-tests-common-track-modified-channels
- #'erc-track-tests--modified-channels/baseline)))
-
-;; This test simulates a common configuration that combines an
-;; `erc-track-faces-priority-list' removed of `erc-notice-face' with
-;; `erc-track-priority-faces-only' being `all'. It also features in the
-;; sample configuration in ERC's manual.
-(ert-deftest erc-track-modified-channels/priority-only-all/sans-notice ()
- (let ((erc-track-priority-faces-only 'all)
- (erc-track-faces-priority-list
- (remq 'erc-notice-face erc-track-faces-priority-list)))
-
- (erc-tests-common-track-modified-channels
- (lambda (set-faces)
- ;; Note: these messages don't have timestamps.
-
- ;; Simulate a message normally displayed in `erc-notice-face',
- ;; which has been removed from `erc-track-faces-priority-list'.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (should-not (alist-get (current-buffer) erc-modified-channels-alist))
-
- ;; Someone speaks, mentioning someone else, and the mode-line
- ;; changes to the buttonized speaker face rather than the
- ;; buttonized mention face, due to their respective ranks.
- (funcall set-faces
- '((erc-button-nick-default-face erc-default-face)
- (erc-button-nick-default-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(1 erc-button-nick-default-face erc-nick-default-face)))
-
- ;; Someone else speaks, again with a mention and additional body text.
- (funcall set-faces
- '((erc-button-nick-default-face erc-default-face)
- (erc-button-nick-default-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(2 erc-button-nick-default-face erc-default-face)))
-
- ;; And yet again, which results in the indicator going back to one.
- (funcall set-faces
- '((erc-button-nick-default-face erc-default-face)
- (erc-button-nick-default-face erc-nick-default-face)
- erc-default-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(3 erc-button-nick-default-face erc-nick-default-face)))
-
- ;; Finally, another notice arrives, which is ignored.
- (funcall set-faces '(erc-notice-face))
- (erc-track-modified-channels)
- (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
- '(3 erc-button-nick-default-face
- erc-nick-default-face)))))))
-
-;;; erc-track-tests.el ends here
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :barnet:changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
- (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.barnet.org 003 tester :This server was created Wed, 28 Apr 2021 06:59:59 UTC")
- (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.barnet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.barnet.org 254 tester 1 :channels formed")
- (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- ;; No mode answer ^
- (0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":tester!~u@xrir8fpe4d7ak.irc JOIN #chan")
- (0 ":irc.barnet.org 353 tester = #chan :joe @mike tester")
- (0 ":irc.barnet.org 366 tester #chan :End of /NAMES list.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...")
- (0 ":joe!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :[07:04:25] mike: Belike, for joy the emperor hath a son.")
- (0 ":mike!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :[07:04:27] joe: Protest their first of manhood.")
- (0 ":joe!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :[07:04:29] mike: As frozen water to a starved snake.")
- (0 ":mike!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :[07:04:34] joe: My mirth it much displeas'd, but pleas'd my woe.")
- (0 ":joe!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :[07:04:38] mike: Why, Marcus, no man should be mad but I.")
- (0 ":mike!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :[07:04:44] joe: Faith, I have heard too much, for your words and performances are no kin together.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.")
- (0 ":irc.barnet.org NOTICE tester :[07:00:01] 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 ":irc.barnet.org 305 tester :You are no longer marked as being away"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.barnet.org 324 tester #chan +nt")
- (0 ":irc.barnet.org 329 tester #chan 1619593200")
- (0.25 ":joe!~u@svpn88yjcdj42.irc PRIVMSG #chan :mike: But, in defense, by mercy, 'tis most just.")
- (0.25 ":mike!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :joe: The Marshal of France, Monsieur la Far.")
- (0.25 ":joe!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :mike: And bide the penance of each three years' day.")
- (0.25 ":mike!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :joe: Madam, within; but never man so chang'd.")
- (0.25 ":joe!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :mike: As much in private, and I'll bid adieu."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :foonet:changeme"))
-((nick 1 "NICK tester"))
-((user 1 "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 Wed, 28 Apr 2021 07:00:00 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- ;; No mode answer ^
- (0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":tester!~u@nvfhxvqm92rm6.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :alice @bob tester")
- (0 ":irc.foonet.org 366 tester #chan :End of /NAMES list.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...")
- (0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:02] alice: Here come the lovers, full of joy and mirth.")
- (0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:07] bob: According to the fool's bolt, sir, and such dulcet diseases.")
- (0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:10] alice: And hang himself. I pray you, do my greeting.")
- (0 ":someone!~u@abcdefg.irc PRIVMSG #chan :[07:04:10] hi everyone.")
- (0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:18] bob: And you sat smiling at his cruel prey.")
- (0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:21] alice: Or never after look me in the face.")
- (0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:25] bob: If that may be, than all is well. Come, sit down, every mother's son, and rehearse your parts. Pyramus, you begin: when you have spoken your speech, enter into that brake; and so every one according to his cue.")
- (0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:30] alice: Where I espied the panther fast asleep.")
- (0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:32] bob: Alas! he is too young: yet he looks successfully.")
- (0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:37] alice: Here, at your lordship's service.")
- (0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:42] bob: By my troth, and in good earnest, and so God mend me, and by all pretty oaths that are not dangerous, if you break one jot of your promise or come one minute behind your hour, I will think you the most pathetical break-promise, and the most hollow lover, and the most unworthy of her you call Rosalind, that may be chosen out of the gross band of the unfaithful. Therefore, beware my censure, and keep your promise.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.")
- (0 ":irc.foonet.org NOTICE tester :[07:00:32] 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 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1619593200")
- (0.9 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :bob: Grows, lives, and dies, in single blessedness.")
- (0.25 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :alice: For these two hours, Rosalind, I will leave thee.")
- (0.25 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :bob: By this hand, it will not kill a fly. But come, now I will be your Rosalind in a more coming-on disposition; and ask me what you will, I will grant it.")
- (0.25 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :alice: That I must love a loathed enemy.")
- (0.25 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :bob: As't please your lordship: I'll leave you."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0.0 ":irc.foonet.org 433 * tester :Nickname is reserved by a different account")
- (0.0 ":irc.foonet.org FAIL NICK NICKNAME_RESERVED tester :Nickname is reserved by a different account"))
-
-((nick 10 "NICK tester`")
- (0.1 ":irc.foonet.org 001 tester` :Welcome to the foonet IRC Network tester`")
- (0.0 ":irc.foonet.org 002 tester` :Your host is irc.foonet.org, running version oragono-2.6.1-937b9b02368748e5")
- (0.0 ":irc.foonet.org 003 tester` :This server was created Fri, 24 Sep 2021 01:38:36 UTC")
- (0.0 ":irc.foonet.org 004 tester` irc.foonet.org oragono-2.6.1-937b9b02368748e5 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.0 ":irc.foonet.org 005 tester` AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0.1 ":irc.foonet.org 005 tester` MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0.1 ":irc.foonet.org 005 tester` draft/CHATHISTORY=100 :are supported by this server")
- (0.0 ":irc.foonet.org 251 tester` :There are 0 users and 3 invisible on 1 server(s)")
- (0.0 ":irc.foonet.org 252 tester` 0 :IRC Operators online")
- (0.0 ":irc.foonet.org 253 tester` 0 :unregistered connections")
- (0.0 ":irc.foonet.org 254 tester` 1 :channels formed")
- (0.0 ":irc.foonet.org 255 tester` :I have 3 clients and 0 servers")
- (0.0 ":irc.foonet.org 265 tester` 3 3 :Current local users 3, max 3")
- (0.2 ":irc.foonet.org 266 tester` 3 3 :Current global users 3, max 3")
- (0.0 ":irc.foonet.org 422 tester` :MOTD File is missing"))
-
-((mode-user 10 "MODE tester` +i")
- (0.0 ":irc.foonet.org 221 tester` +i")
- (0.0 ":irc.foonet.org NOTICE tester` :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((privmsg 10 "PRIVMSG NickServ :IDENTIFY tester changeme")
- (0.01 ":tester`!~u@rpaau95je67ci.irc NICK tester")
- (0.0 ":NickServ!NickServ@localhost NOTICE tester :You're now logged in as tester"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0.0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.1-937b9b02368748e5")
- (0.0 ":irc.foonet.org 003 tester :This server was created Fri, 24 Sep 2021 01:38:36 UTC")
- (0.0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.1-937b9b02368748e5 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0.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:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0.0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0.0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0.0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0.0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0.0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0.0 ":irc.foonet.org 221 tester +i")
- (0.0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((privmsg 10 "PRIVMSG bob :hi")
- (0.02 ":bob!~u@ecnnh95wr67pv.net PRIVMSG tester :hola")
- (0.01 ":bob!~u@ecnnh95wr67pv.net PRIVMSG tester :how r u?"))
-
-((quit 10 "QUIT :" quit)
- (0.01 ":tester!~u@rpaau95je67ci.irc QUIT :Quit: " quit))
-((drop 1 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0.1 ":irc.foonet.org 001 dummy :Welcome to the foonet IRC Network dummy")
- (0.0 ":irc.foonet.org 002 dummy :Your host is irc.foonet.org, running version oragono-2.6.1-937b9b02368748e5")
- (0.0 ":irc.foonet.org 003 dummy :This server was created Fri, 24 Sep 2021 01:38:36 UTC")
- (0.0 ":irc.foonet.org 004 dummy irc.foonet.org oragono-2.6.1-937b9b02368748e5 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.0 ":irc.foonet.org 005 dummy 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.1 ":irc.foonet.org 005 dummy MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0.1 ":irc.foonet.org 005 dummy draft/CHATHISTORY=100 :are supported by this server")
- (0.0 ":irc.foonet.org 251 dummy :There are 0 users and 3 invisible on 1 server(s)")
- (0.0 ":irc.foonet.org 252 dummy 0 :IRC Operators online")
- (0.0 ":irc.foonet.org 253 dummy 0 :unregistered connections")
- (0.0 ":irc.foonet.org 254 dummy 1 :channels formed")
- (0.0 ":irc.foonet.org 255 dummy :I have 3 clients and 0 servers")
- (0.0 ":irc.foonet.org 265 dummy 3 3 :Current local users 3, max 3")
- (0.2 ":irc.foonet.org 266 dummy 3 3 :Current global users 3, max 3")
- ;; Could arrive anytime around this point
- (0.0 ":tester!~u@rpaau95je67ci.irc NICK :dummy")
- (0.0 ":irc.foonet.org 422 dummy :MOTD File is missing")
- ;; Playback
- (0.01 ":bob!~u@ecnnh95wr67pv.net PRIVMSG dummy :back?")
- )
-
-((mode-user 10 "MODE dummy +i")
- (0.0 ":irc.foonet.org 221 dummy +i")
- (0.0 ":irc.foonet.org NOTICE dummy :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."))
-
-((renick 10 "NICK tester")
- (0.01 ":dummy!~u@rpaau95je67ci.irc NICK tester")
- (0.0 ":NickServ!NickServ@localhost NOTICE dummy :You're now logged in as tester"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0.0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.1-937b9b02368748e5")
- (0.0 ":irc.foonet.org 003 tester :This server was created Fri, 24 Sep 2021 01:38:36 UTC")
- (0.0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.1-937b9b02368748e5 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0.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:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0.0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0.0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0.0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0.0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0.0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 12 "MODE tester +i")
- (0.0 ":irc.foonet.org 221 tester +i")
- (0.0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((privmsg 17.21 "PRIVMSG NickServ :REGISTER changeme")
- (0.02 ":NickServ!NickServ@localhost NOTICE tester :Account created")
- (0.01 ":NickServ!NickServ@localhost NOTICE tester :You're now logged in as tester"))
-
-((quit 18.19 "QUIT :" quit)
- (0.01 ":tester!~u@rpaau95je67ci.irc QUIT :Quit: " quit))
-((drop 1 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :changeme"))
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
- (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.barnet.org 003 tester :This server was created Tue, 04 May 2021 05:06:19 UTC")
- (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.barnet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.barnet.org 253 tester 0 :unregistered connections")
- (0 ":irc.barnet.org 254 tester 1 :channels formed")
- (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0 ":irc.barnet.org 221 tester +i")
- (0 ":irc.barnet.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."))
-
-((join 10 "JOIN #chan")
- (0 ":tester!~u@jnu48g2wrycbw.irc JOIN #chan")
- (0 ":irc.barnet.org 353 tester = #chan :@mike joe tester")
- (0 ":irc.barnet.org 366 tester #chan :End of NAMES list"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.barnet.org 324 tester #chan +nt")
- (0 ":irc.barnet.org 329 tester #chan 1620104779")
- (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #chan :tester, welcome!")
- (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #chan :tester, welcome!")
- (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #chan :joe: Whipp'd first, sir, and hang'd after.")
- (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #chan :mike: We have yet many among us can gripe as hard as Cassibelan; I do not say I am one, but I have a hand. Why tribute ? why should we pay tribute ? If C sar can hide the sun from us with a blanket, or put the moon in his pocket, we will pay him tribute for light; else, sir, no more tribute, pray you now.")
- (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #chan :joe: Double and treble admonition, and still forfeit in the same kind ? This would make mercy swear, and play the tyrant.")
- (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #chan :mike: And secretly to greet the empress' friends.")
- (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #chan :joe: You have not been inquired after: I have sat here all day.")
- (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #chan :mike: That same Berowne I'll torture ere I go.")
- (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #chan :joe: For mine own part,no offence to the general, nor any man of quality,I hope to be saved.")
- (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #chan :mike: Mehercle! if their sons be ingenuous, they shall want no instruction; if their daughters be capable, I will put it to them. But, vir sapit qui pauca loquitur. A soul feminine saluteth us."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :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 Tue, 04 May 2021 05:06:18 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((join 10 "JOIN #chan")
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620104779")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: But, as it seems, did violence on herself.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Well, this is the forest of Arden.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Signior Iachimo will not from it. Pray, let us follow 'em.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Our queen and all her elves come here anon.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: The ground is bloody; search about the churchyard.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: You have discharged this honestly: keep it to yourself. Many likelihoods informed me of this before, which hung so tottering in the balance that I could neither believe nor misdoubt. Pray you, leave me: stall this in your bosom; and I thank you for your honest care. I will speak with you further anon.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Give me that mattock, and the wrenching iron.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Stand you! You have land enough of your own; but he added to your having, gave you some ground.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Excellent workman! Thou canst not paint a man so bad as is thyself.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: And will you, being a man of your breeding, be married under a bush, like a beggar ? Get you to church, and have a good priest that can tell you what marriage is: this fellow will but join you together as they join wainscot; then one of you will prove a shrunk panel, and like green timber, warp, warp.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Live, and be prosperous; and farewell, good fellow."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 1 "USER tester 0 * :tester")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.00 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.8.0")
- (0.00 ":irc.foonet.org 003 tester :This server was created Mon, 12 Dec 2022 01:25:38 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.00 ":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 1 :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.01 ":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 10 "MODE tester +i")
- (0.00 ":irc.foonet.org 221 tester +i")
- (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((join 10 "JOIN #chan")
- (0.03 ":tester!~u@z5d6jyn8pwxge.irc JOIN #chan"))
-
-((mode-1 10 "MODE #chan")
- (0.01 ":irc.foonet.org 353 tester = #chan :@alice bob foonet tester")
- (0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.03 ":irc.foonet.org 324 tester #chan +nt")
- (0.00 ":irc.foonet.org 329 tester #chan 1670808354")
- (0.00 ":bob!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :tester, welcome!")
- (0.00 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :tester, welcome!")
-
- (0.00 ":foonet!~u@z5d6jyn8pwxge.irc PRIVMSG tester :hi")
-
- (0.03 ":bob!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :alice: Forbear it therefore; give your cause to heaven.")
- (0.01 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :bob: Even at thy teat thou hadst thy tyranny.")
- (0.00 ":foonet!~u@z5d6jyn8pwxge.irc QUIT :connection closed"))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.03 ":tester!~u@z5d6jyn8pwxge.irc QUIT :Quit: \2ERC\2"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 1 "USER tester 0 * :tester")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.00 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.8.0")
- (0.00 ":irc.foonet.org 003 tester :This server was created Mon, 12 Dec 2022 01:25:38 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.00 ":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 1 :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.01 ":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 10 "MODE tester +i")
- (0.00 ":irc.foonet.org 221 tester +i")
- (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")
- (0.00 ":dummy!~u@z5d6jyn8pwxge.irc PRIVMSG tester :hi"))
-
-((~privmsg-open 10 "PRIVMSG nitwit :hola")
- (0.00 ":nitwit!~u@m5q6wla8cjktr.irc PRIVMSG tester :ciao"))
-
-((privmsg 10 "PRIVMSG dummy :howdy")
- (0.00 ":dummy!~u@z5d6jyn8pwxge.irc PRIVMSG tester :bye")
- (0.01 ":dummy!~u@z5d6jyn8pwxge.irc QUIT :connection closed"))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.03 ":tester!~u@z5d6jyn8pwxge.irc QUIT :Quit: \2ERC\2"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 4.0 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0.0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0.0 ":irc.foonet.org 003 tester :This server was created Wed, 16 Jun 2021 04:15:00 UTC")
- (0.0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0.0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0.0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0.0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0.0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0.0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0.0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- ;; No mode answer
- (0.0 ":tester!~u@mw6kegwt77kwe.irc JOIN #chan")
- (0.0 ":irc.foonet.org 353 tester = #chan :alice @bob tester")
- (0.0 ":irc.foonet.org 366 tester #chan :End of /NAMES list.")
- (0.0 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...")
- (0.0 ":alice!~u@mw6kegwt77kwe.irc PRIVMSG #chan :[10:37:52] bob: Thou pout'st upon thy fortune and thy love.")
- (0.0 ":bob!~u@mw6kegwt77kwe.irc PRIVMSG #chan :[10:37:56] alice: With these mortals on the ground.")
- (0.0 ":***!znc@znc.in PRIVMSG #chan :Playback Complete."))
-
-((mode 10 "MODE #chan")
- (0.0 ":irc.foonet.org 324 tester #chan +nt")
- (0.0 ":irc.foonet.org 329 tester #chan 1623816901")
- (0.1 ":bob!~u@mw6kegwt77kwe.irc PRIVMSG #chan :alice: My name, my good lord, is Parolles.")
- (0.1 ":alice!~u@mw6kegwt77kwe.irc PRIVMSG #chan :bob: Wilt thou rest damned ? God help thee, shallow man! God make incision in thee! thou art raw."))
-
-((privmsg 3.0 "PRIVMSG *status :help")
- (0.0 ":*status!znc@znc.in PRIVMSG tester :In the following list all occurrences of <#chan> support wildcards (* and ?) except ListNicks")
- (0.0 ":*status!znc@znc.in PRIVMSG tester :\2Version\17: Print which version of ZNC this is")
- (0.0 ":*status!znc@znc.in PRIVMSG tester :\2Shutdown [message]\17: Shut down ZNC completely")
- (0.0 ":*status!znc@znc.in PRIVMSG tester :\2Restart [message]\17: Restart ZNC")
- (0.1 ":bob!~u@mw6kegwt77kwe.irc PRIVMSG #chan :alice: In that word's death; no words can that woe sound.")
- (0.1 ":alice!~u@mw6kegwt77kwe.irc PRIVMSG #chan :bob: Look, sir, here comes the lady towards my cell."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0.0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0.0 ":irc.foonet.org 003 tester :This server was created Wed, 16 Jun 2021 04:15:00 UTC")
- (0.0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0.0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0.0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0.0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0.0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0.0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0.0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 5 "MODE tester +i")
- ;; No mode answer
- (0.0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0.0 ":tester!~u@mw6kegwt77kwe.irc JOIN #chan")
- (0.0 ":irc.foonet.org 353 tester = #chan :alice @bob tester")
- (0.0 ":irc.foonet.org 366 tester #chan :End of /NAMES list.")
- (0.0 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...")
- (0.0 ":alice!~u@mw6kegwt77kwe.irc PRIVMSG #chan :[10:35:50] bob: To Laced mon did my land extend.")
- (0.0 ":bob!~u@mw6kegwt77kwe.irc PRIVMSG #chan :[10:35:55] alice: This is but a custom in your tongue; you bear a graver purpose, I hope.")
- (0.0 ":alice!~u@mw6kegwt77kwe.irc PRIVMSG #chan :[10:37:16] bob: To imitate them; faults that are rich are fair.")
- (0.0 ":bob!~u@mw6kegwt77kwe.irc PRIVMSG #chan :[10:37:18] alice: Our Romeo hath not been in bed to-night.")
- (0.0 ":alice!~u@mw6kegwt77kwe.irc PRIVMSG #chan :[10:37:21] bob: But, in defense, by mercy, 'tis most just.")
- (0.0 ":bob!~u@mw6kegwt77kwe.irc PRIVMSG #chan :[10:37:25] alice: Younger than she are happy mothers made.")
- (0.0 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.")
- (0.0 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-
-((mode-chan 10 "MODE #chan")
- (1.0 ":irc.foonet.org 324 tester #chan +nt")
- (0.0 ":irc.foonet.org 329 tester #chan 1623816901")
- (0.1 ":alice!~u@mw6kegwt77kwe.irc PRIVMSG #chan :bob: At thy good heart's oppression.")
- (0.1 ":bob!~u@mw6kegwt77kwe.irc PRIVMSG #chan :alice: But purgatory, torture, hell itself."))
-
-((privmsg 3 "PRIVMSG *status :help")
- (0.0 ":*status!znc@znc.in PRIVMSG tester :In the following list all occurrences of <#chan> support wildcards (* and ?) except ListNicks")
- (0.0 ":*status!znc@znc.in PRIVMSG tester :\2AddPort <[+]port> <ipv4|ipv6|all> <web|irc|all> [bindhost [uriprefix]]\17: Add another port for ZNC to listen on")
- (0.0 ":*status!znc@znc.in PRIVMSG tester :\2DelPort <port> <ipv4|ipv6|all> [bindhost]\17: Remove a port from ZNC")
- (0.0 ":*status!znc@znc.in PRIVMSG tester :\2Rehash\17: Reload global settings, modules, and listeners from znc.conf")
- (0.1 ":alice!~u@mw6kegwt77kwe.irc PRIVMSG #chan :bob: And at my suit, sweet, pardon what is past.")
- (0.1 ":bob!~u@mw6kegwt77kwe.irc PRIVMSG #chan :alice: My lord, you give me most egregious indignity."))
-
-((quit 2 "QUIT :\2ERC\2"))
-
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :changeme"))
-((nick 1 "NICK chester"))
-((user 1 "USER user 0 * :chester")
- (0 ":irc.foonet.org 001 chester :Welcome to the foonet IRC Network chester")
- (0 ":irc.foonet.org 002 chester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.foonet.org 003 chester :This server was created Sun, 13 Jun 2021 05:45:20 UTC")
- (0 ":irc.foonet.org 004 chester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 chester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 chester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 chester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 chester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 chester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 chester 1 :unregistered connections")
- (0 ":irc.foonet.org 254 chester 1 :channels formed")
- (0 ":irc.foonet.org 255 chester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 chester 3 4 :Current local users 3, max 4")
- (0 ":irc.foonet.org 266 chester 3 4 :Current global users 3, max 4")
- (0 ":irc.foonet.org 422 chester :MOTD File is missing"))
-
-((mode-user 12 "MODE chester +i")
- (0 ":irc.foonet.org 221 chester +i")
- (0 ":chester!~u@yuvqisyu7m7qs.irc JOIN #chan")
- (0 ":irc.foonet.org 353 chester = #chan :tester chester @alice bob")
- (0 ":irc.foonet.org 366 chester #chan :End of NAMES list")
- (0 ":irc.foonet.org NOTICE chester :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."))
-
-((mode 10 "MODE #chan")
- (0.0 ":irc.foonet.org 324 chester #chan +nt")
- (0.0 ":irc.foonet.org 329 chester #chan 1623563121")
- (0.0 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :chester, welcome!")
- (0.0 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :chester, welcome!")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :alice: Dispatch, I say, and find the forester.")
- (0.0 ":tester!~u@yuvqisyu7m7qs.irc QUIT :Quit: " quit)
- (0.5 ":tester!~u@yuvqisyu7m7qs.irc JOIN #chan")
- (0.1 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :tester, welcome again!")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :tester, welcome again!"))
-
-((quit 20 "QUIT :" quit)
- (0.0 ":chester!~u@yuvqisyu7m7qs.irc QUIT :Quit: " quit))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "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, 13 Jun 2021 05:45:20 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4")
- (0 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 12 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((join 15 "JOIN #chan")
- (0 ":tester!~u@yuvqisyu7m7qs.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :tester @alice bob")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-
-((mode 10 "MODE #chan")
- (0.0 ":irc.foonet.org 324 tester #chan +nt")
- (0.0 ":irc.foonet.org 329 tester #chan 1623563121")
- (0.0 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :tester, welcome!")
- (0.0 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :tester, welcome!")
- (0.0 ":chester!~u@yuvqisyu7m7qs.irc JOIN #chan")
- (0.1 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :chester, welcome!")
- (0.0 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :chester, welcome!")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :alice: Dispatch, I say, and find the forester."))
-
-((quit 4 "QUIT "))
-
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "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, 13 Jun 2021 05:45:20 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4")
- (0 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 4.2 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")
- (0 ":tester!~u@yuvqisyu7m7qs.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :tester @alice bob chester")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-
-((~useless-join 10 "JOIN #chan"))
-
-((mode 10 "MODE #chan")
- (0.0 ":irc.foonet.org 324 tester #chan +nt")
- (0.0 ":irc.foonet.org 329 tester #chan 1623563121")
- (0.0 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :tester, welcome again!")
- (0.0 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :tester, welcome again!"))
-
-((quit 4 "QUIT :" quit)
- (0 ":tester!~u@yuvqisyu7m7qs.irc QUIT :Quit: " quit))
-
-((linger 5 LINGER))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 1.2 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 1.2 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 12 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((join 6 "JOIN #chan")
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-
-((mode 8 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620104779")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: But, as it seems, did violence on herself.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Well, this is the forest of Arden.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Signior Iachimo will not from it. Pray, let us follow 'em.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Our queen and all her elves come here anon.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: The ground is bloody; search about the churchyard.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: You have discharged this honestly: keep it to yourself. Many likelihoods informed me of this before, which hung so tottering in the balance that I could neither believe nor misdoubt. Pray you, leave me: stall this in your bosom; and I thank you for your honest care. I will speak with you further anon.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Give me that mattock, and the wrenching iron.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Stand you! You have land enough of your own; but he added to your having, gave you some ground.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Excellent workman! Thou canst not paint a man so bad as is thyself.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: And will you, being a man of your breeding, be married under a bush, like a beggar ? Get you to church, and have a good priest that can tell you what marriage is: this fellow will but join you together as they join wainscot; then one of you will prove a shrunk panel, and like green timber, warp, warp.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Live, and be prosperous; and farewell, good fellow."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :tester@vanilla/foonet:changeme"))
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.00 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.00 ":irc.foonet.org 003 tester :This server was created Thu, 13 Apr 2023 05:55:22 UTC")
- (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.00 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.00 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
- (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0.01 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.00 ":irc.foonet.org 254 tester 1 :channels formed")
- (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.00 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode 10 "MODE tester +i")
- (0.01 ":irc.foonet.org 221 tester +Zi"))
-
-((privmsg-play 10 "PRIVMSG *status :playbuffer #chan")
- (0.05 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...")
- (0.02 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:08:24] alice: Was I a child, to fear I know not what.")
- (0.02 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:08:29] bob: My lord, I do confess the ring was hers.")
- (0.01 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:08:40] alice: My sons would never so dishonour me.")
- (0.01 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:09:54] bob: By the hand of a soldier, I will undertake it.")
- (0.01 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:09:57] alice: Thou counterfeit'st most lively.")
- (0.01 ":***!znc@znc.in PRIVMSG #chan :Playback Complete."))
-
-((privmsg-attach 10 "PRIVMSG *status :attach #chan")
- (0.01 ":tester!~u@78a58pgahbr24.irc JOIN #chan"))
-
-((mode-chan 10 "MODE #chan")
- (0.01 ":irc.foonet.org 353 tester = #chan :@alice bob tester")
- (0.00 ":irc.foonet.org 366 tester #chan :End of /NAMES list.")
- (0.00 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...")
- (0.00 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:10:01] bob: With what it loathes for that which is away.")
- (0.00 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:10:30] alice: Ties up my tongue, and will not let me speak.")
- (0.00 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:11:26] bob: They say he is already in the forest of Arden, and a many merry men with him; and there they live like the old Robin Hood of England. They say many young gentlemen flock to him every day, and fleet the time carelessly, as they did in the golden world.")
- (0.01 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:11:29] alice: Not by his breath that is more miserable.")
- (0.00 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.")
- (0.00 ":*status!znc@znc.in PRIVMSG tester :There was 1 channel matching [#chan]")
- (0.03 ":*status!znc@znc.in PRIVMSG tester :Attached 1 channel")
- (0.00 ":irc.foonet.org 324 tester #chan +Cnt")
- (0.00 ":irc.foonet.org 329 tester #chan 1681365340")
- (0.03 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :bob: Five or six thousand horse, I said,I will say true,or thereabouts, set down, for I'll speak truth.")
- (0.02 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :alice: Riddling confession finds but riddling shrift.")
- (0.04 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :bob: Ay, and the captain of his horse, Count Rousillon."))
-
-((privmsg-bob 10 "PRIVMSG #chan :bob: hi")
- (0.02 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :alice: But thankful even for hate, that is meant love.")
- (0.02 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :tester: Come, come, elder brother, you are too young in this.")
- (0.02 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :bob: Sir, we have known together in Orleans.")
- (0.05 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :alice: Pawn me to this your honour, she is his."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.01 ":irc.foonet.org 003 tester :This server was created Sat, 14 Oct 2023 16:08:20 UTC")
- (0.02 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
- (0.00 ":irc.foonet.org 251 tester :There are 0 users and 5 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 5 clients and 0 servers")
- (0.00 ":irc.foonet.org 265 tester 5 5 :Current local users 5, max 5")
- (0.02 ":irc.foonet.org 266 tester 5 5 :Current global users 5, max 5")
- (0.01 ":irc.foonet.org 422 tester :MOTD File is missing")
- (0.00 ":irc.foonet.org 221 tester +i")
- (0.01 ":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."))
-
-((mode 10 "MODE tester +i")
- (0.00 ":irc.foonet.org 221 tester +i"))
-
-((join 10 "JOIN #chan")
- (0.03 ":tester!~u@rdjcgiwfuwqmc.irc JOIN #chan")
- (0.03 ":irc.foonet.org 353 tester = #chan :@fsbot bob alice dummy tester")
- (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.00 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :tester, welcome!")
- (0.01 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :tester, welcome!"))
-
-((mode 10 "MODE #chan")
- (0.01 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :alice: Persuade this rude wretch willingly to die.")
- (0.01 ":irc.foonet.org 324 tester #chan +Cnt")
- (0.01 ":irc.foonet.org 329 tester #chan 1697299707")
- (0.03 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :bob: It might be yours or hers, for aught I know.")
- (0.07 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :Would all themselves laugh mortal.")
- (0.04 ":dummy!~u@rdjcgiwfuwqmc.irc PRIVMSG tester :hi")
- (0.06 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :alice: It hath pleased the devil drunkenness to give place to the devil wrath; one unperfectness shows me another, to make me frankly despise myself.")
- (0.05 ":dummy!~u@rdjcgiwfuwqmc.irc QUIT :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)")
- (0.08 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :You speak of him when he was less furnished than now he is with that which makes him both without and within."))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.04 ":tester!~u@rdjcgiwfuwqmc.irc QUIT :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)")
- (0.02 "ERROR :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER tester 0 * :tester")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.02 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.01 ":irc.foonet.org 003 tester :This server was created Thu, 07 Dec 2023 08:04:35 UTC")
- (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
- (0.00 ":irc.foonet.org 251 tester :There are 0 users and 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.02 ":irc.foonet.org 265 tester 4 5 :Current local users 4, max 5")
- (0.00 ":irc.foonet.org 266 tester 4 5 :Current global users 4, max 5")
- (0.00 ":irc.foonet.org 422 tester :MOTD File is missing")
- (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."))
-
-((mode-tester 10 "MODE tester +i"))
-
-((join-mine 10 "JOIN #mine")
- (0.01 ":irc.foonet.org 221 tester +i")
- (0.00 ":tester!~u@2jv6nwu4af69s.irc JOIN #mine")
- (0.02 ":irc.foonet.org 353 tester = #mine :@tester +dummy")
- (0.01 ":irc.foonet.org 366 tester #mine :End of NAMES list"))
-
-((mode-mine 10 "MODE #mine")
- (0.00 ":irc.foonet.org 324 tester #mine +Cnt")
- (0.02 ":irc.foonet.org 329 tester #mine 1702026418")
- (0.04 ":dummy!~u@2jv6nwu4af69s.irc PRIVMSG +#mine :hello")
- (0.03 ":dummy!~u@2jv6nwu4af69s.irc PRIVMSG +#mine :there")
- (0.05 ":dummy!~u@2jv6nwu4af69s.irc PRIVMSG +#mine :\1ACTION sad\1")
- (0.03 ":dummy!~u@2jv6nwu4af69s.irc PRIVMSG +#mine :\1ACTION glad\1"))
-
-((privmsg-statusmsg 10 "PRIVMSG +#mine :howdy"))
-((privmsg-statusmsg-action 10 "PRIVMSG +#mine :tenderfoot")
- ;; These are simulated "echoed messages"
- (0.05 ":tester!~u@2jv6nwu4af69s.irc PRIVMSG +#mine :\1ACTION mad\1")
- (0.05 ":tester!~u@2jv6nwu4af69s.irc PRIVMSG +#mine :\1ACTION chad\1"))
-
-((privmsg-prefixed 10 "PRIVMSG #mine :\1ACTION ready\1")
- (0.04 ":dummy!~u@2jv6nwu4af69s.irc PRIVMSG +#mine :okie")
- (0.05 ":dummy!~u@2jv6nwu4af69s.irc PRIVMSG +#mine :\1ACTION dokie\1")
- (0.04 ":dummy!~u@2jv6nwu4af69s.irc PRIVMSG #mine :\1ACTION out\1"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 12 Mar 2023 02:30:29 UTC")
- (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
- (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0.00 ":irc.foonet.org 254 tester 1 :channels formed")
- (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.00 ":irc.foonet.org 375 tester :- irc.foonet.org Message of the day - ")
- (0.00 ":irc.foonet.org 372 tester :- This is the default Ergo MOTD.")
- (0.01 ":irc.foonet.org 372 tester :- ")
- (0.02 ":irc.foonet.org 372 tester :- For more information on using these, see MOTDFORMATTING.md")
- (0.00 ":irc.foonet.org 376 tester :End of MOTD command"))
-
-((mode-tester 10 "MODE tester +i")
- (0.00 ":irc.foonet.org 221 tester +i")
- (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")
- (0.05 ":irc.foonet.org 221 tester +i"))
-
-((join-spam 10 "JOIN #ascii")
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #ascii")
- (0 ":irc.foonet.org 353 tester = #ascii :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #ascii :End of NAMES list"))
-
-((mode-spam 10 "MODE #ascii")
- (0 ":irc.foonet.org 324 tester #ascii +nt")
- (0 ":irc.foonet.org 329 tester #ascii 1620104779")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #ascii :tester, welcome!")
- (0.0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #ascii :tester, welcome!"))
-
-((privmsg 10 "PRIVMSG #ascii :twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters 12345678"))
-((privmsg 10 "PRIVMSG #ascii :twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters "))
-((privmsg 10 "PRIVMSG #ascii :123456789"))
-((privmsg 10 "PRIVMSG #ascii :xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"))
-((privmsg 10 "PRIVMSG #ascii :yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy"))
-((privmsg 10 "PRIVMSG #ascii :z"))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.07 ":tester!~u@h3f95zveyc38a.irc QUIT :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)")
- (0.01 "ERROR :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 12 Mar 2023 02:30:29 UTC")
- (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
- (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0.00 ":irc.foonet.org 254 tester 1 :channels formed")
- (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.00 ":irc.foonet.org 375 tester :- irc.foonet.org Message of the day - ")
- (0.00 ":irc.foonet.org 372 tester :- This is the default Ergo MOTD.")
- (0.01 ":irc.foonet.org 372 tester :- ")
- (0.02 ":irc.foonet.org 372 tester :- For more information on using these, see MOTDFORMATTING.md")
- (0.00 ":irc.foonet.org 376 tester :End of MOTD command"))
-
-((mode-tester 10 "MODE tester +i")
- (0.00 ":irc.foonet.org 221 tester +i")
- (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")
- (0.05 ":irc.foonet.org 221 tester +i"))
-
-((join-chan 6 "JOIN #koi8")
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #koi8")
- (0 ":irc.foonet.org 353 tester = #koi8 :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #koi8 :End of NAMES list"))
-
-((mode-chan 8 "MODE #koi8")
- (0 ":irc.foonet.org 324 tester #koi8 +nt")
- (0 ":irc.foonet.org 329 tester #koi8 1620104779")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #koi8 :tester, welcome!")
- (0.0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #koi8 :tester, welcome!")
- (0.0 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #koi8 :\313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317"))
-
-((privmsg 10 "PRIVMSG #koi8 :\313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317"))
-((privmsg 10 "PRIVMSG #koi8 :\313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \302\325\304\305\324 "))
-((privmsg 10 "PRIVMSG #koi8 :\322\301\332\322\331\327 \323\324\322\317\313\311 \316\305\320\317\316\321\324\316\317 \307\304\305"))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.07 ":tester!~u@h3f95zveyc38a.irc QUIT :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)")
- (0.01 "ERROR :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0.13 ":soju.im 001 tester :Welcome to soju, tester")
- (0.0 ":soju.im 002 tester :Your host is soju.im")
- (0.0 ":soju.im 004 tester soju.im soju aiwroO OovaimnqpsrtklbeI")
- (0.0 ":soju.im 005 tester CHATHISTORY=1000 CASEMAPPING=ascii NETWORK=Soju :are supported")
- (0.0 ":soju.im 422 tester :No MOTD"))
-
-((mode 10 "MODE tester +i")
- (0.0 ":tester!tester@10.0.2.100 JOIN #chan/foonet")
- (0.25 ":soju.im 331 tester #chan/foonet :No topic is set")
- (0.0 ":soju.im 353 tester = #chan/foonet :@bob/foonet alice/foonet tester")
- (0.01 ":soju.im 366 tester #chan/foonet :End of /NAMES list")
- (0.0 ":tester!tester@10.0.2.100 JOIN #chan/barnet")
- (0.04 ":soju.im 331 tester #chan/barnet :No topic is set")
- (0.0 ":soju.im 353 tester = #chan/barnet :tester @mike/barnet joe/barnet")
- (0.01 ":soju.im 366 tester #chan/barnet :End of /NAMES list")
- (0.01 ":bob/foonet PRIVMSG #chan/foonet :alice: Then this breaking of his has been but a try for his friends.")
- (0.16 ":alice/foonet PRIVMSG #chan/foonet :bob: By my troth, I take my young lord to be a very melancholy man.")
- (0.91 ":bob/foonet PRIVMSG #chan/foonet :alice: No, truly, for the truest poetry is the most feigning; and lovers are given to poetry, and what they swear in poetry may be said as lovers they do feign.")
- (0.01 ":alice/foonet PRIVMSG #chan/foonet :bob: Sir, his wife some two months since fled from his house: her pretence is a pilgrimage to Saint Jaques le Grand; which holy undertaking with most austere sanctimony she accomplished; and, there residing, the tenderness of her nature became as a prey to her grief; in fine, made a groan of her last breath, and now she sings in heaven.")
- (0.0 ":mike/barnet PRIVMSG #chan/barnet :joe: Who ? not the duke ? yes, your beggar of fifty, and his use was to put a ducat in her clack-dish; the duke had crotchets in him. He would be drunk too; that let me inform you.")
- (0.01 ":joe/barnet PRIVMSG #chan/barnet :mike: Prove it before these varlets here, thou honourable man, prove it.")
- (0.0 ":mike/barnet PRIVMSG #chan/barnet :joe: That my report is just and full of truth.")
- (0.0 ":joe/barnet PRIVMSG #chan/barnet :mike: It is impossible they bear it out.")
- ;; Expected, since we blindly send +i
- (0.0 ":soju.im 501 tester :Cannot change user mode in multi-upstream mode"))
-
-((~mode-foonet 5 "MODE #chan/foonet")
- (0.0 ":soju.im 324 tester #chan/foonet +nt")
- (0.16 ":soju.im 329 tester #chan/foonet 1647158643")
- ;; Start frantic pinging
- (0.0 "PING :soju-msgid-1"))
-
-((~mode-barnet 5 "MODE #chan/barnet")
- (0.0 ":soju.im 324 tester #chan/barnet +nt")
- (0.0 ":soju.im 329 tester #chan/barnet 1647158643"))
-
-((pong-1 5 "PONG :soju-msgid-1")
- (0.0 ":bob/foonet!~u@g56t7uz8xjj4e.irc PRIVMSG #chan/foonet :alice: The king's coming; I know by his trumpets. Sirrah, inquire further after me; I had talk of you last night: though you are a fool and a knave, you shall eat: go to, follow.")
- (0.0 ":mike/barnet!~u@qsidzk5cytcai.irc PRIVMSG #chan/barnet :joe: Up: so. How is 't ? Feel you your legs ? You stand.")
- (0.0 ":alice/foonet!~u@g56t7uz8xjj4e.irc PRIVMSG #chan/foonet :bob: Consider then we come but in despite.")
- (0.1 "PING :soju-msgid-2"))
-
-((pong-2 2 "PONG :soju-msgid-2")
- (0.1 ":joe/barnet!~u@qsidzk5cytcai.irc PRIVMSG #chan/barnet :mike: All hail, Macbeth! that shalt be king hereafter.")
- (0.1 "PING :soju-msgid-3"))
-
-((pong-3 2 "PONG :soju-msgid-3")
- (0.1 ":bob/foonet!~u@g56t7uz8xjj4e.irc PRIVMSG #chan/foonet :alice: And that at my bidding you could so stand up.")
- (0.1 "PING :soju-msgid-4"))
-
-((pong-4 2 "PONG :soju-msgid-4")
- (0.03 ":mike/barnet!~u@qsidzk5cytcai.irc PRIVMSG #chan/barnet :joe: Now he tells how she plucked him to my chamber. O! I see that nose of yours, but not the dog I shall throw it to.")
- (0.1 "PING :soju-msgid-5"))
-
-((pong-5 2 "PONG :soju-msgid-5")
- (0.1 ":alice/foonet!~u@g56t7uz8xjj4e.irc PRIVMSG #chan/foonet :bob: For policy sits above conscience.")
- (0.1 "PING :soju-msgid-6"))
-
-((pong-6 2 "PONG :soju-msgid-6")
- (0.0 ":joe/barnet!~u@qsidzk5cytcai.irc PRIVMSG #chan/barnet :mike: Take heed o' the foul fiend. Obey thy parents; keep thy word justly; swear not; commit not with man's sworn spouse; set not thy sweet heart on proud array. Tom's a-cold.")
- (0.1 "PING :soju-msgid-7"))
-
-((pong-7 2 "PONG :soju-msgid-7")
- (0.08 ":mike/barnet!~u@qsidzk5cytcai.irc PRIVMSG #chan/barnet :joe: To suffer with him. Good love, call him back.")
- (0.1 "PING :soju-msgid-8"))
-
-((pong-9 2 "PONG :soju-msgid-8")
- (0.1 ":bob/foonet!~u@g56t7uz8xjj4e.irc PRIVMSG #chan/foonet :alice: Be not obdurate, open thy deaf ears.")
- (0.0 "PING :soju-msgid-9"))
-
-((pong-10 2 "PONG :soju-msgid-9")
- (0.04 ":joe/barnet!~u@qsidzk5cytcai.irc PRIVMSG #chan/barnet :mike: To get good guard and go along with me.")
- (0.1 "PING :soju-msgid-10"))
-
-((~privmsg 2 "PRIVMSG #chan/foonet :alice: hi")
- (0.1 ":alice/foonet!~u@g56t7uz8xjj4e.irc PRIVMSG #chan/foonet :tester: Good, very good; it is so then: good, very good. Let it be concealed awhile."))
-
-((pong-11 2 "PONG :soju-msgid-10")
- (0.1 ":alice/foonet!~u@g56t7uz8xjj4e.irc PRIVMSG #chan/foonet :bob: Some man or other must present Wall; and let him have some plaster, or some loam, or some rough-cast about him, to signify wall; and let him hold his fingers thus, and through that cranny shall Pyramus and Thisby whisper.")
- (0.0 "PING :soju-msgid-11"))
-
-((pong-12 5 "PONG :soju-msgid-11")
- (0.1 ":mike/barnet!~u@qsidzk5cytcai.irc PRIVMSG #chan/barnet :joe: That's he that was Othello; here I am."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 12 Mar 2023 02:30:29 UTC")
- (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
- (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0.00 ":irc.foonet.org 254 tester 1 :channels formed")
- (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.00 ":irc.foonet.org 375 tester :- irc.foonet.org Message of the day - ")
- (0.00 ":irc.foonet.org 372 tester :- This is the default Ergo MOTD.")
- (0.01 ":irc.foonet.org 372 tester :- ")
- (0.02 ":irc.foonet.org 372 tester :- For more information on using these, see MOTDFORMATTING.md")
- (0.00 ":irc.foonet.org 376 tester :End of MOTD command"))
-
-((mode-tester 10 "MODE tester +i")
- (0.00 ":irc.foonet.org 221 tester +i")
- (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")
- (0.05 ":irc.foonet.org 221 tester +i"))
-
-((join-spam 10 "JOIN #utf-8")
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #utf-8")
- (0 ":irc.foonet.org 353 tester = #utf-8 :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #utf-8 :End of NAMES list"))
-
-((mode-spam 10 "MODE #utf-8")
- (0 ":irc.foonet.org 324 tester #utf-8 +nt")
- (0 ":irc.foonet.org 329 tester #utf-8 1620104779")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #utf-8 :tester, welcome!")
- (0.0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #utf-8 :tester, welcome!"))
-
-((privmsg-a 10 "PRIVMSG #utf-8 :\320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 "))
-((privmsg-b 10 "PRIVMSG #utf-8 :\320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\261\321\203\320\264\320\265\321\202 \321\200\320\260\320\267\321\200\321\213\320\262 \321\201\321\202\321\200\320\276\320\272\320\270 \320\275\320\265\320\277\320\276\320\275\321\217\321\202\320\275\320\276 \320\263\320\264\320\265 \320\261\321\203\320\264\320\265\321\202 "))
-((privmsg-c 10 "PRIVMSG #utf-8 :\321\200\320\260\320\267\321\200\321\213\320\262 \321\201\321\202\321\200\320\276\320\272\320\270 \320\275\320\265\320\277\320\276\320\275\321\217\321\202\320\275\320\276 \320\263\320\264\320\265")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #utf-8 :alice: Entirely honour; I would not be delay'd."))
-
-((privmsg-g 10 "PRIVMSG #utf-8 :\350\251\261\350\252\252\345\244\251\344\270\213\345\244\247\345\213\242\357\274\214\345\210\206\344\271\205\345\277\205\345\220\210\357\274\214\345\220\210\344\271\205\345\277\205\345\210\206\357\274\232\345\221\250\346\234\253\344\270\203\345\234\213\345\210\206\347\210\255\357\274\214\345\271\266\345\205\245\346\226\274\347\247\246\343\200\202\345\217\212\347\247\246\346\273\205\344\271\213\345\276\214\357\274\214\346\245\232\343\200\201\346\274\242\345\210\206\347\210\255\357\274\214\345\217\210\345\271\266\345\205\245\346\226\274\346\274\242\343\200\202\346\274\242\346\234\235\350\207\252\351\253\230\347\245\226\346\226\254\347\231\275\350\233\207\350\200\214\350\265\267\347\276\251\357\274\214\344\270\200\347\265\261\345\244\251\344\270\213\343\200\202\345\276\214\344\276\206\345\205\211\346\255\246\344\270\255\350\210\210\357\274\214\345\202\263\350\207\263\347\215\273\345\270\235\357\274\214\351\201\202\345\210\206\347\202\272\344\270\211\345\234\213\343\200\202\346\216\250\345\205\266\350\207\264\344\272\202\344\271\213\347\224\261\357\274\214\346\256\206\345\247\213\346\226\274\346\241\223\343\200\201\351\235\210\344\272\214\345\270\235\343\200\202\346\241\223\345\270\235\347\246\201\351\214\256\345\226\204\351\241\236\357\274\214\345\264\207\344\277\241\345\256\246\345\256\230\343\200\202\345\217\212\346\241\223\345\270\235\345\264\251\357\274\214\351\235\210\345\270\235\345\215\263\344\275\215\357\274\214\345\244\247\345\260\207\350\273\215\347\253\207\346\255\246\343\200\201\345\244\252\345\202\205\351\231\263\350\225\203\357\274\214\345\205\261\347\233\270\350\274\224\344\275\220\343\200\202\346\231\202\346\234\211\345\256\246\345\256\230\346\233\271\347\257\200\347\255\211\345\274\204\346\254\212\357\274\214"))
-((privmsg-h 10 "PRIVMSG #utf-8 :\347\253\207\346\255\246\343\200\201\351\231\263\350\225\203\350\254\200\350\252\205\344\271\213\357\274\214\344\275\234\344\272\213\344\270\215\345\257\206\357\274\214\345\217\215\347\202\272\346\211\200\345\256\263\343\200\202\344\270\255\346\266\223\350\207\252\346\255\244\346\204\210\346\251\253")
- (0.0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #utf-8 :Shall seize this prey out of his father's hands."))
-
-((privmsg-d 10 "PRIVMSG #utf-8 :\320\261\321\203\320\264\320\265\321\202\302\240\321\200\320\260\320\267\321\200\321\213\320\262\302\240\321\201\321\202\321\200\320\276\320\272\320\270\302\240\320\275\320\265\320\277\320\276\320\275\321\217\321\202\320\275\320\276\302\240\320\263\320\264\320\265\360\237\217\201\360\237\232\251\360\237\216\214\360\237\217\264\360\237\217\263\357\270\217"))
-((privmsg-e 10 "PRIVMSG #utf-8 :\360\237\217\263\357\270\217\342\200\215\360\237\214\210\360\237\217\263\357\270\217\342\200\215\342\232\247\357\270\217\360\237\217\264\342\200\215\342\230\240\357\270\217"))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.07 ":tester!~u@h3f95zveyc38a.irc QUIT :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)")
- (0.01 "ERROR :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :barnet:changeme"))
-((nick 10 "NICK tester"))
-((user 0.2 "USER user 0 * :tester")
- (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
- (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.5.1-4860c5cad0179db1")
- (0 ":irc.barnet.org 003 tester :This server was created Fri, 19 Mar 2021 10:23:19 UTC")
- (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.5.1-4860c5cad0179db1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m INVEX KICKLEN=390 MAXLIST=beI:60 :are supported by this server")
- (0 ":irc.barnet.org 005 tester MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.barnet.org 251 tester :There are 0 users and 1 invisible on 1 server(s)")
- (0 ":irc.barnet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.barnet.org 254 tester 0 :channels formed")
- (0 ":irc.barnet.org 255 tester :I have 1 clients and 0 servers")
- (0 ":irc.barnet.org 265 tester 1 1 :Current local users 1, max 1")
- (0 ":irc.barnet.org 266 tester 1 1 :Current global users 1, max 1")
- (0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10.2 "MODE tester +i")
- ;; No mode answer
- (0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":tester!~u@8cgjyczyrjgby.irc JOIN #bar")
- (0 ":irc.barnet.org 353 tester = #bar :@mike joe tester")
- (0 ":irc.barnet.org 366 tester #bar :End of /NAMES list.")
- (0 ":***!znc@znc.in PRIVMSG #bar :Buffer Playback...")
- (0 ":joe!~u@8cgjyczyrjgby.irc PRIVMSG #bar :[10:23:28] tester, welcome!")
- (0 ":mike!~u@8cgjyczyrjgby.irc PRIVMSG #bar :[10:23:28] tester, welcome!")
- (0 ":joe!~u@8cgjyczyrjgby.irc PRIVMSG #bar :[10:24:49] mike: Bid me farewell, and let me hear thee going.")
- (0 ":mike!~u@8cgjyczyrjgby.irc PRIVMSG #bar :[10:24:54] joe: By heaven, thy love is black as ebony.")
- (0 ":***!znc@znc.in PRIVMSG #bar :Playback Complete.")
- (0 ":irc.barnet.org NOTICE tester :[10:23:22] 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 ":irc.barnet.org 305 tester :You are no longer marked as being away"))
-
-((mode 20 "MODE #bar")
- (0 ":irc.barnet.org 324 tester #bar +nt")
- (0 ":irc.barnet.org 329 tester #bar 1616149403")
- (0.1 ":mike!~u@8cgjyczyrjgby.irc PRIVMSG #bar :joe: To ask of whence you are: report it.")
- (0.1 ":joe!~u@8cgjyczyrjgby.irc PRIVMSG #bar :mike: Friar, thou knowest not the duke so well as I do: he's a better woodman than thou takest him for.")
- (0.1 ":mike!~u@8cgjyczyrjgby.irc PRIVMSG #bar :joe: Like the sequel, I. Signior Costard, adieu.")
- (0.1 ":joe!~u@8cgjyczyrjgby.irc PRIVMSG #bar :mike: This is his second fit; he had one yesterday."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((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")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10.2 "MODE tester +i")
- ;; 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 :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.")
- (0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :[07:02:44] alice: Why dost thou call them knaves ? thou know'st them not.")
- (0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :[07:03:05] bob: Now, by the faith of my love, I will: tell me where it is.")
- (0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :[07:03:09] alice: Give me the letter; I will look on it.")
- (0 ":***!znc@znc.in PRIVMSG #foo :Playback Complete.")
- (0 ":irc.foonet.org NOTICE tester :[11:29:00] 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 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-
-((mode 8 "MODE #foo")
- (0 ":irc.foonet.org 324 tester #foo +nt")
- (0 ":irc.foonet.org 329 tester #foo 1619593200")
- (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: By this hand, it will not kill a fly. But come, now I will be your Rosalind in a more coming-on disposition; and ask me what you will, I will grant it.")
- (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: That I must love a loathed enemy.")
- (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: His discretion, I am sure, cannot carry his valour, for the goose carries not the fox. It is well: leave it to his discretion, and let us listen to the moon.")
- (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: As living here and you no use of him."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 3 "PASS :" token ":changeme"))
-
-((fake 1 "FAKE no op"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((cap 10 "CAP REQ :sasl"))
-((nick 10 "NICK tester"))
-((user 10 "USER tester 0 * :tester"))
-
-((authenticate 5 "AUTHENTICATE PLAIN")
- (0.0 ":irc.foonet.org CAP * ACK sasl")
- (0.0 "AUTHENTICATE +"))
-
-((authenticate 5 "AUTHENTICATE AHRlc3RlcgBjaGFuZ2VtZQ==")
- (0.0 ":irc.foonet.org 900 * * tester :You are now logged in as tester")
- (0.01 ":irc.foonet.org 903 * :Authentication successful"))
-
-((cap 10 "CAP END")
- (0.0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.8.0")
- (0.2 ":irc.foonet.org 003 tester :This server was created Sun, 20 Nov 2022 23:10:36 UTC")
- (0.0 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0.0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0.0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0.0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0.0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0.0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0.0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0.0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.0 ":irc.foonet.org 422 tester :MOTD File is missing")
- (0.0 ":irc.foonet.org 221 tester +i")
- (0.0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((mode 10 "MODE tester +i")
- (0.02 ":irc.foonet.org 221 tester +i"))
-
-((join 10 "JOIN #chan")
- (0.00 ":tester!~u@u9iqi96sfwk9s.irc JOIN #chan")
- (0.06 ":irc.foonet.org 353 tester = #chan :@bob alice tester")
- (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.02 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :tester, welcome!")
- (0.01 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :tester, welcome!")
- (0.04 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :bob: Either your unparagoned mistress is dead, or she's outprized by a trifle."))
-
-((mode 12 "MODE #chan")
- (0.00 ":irc.foonet.org 324 tester #chan +nt")
- (0.02 ":irc.foonet.org 329 tester #chan 1668985854")
- (0.98 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :alice: Come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of ? Come me to what was done to her.")
- (0.01 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :bob: She is Lavinia, therefore must be lov'd."))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.02 ":tester!~u@u9iqi96sfwk9s.irc QUIT :Quit"))
-
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((cap 10 "CAP REQ :sasl"))
-((nick 10 "NICK tester`"))
-((user 10 "USER tester` 0 * :tester"))
-
-((authenticate 10 "AUTHENTICATE PLAIN")
- (0.0 ":irc.foonet.org CAP * ACK sasl")
- (0.0 "AUTHENTICATE +"))
-
-((authenticate 10 "AUTHENTICATE AHRlc3RlcgBjaGFuZ2VtZQ==")
- (0.00 ":irc.foonet.org 900 * * tester :You are now logged in as tester")
- (0.01 ":irc.foonet.org 903 * :Authentication successful"))
-
-((cap 10 "CAP END")
- (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.01 ":irc.foonet.org 003 tester :This server was created Sun, 20 Nov 2022 23:10:36 UTC")
- (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.13 ":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.03 ":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 3 invisible on 1 server(s)")
- (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0.00 ":irc.foonet.org 254 tester 1 :channels formed")
- (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.03 ":irc.foonet.org 422 tester :MOTD File is missing")
- (0.02 ":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."))
-
-((mode 10 "MODE tester +i")
- (0.0 ":irc.foonet.org 221 tester +i"))
-
-((join 10 "JOIN #chan")
- (0.00 ":tester!~u@u9iqi96sfwk9s.irc JOIN #chan")
- (0.09 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
- (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.00 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :tester, welcome!")
- (0.00 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :tester, welcome!")
- (0.03 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :bob: And both shall cease, without your remedy.")
- (0.02 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :alice: Nay, tarry; I'll go along with thee: I can tell thee pretty tales of the duke."))
-
-((mode 10 "MODE #chan")
- (0.00 ":irc.foonet.org 324 tester #chan +nt")
- (0.01 ":irc.foonet.org 329 tester #chan 1668985854")
- (0.03 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :bob: Do: I'll take the sacrament on't, how and which way you will.")
- (0.00 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :alice: Worthy Macbeth, we stay upon your leisure.")
- (0.00 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :bob: Well met; good morrow, Titus and Hortensius."))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.03 ":tester!~u@u9iqi96sfwk9s.irc QUIT :Quit"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER tester 0 * :tester")
- (0.0 ":irc.foonet.org 433 * tester :Nickname is reserved by a different account"))
-
-((nick 10 "NICK tester`")
- (0.01 ":irc.foonet.org FAIL NICK NICKNAME_RESERVED tester :Nickname is reserved by a different account")
- (0.06 ":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.01 ":irc.foonet.org 003 tester` :This server was created Sun, 20 Nov 2022 23:10:36 UTC")
- (0.01 ":irc.foonet.org 004 tester` irc.foonet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.01 ":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 3 invisible on 1 server(s)")
- (0.00 ":irc.foonet.org 252 tester` 0 :IRC Operators online")
- (0.02 ":irc.foonet.org 253 tester` 0 :unregistered connections")
- (0.00 ":irc.foonet.org 254 tester` 1 :channels formed")
- (0.00 ":irc.foonet.org 255 tester` :I have 3 clients and 0 servers")
- (0.00 ":irc.foonet.org 265 tester` 3 3 :Current local users 3, max 3")
- (0.00 ":irc.foonet.org 266 tester` 3 3 :Current global users 3, max 3")
- (0.00 ":irc.foonet.org 422 tester` :MOTD File is missing")
- (0.02 ":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."))
-
-((mode 12 "MODE tester` +i")
- (0.0 ":irc.foonet.org 221 tester` +i"))
-
-((join 10 "JOIN #chan")
- (0.00 ":tester`!~u@u9iqi96sfwk9s.irc JOIN #chan")
- (0.08 ":irc.foonet.org 353 tester` = #chan :@bob alice tester`")
- (0.01 ":irc.foonet.org 366 tester` #chan :End of NAMES list")
- (0.00 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :tester`, welcome!")
- (0.01 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :tester`, welcome!")
- (0.05 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :alice: And Jove, for your love, would infringe an oath."))
-
-((mode 10 "MODE #chan")
- (0.00 ":irc.foonet.org 324 tester` #chan +nt")
- (0.02 ":irc.foonet.org 329 tester` #chan 1668985854")
- (0.07 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :bob: To you that know them not. This to my mother.")
- (0.00 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :alice: Some enigma, some riddle: come, thy l'envoy; begin."))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.03 ":tester`!~u@u9iqi96sfwk9s.irc QUIT"))
-
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :changeme"))
-((nick 1 "NICK tester`"))
-((user 1 "USER tester 0 * :tester")
- (0.06 ":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.01 ":irc.foonet.org 003 tester` :This server was created Sun, 20 Nov 2022 23:10:36 UTC")
- (0.01 ":irc.foonet.org 004 tester` irc.foonet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.01 ":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 3 invisible on 1 server(s)")
- (0.00 ":irc.foonet.org 252 tester` 0 :IRC Operators online")
- (0.02 ":irc.foonet.org 253 tester` 0 :unregistered connections")
- (0.00 ":irc.foonet.org 254 tester` 1 :channels formed")
- (0.00 ":irc.foonet.org 255 tester` :I have 3 clients and 0 servers")
- (0.00 ":irc.foonet.org 265 tester` 3 3 :Current local users 3, max 3")
- (0.00 ":irc.foonet.org 266 tester` 3 3 :Current global users 3, max 3")
- (0.00 ":irc.foonet.org 422 tester` :MOTD File is missing")
- (0.02 ":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."))
-
-((mode 12 "MODE tester` +i")
- (0.0 ":irc.foonet.org 221 tester` +i"))
-
-((join 10 "JOIN #chan")
- (0.00 ":tester`!~u@u9iqi96sfwk9s.irc JOIN #chan")
- (0.08 ":irc.foonet.org 353 tester` = #chan :@bob alice tester`")
- (0.01 ":irc.foonet.org 366 tester` #chan :End of NAMES list")
- (0.00 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :tester`, welcome!")
- (0.01 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :tester`, welcome!")
- (0.05 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :alice: With pomp, with triumph, and with revelling."))
-
-((mode 10 "MODE #chan")
- (0.00 ":irc.foonet.org 324 tester` #chan +nt")
- (0.02 ":irc.foonet.org 329 tester` #chan 1668985854")
- (0.00 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :bob: No remedy, my lord, when walls are so wilful to hear without warning.")
- (0.01 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :alice: Let our reciprocal vows be remembered. You have many opportunities to cut him off; if your will want not, time and place will be fruitfully offered. There is nothing done if he return the conqueror; then am I the prisoner, and his bed my gaol; from the loathed warmth whereof deliver me, and supply the place for your labor."))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.03 ":tester`!~u@u9iqi96sfwk9s.irc QUIT :Quit"))
-
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "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 Mon, 31 May 2021 09:56:24 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 254 tester 2 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4")
- (0 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- ;; No mode answer
- (0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":tester!~u@gq7yjr7gsu7nn.irc JOIN #foo")
- (0 ":irc.foonet.org 353 tester = #foo :alice @bob rando tester")
- (0 ":irc.foonet.org 366 tester #foo :End of /NAMES list.")
- (0 ":***!znc@znc.in PRIVMSG #foo :Buffer Playback...")
- (0 ":alice!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :[10:00:02] bob: All that he is hath reference to your highness.")
- (0 ":bob!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :[10:00:06] alice: Excellent workman! Thou canst not paint a man so bad as is thyself.")
- (0 ":***!znc@znc.in PRIVMSG #foo :Playback Complete.")
- (0 ":irc.foonet.org NOTICE tester :[09:56:57] 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 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-
-((mode 5 "MODE #foo")
- (0 ":irc.foonet.org 324 tester #foo +nt")
- (0 ":irc.foonet.org 329 tester #foo 1622454985")
- ;; Invalid msg
- (0.1 ":rando!~u@em2i467d4ejul.irc PRIVMSG :")
- (0.1 ":alice!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :bob: Farewell, pretty lady: you must hold the credit of your father.")
- (0.1 ":bob!~u@gq7yjr7gsu7nn.irc NOTICE $* :[Global notice] going down soon.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Well, this is the forest of Arden.")
- (0.1 ":bob!~u@gq7yjr7gsu7nn.irc NOTICE $$* :[Global notice] this is a warning.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Be married under a bush, like a beggar ? Get you to church, and have a good priest that can tell you what marriage is: this fellow will but join you together as they join wainscot; then one of you will prove a shrunk panel, and like green timber, warp, warp.")
- (0.1 ":bob!~u@gq7yjr7gsu7nn.irc PRIVMSG $* :[Global msg] second warning.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: And will you, being a man of your breeding.")
- (0.1 ":bob!~u@gq7yjr7gsu7nn.irc NOTICE #* :[Global notice] final warning."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0.03 ":cadmium.libera.chat 001 tester :Welcome to the Libera.Chat Internet Relay Chat Network tester")
- (0.02 ":cadmium.libera.chat 002 tester :Your host is cadmium.libera.chat[103.196.37.95/6697], running version solanum-1.0-dev")
- (0.01 ":cadmium.libera.chat 003 tester :This server was created Wed Jan 25 2023 at 10:22:45 UTC")
- (0.01 ":cadmium.libera.chat 004 tester cadmium.libera.chat solanum-1.0-dev DGMQRSZaghilopsuwz CFILMPQRSTbcefgijklmnopqrstuvz bkloveqjfI")
- (0.00 ":cadmium.libera.chat 005 tester CALLERID=g WHOX ETRACE FNC SAFELIST ELIST=CMNTU KNOCK MONITOR=100 CHANTYPES=# EXCEPTS INVEX CHANMODES=eIbq,k,flj,CFLMPQRSTcgimnprstuz :are supported by this server")
- (0.01 ":cadmium.libera.chat 005 tester CHANLIMIT=#:250 PREFIX=(ov)@+ MAXLIST=bqeI:100 MODES=4 NETWORK=Libera.Chat STATUSMSG=@+ CASEMAPPING=rfc1459 NICKLEN=16 MAXNICKLEN=16 CHANNELLEN=50 TOPICLEN=390 DEAF=D :are supported by this server")
- (0.01 ":cadmium.libera.chat 005 tester TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,MONITOR: EXTBAN=$,ajrxz :are supported by this server")
- (0.01 ":cadmium.libera.chat 251 tester :There are 70 users and 42996 invisible on 28 servers")
- (0.02 ":cadmium.libera.chat 252 tester 38 :IRC Operators online")
- (0.01 ":cadmium.libera.chat 253 tester 57 :unknown connection(s)")
- (0.01 ":cadmium.libera.chat 254 tester 22912 :channels formed")
- (0.01 ":cadmium.libera.chat 255 tester :I have 2499 clients and 1 servers")
- (0.01 ":cadmium.libera.chat 265 tester 2499 4187 :Current local users 2499, max 4187")
- (0.01 ":cadmium.libera.chat 266 tester 43066 51827 :Current global users 43066, max 51827")
- (0.01 ":cadmium.libera.chat 250 tester :Highest connection count: 4188 (4187 clients) (319420 connections received)")
- (0.01 ":cadmium.libera.chat 375 tester :- cadmium.libera.chat Message of the Day - ")
- (0.01 ":cadmium.libera.chat 372 tester :- This server kindly provided by Mach Dilemma (www.m-d.net)")
- (0.01 ":cadmium.libera.chat 372 tester :- Welcome to Libera Chat, the IRC network for")
- (0.00 ":cadmium.libera.chat 372 tester :- Email: support@libera.chat")
- (0.00 ":cadmium.libera.chat 376 tester :End of /MOTD command.")
- (0.00 ":tester MODE tester :+Ziw"))
-
-((mode-tester 10 "MODE tester +i"))
-
-((join-chan 10 "JOIN #chan")
- (0.09 ":tester!~tester@127.0.0.1 JOIN #chan"))
-
-((mode-chan 10 "MODE #chan")
- (0.03 ":cadmium.libera.chat 353 tester = #chan :tester @Chad dummy")
- (0.02 ":cadmium.libera.chat 366 tester #chan :End of /NAMES list.")
- (0.00 ":cadmium.libera.chat 324 tester #chan +nt")
- (0.01 ":cadmium.libera.chat 329 tester #chan 1621432263"))
-
-((privmsg-before 10 "PRIVMSG #chan :ready before")
- (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan before")
- (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +Qu"))
-
-((privmsg-key 10 "PRIVMSG #chan :ready key")
- (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan :doing key")
- (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +k hunter2"))
-
-((privmsg-limit 10 "PRIVMSG #chan :ready limit")
- (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan :doing limit")
- (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +l 3"))
-
-((privmsg-drop 10 "PRIVMSG #chan :ready drop")
- (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan dropping")
- (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan -lu")
- (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan -Qk *")
- (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan after"))
-
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER tester 0 * :unknown")
- (0.00 ":irc.example.net NOTICE * :*** Looking up your hostname...")
- (0.00 ":irc.example.net NOTICE tester :*** Could not resolve your hostname: Domain not found; using your IP address (10.0.2.100) instead.")
- (0.09 ":irc.example.net 001 tester :Welcome to the foonet IRC Network tester!tester@10.0.2.100")
- (0.01 ":irc.example.net 002 tester :Your host is irc.example.net, running version InspIRCd-3")
- (0.01 ":irc.example.net 003 tester :This server was created 07:50:59 Jan 22 2024")
- (0.03 ":irc.example.net 004 tester irc.example.net InspIRCd-3 BIRcgikorsw ACHIKMORTVXabcefghijklmnopqrstvyz :HIVXabefghjkloqvy")
- (0.00 ":irc.example.net 005 tester ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=ascii CHANLIMIT=#:20 CHANMODES=IXbeg,k,Hfjl,ACKMORTcimnprstz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server")
- (0.01 ":irc.example.net 005 tester EXTBAN=,ACORTUacjrwz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=foonet :are supported by this server")
- (0.01 ":irc.example.net 005 tester NICKLEN=30 PREFIX=(yqaohvV)!~&@%+- SAFELIST SILENCE=32 STATUSMSG=!~&@%+- TOPICLEN=307 UHNAMES USERIP USERLEN=10 USERMODES=,,s,BIRcgikorw WHOX :are supported by this server")
- (0.01 ":irc.example.net 251 tester :There are 2 users and 2 invisible on 2 servers")
- (0.00 ":irc.example.net 252 tester 1 :operator(s) online")
- (0.00 ":irc.example.net 253 tester 1 :unknown connections")
- (0.00 ":irc.example.net 254 tester 2 :channels formed")
- (0.00 ":irc.example.net 255 tester :I have 4 clients and 1 servers")
- (0.00 ":irc.example.net 265 tester :Current local users: 4 Max: 5")
- (0.00 ":irc.example.net 266 tester :Current global users: 4 Max: 5")
- (0.00 ":irc.example.net 375 tester :irc.example.net message of the day")
- (0.00 ":irc.example.net 372 tester : https://github.com/inspircd/inspircd-docker/issues")
- (0.00 ":irc.example.net 372 tester : ")
- (0.00 ":irc.example.net 372 tester : Have fun with the image!")
- (0.00 ":irc.example.net 376 tester :End of message of the day.")
- (0.00 ":irc.example.net 501 tester x :is not a recognised user mode.")
- (0.00 ":NickServ!NickServ@services.int NOTICE tester :Welcome to foonet, tester! Here on foonet, we provide services to enable the registration of nicknames and channels! For details, type \2/msg NickServ help\2 and \2/msg ChanServ help\2."))
-
-((mode 10 "MODE tester +i")
- (0.01 ":tester!tester@10.0.2.100 MODE tester :+i"))
-
-((join 10 "JOIN #chan")
- (0.02 ":tester!tester@10.0.2.100 JOIN :#chan")
- (0.02 ":irc.example.net 353 tester = #chan :+alice @fsbot -bob !foop tester")
- (0.03 ":irc.example.net 366 tester #chan :End of /NAMES list.")
- (0.00 ":bob!bob@localhost PRIVMSG #chan :tester, welcome!")
- (0.01 ":alice!alice@localhost PRIVMSG #chan :tester, welcome!"))
-
-((mode-chan 10 "MODE #chan")
- (0.00 ":irc.example.net 324 tester #chan :+nt")
- (0.01 ":irc.example.net 329 tester #chan :1705909863")
- (0.03 ":bob!bob@localhost PRIVMSG #chan :alice: Of that which hath so faithfully been paid.")
- (0.03 ":alice!alice@localhost PRIVMSG #chan :Hie you, make haste, for it grows very late.")
- (0.03 ":foop!user@netadmin.example.net PRIVMSG #chan :hi")
- ;; (0.07 ":alice!alice@localhost PRIVMSG #chan :bob: And make a clear way to the gods.")
- ;; (0.04 ":bob!bob@localhost PRIVMSG #chan :Why, that they have; and bid them so be gone.")
- ;; (0.08 ":bob!bob@localhost PRIVMSG #chan :alice: Now stay your strife: what shall be is dispatch'd.")
- (0.06 ":foop!user@netadmin.example.net MODE #chan +v :bob")
- (0.05 ":bob!bob@localhost PRIVMSG #chan :alice: Fair as a text B in a copy-book.")
- (0.07 ":alice!alice@localhost PRIVMSG #chan :bob: Even as Apemantus does now; hate a lord with my heart.")
- (0.03 ":bob!bob@localhost PRIVMSG #chan :Then here is a supplication for you. And when you come to him, at the first approach you must kneel; then kiss his foot; then deliver up your pigeons; and then look for your reward. I'll be at hand, sir; see you do it bravely.")
- (0.05 ":foop!user@netadmin.example.net MODE #chan -v :bob")
- (0.04 ":bob!bob@localhost PRIVMSG #chan :alice: That's the way: for women are light at midnight.")
- (0.04 ":alice!alice@localhost PRIVMSG #chan :Give it the beasts, to be rid of the men.")
- ;; (0.02 ":alice!alice@localhost PRIVMSG #chan :bob: Here comes young Master Ganymede, my new mistress's brother.")
- )
-
-((who-chan 10 "who #chan")
- (0.03 ":irc.example.net 352 tester #chan alice localhost irc.example.net alice H+ :0 Irc bot based on irc3 http://irc3.readthedocs.io")
- (0.03 ":irc.example.net 352 tester #chan fsbot localhost irc.example.net fsbot H@ :0 fsbot")
- (0.01 ":irc.example.net 352 tester #chan bob localhost irc.example.net bob H- :0 Irc bot based on irc3 http://irc3.readthedocs.io")
- (0.01 ":irc.example.net 352 tester #chan user netadmin.example.net irc.example.net foop H*! :0 unknown")
- (0.01 ":irc.example.net 352 tester #chan tester 10.0.2.100 irc.example.net tester H :0 unknown")
- (0.01 ":irc.example.net 315 tester #chan :End of /WHO list.")
- ;; (0.09 ":bob!bob@localhost PRIVMSG #chan :alice: Shall nothing wrong him. Thus it is, general.")
- ;; (0.04 ":alice!alice@localhost PRIVMSG #chan :bob: His father and I were soldiers together; to whom I have been often bound for no less than my life. Here comes the Briton: let him be so entertained amongst you as suits, with gentlemen of your knowing, to a stranger of his quality.")
- (0.04 ":bob!bob@localhost PRIVMSG #chan :alice: Remains in danger of her former tooth."))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.03 "ERROR :Closing link: (tester@10.0.2.100) [Quit: \2ERC\2 5.x (IRC client for GNU Emacs)]"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :barnet:changeme"))
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
- (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.barnet.org 003 tester :This server was created Wed, 12 May 2021 07:41:08 UTC")
- (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.barnet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.barnet.org 254 tester 1 :channels formed")
- (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- ;; No mode answer ^
-
- (0 ":tester!~u@xrir8fpe4d7ak.irc JOIN #chan")
- (0 ":irc.barnet.org 353 tester = #chan :joe @mike tester")
- (0 ":irc.barnet.org 366 tester #chan :End of /NAMES list.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...")
- (0 ":joe!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :[07:04:25] mike: Belike, for joy the emperor hath a son.")
- (0 ":mike!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :[07:04:27] joe: Protest their first of manhood.")
- (0 ":joe!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :[07:04:29] mike: As frozen water to a starved snake.")
- (0 ":mike!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :[07:04:34] joe: My mirth it much displeas'd, but pleas'd my woe.")
- (0 ":joe!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :[07:04:38] mike: Why, Marcus, no man should be mad but I.")
- (0 ":mike!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :[07:04:44] joe: Faith, I have heard too much, for your words and performances are no kin together.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.")
- (0 ":irc.barnet.org NOTICE tester :[07:00:01] 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 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":irc.barnet.org 305 tester :You are no longer marked as being away"))
-
-((~join 10 "JOIN #chan"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.barnet.org 324 tester #chan +nt")
- (0 ":irc.barnet.org 329 tester #chan 1620805269")
- (0.1 ":joe!~u@svpn88yjcdj42.irc PRIVMSG #chan :mike: But, in defense, by mercy, 'tis most just.")
- (0.1 ":mike!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :joe: The Marshal of France, Monsieur la Far.")
- (0.1 ":joe!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :mike: And bide the penance of each three years' day.")
- (0.1 ":mike!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :joe: Madam, within; but never man so chang'd.")
- (0.1 ":joe!~u@xrir8fpe4d7ak.irc PRIVMSG #chan :mike: As much in private, and I'll bid adieu."))
-
-((linger 10 LINGER))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :barnet:changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
- (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.barnet.org 003 tester :This server was created Wed, 12 May 2021 07:41:08 UTC")
- (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.barnet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.barnet.org 254 tester 1 :channels formed")
- (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10.2 "MODE tester +i")
- ;; No mode answer ^
- (0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":irc.barnet.org 305 tester :You are no longer marked as being away"))
-
-((join 10 "JOIN #chan")
- (0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan")
- (0 ":irc.barnet.org 353 tester = #chan :@joe mike tester")
- (0 ":irc.barnet.org 366 tester #chan :End of NAMES list")
- (0.1 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :tester, welcome!")
- (0 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :tester, welcome!"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.barnet.org 324 tester #chan +nt")
- (0 ":irc.barnet.org 329 tester #chan 1620805269")
- (0.1 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: But you have outfaced them all.")
- (0.1 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: Why, will shall break it; will, and nothing else.")
- (0.1 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: Yes, a dozen; and as many to the vantage, as would store the world they played for.")
- (0.05 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: As he regards his aged father's life.")
- (0.05 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonor in doing it."))
-
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :barnet:changeme"))
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
- (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.barnet.org 003 tester :This server was created Wed, 12 May 2021 07:41:08 UTC")
- (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.barnet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.barnet.org 254 tester 1 :channels formed")
- (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- ;; No mode answer ^
- (0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":irc.barnet.org 305 tester :You are no longer marked as being away"))
-
-((join 10 "JOIN #chan")
- (0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan")
- (0 ":irc.barnet.org 353 tester = #chan :@joe mike tester")
- (0 ":irc.barnet.org 366 tester #chan :End of NAMES list")
- (0.1 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :tester, welcome!")
- (0 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :tester, welcome!"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.barnet.org 324 tester #chan +nt")
- (0 ":irc.barnet.org 329 tester #chan 1620805269")
- (0.1 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: But you have outfaced them all.")
- (0.1 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: Why, will shall break it; will, and nothing else.")
- (0.1 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: Yes, a dozen; and as many to the vantage, as would store the world they played for.")
- (0.05 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: As he regards his aged father's life.")
- (0.05 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonor in doing it."))
-
-((linger 2 LINGER))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((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 Wed, 12 May 2021 07:41:09 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- ;; No mode answer ^
- (0 ":tester!~u@nvfhxvqm92rm6.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :alice @bob tester")
- (0 ":irc.foonet.org 366 tester #chan :End of /NAMES list.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...")
- (0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:02] alice: Here come the lovers, full of joy and mirth.")
- (0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:07] bob: According to the fool's bolt, sir, and such dulcet diseases.")
- (0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:10] alice: And hang himself. I pray you, do my greeting.")
- (0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:18] bob: And you sat smiling at his cruel prey.")
- (0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:21] alice: Or never after look me in the face.")
- (0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:25] bob: If that may be, than all is well. Come, sit down, every mother's son, and rehearse your parts. Pyramus, you begin: when you have spoken your speech, enter into that brake; and so every one according to his cue.")
- (0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:30] alice: Where I espied the panther fast asleep.")
- (0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:32] bob: Alas! he is too young: yet he looks successfully.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.")
-
- (0 ":irc.foonet.org NOTICE tester :[07:00:32] 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 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-
-((~join 10 "JOIN #chan"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620805271")
- (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :bob: Grows, lives, and dies, in single blessedness.")
- (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :alice: For these two hours, Rosalind, I will leave thee.")
- (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :bob: By this hand, it will not kill a fly. But come, now I will be your Rosalind in a more coming-on disposition; and ask me what you will, I will grant it.")
- (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :alice: That I must love a loathed enemy.")
- (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :bob: As't please your lordship: I'll leave you."))
-
-((linger 10 LINGER))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :foonet:changeme"))
-((nick 1 "NICK tester"))
-((user 1 "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 Wed, 12 May 2021 07:41:09 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10.2 "MODE tester +i")
- ;; No mode answer ^
- (0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-
-((join 10 "JOIN #chan")
- (0 ":tester!~u@ertp7idh9jtgi.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :@alice bob tester")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :tester, welcome!")
- (0 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :tester, welcome!"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620805271")
- (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: He cannot be heard of. Out of doubt he is transported.")
- (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: More evident than this; for this was stol'n.")
- (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: Sell when you can; you are not for all markets.")
- (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: There's the fool hangs on your back already.")
- (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: Why, if you have a stomach to't, monsieur, if you think your mystery in stratagem can bring this instrument of honor again into its native quarter, be magnanimous in the enterprise and go on; I will grace the attempt for a worthy exploit: if you speed well in it, the duke shall both speak of it, and extend to you what further becomes his greatness, even to the utmost syllable of your worthiness.")
- (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: For he hath still been tried a holy man.")
- (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: To have the touches dearest priz'd.")
- (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: And must advise the emperor for his good.")
- (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: Orlando, my liege; the youngest son of Sir Rowland de Boys.")
- (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: The ape is dead, and I must conjure him."))
-
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((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 Wed, 12 May 2021 07:41:09 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- ;; No mode answer ^
- (0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-
-((join 10 "JOIN #chan")
- (0 ":tester!~u@ertp7idh9jtgi.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :@alice bob tester")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :tester, welcome!")
- (0 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :tester, welcome!"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620805271")
- (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: He cannot be heard of. Out of doubt he is transported.")
- (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: More evident than this; for this was stol'n.")
- (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: Sell when you can; you are not for all markets.")
- (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: There's the fool hangs on your back already.")
- (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: Why, if you have a stomach to't, monsieur, if you think your mystery in stratagem can bring this instrument of honor again into its native quarter, be magnanimous in the enterprise and go on; I will grace the attempt for a worthy exploit: if you speed well in it, the duke shall both speak of it, and extend to you what further becomes his greatness, even to the utmost syllable of your worthiness.")
- (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: For he hath still been tried a holy man.")
- (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: To have the touches dearest priz'd.")
- (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: And must advise the emperor for his good.")
- (0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: Orlando, my liege; the youngest son of Sir Rowland de Boys.")
- (0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: The ape is dead, and I must conjure him."))
-
-((linger 2 LINGER))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :" token ":changeme"))
-
-((fake 1 "FAKE no op"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :changeme"))
-((nick 1 "NICK chester"))
-((user 1 "USER user 0 * :chester")
- (0 ":irc.foonet.org 001 chester :Welcome to the foonet IRC Network chester")
- (0 ":irc.foonet.org 002 chester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.foonet.org 003 chester :This server was created Sun, 13 Jun 2021 05:45:20 UTC")
- (0 ":irc.foonet.org 004 chester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 chester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 chester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 chester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 chester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 chester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 chester 1 :unregistered connections")
- (0 ":irc.foonet.org 254 chester 1 :channels formed")
- (0 ":irc.foonet.org 255 chester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 chester 3 4 :Current local users 3, max 4")
- (0 ":irc.foonet.org 266 chester 3 4 :Current global users 3, max 4")
- (0 ":irc.foonet.org 422 chester :MOTD File is missing"))
-
-((mode-user 10.2 "MODE chester +i")
- (0 ":irc.foonet.org 221 chester +i")
- (0 ":irc.foonet.org NOTICE chester :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."))
-
-((join 14 "JOIN #chan")
- (0 ":chester!~u@yuvqisyu7m7qs.irc JOIN #chan")
- (0 ":irc.foonet.org 353 chester = #chan :tester chester @alice bob")
- (0 ":irc.foonet.org 366 chester #chan :End of NAMES list"))
-
-((mode 10 "MODE #chan")
- (0.0 ":irc.foonet.org 324 chester #chan +nt")
- (0.0 ":irc.foonet.org 329 chester #chan 1623563121")
- (0.0 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :chester, welcome!")
- (0.0 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :chester, welcome!")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :alice: That ever eye with sight made heart lament.")
- (0.1 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :bob: The bitter past, more welcome is the sweet.")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :alice: Dispatch, I say, and find the forester.")
- (0.1 ":tester!~u@yuvqisyu7m7qs.irc PRIVMSG #chan :chester: hi")
- (0.1 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :bob: This was lofty! Now name the rest of the players. This is Ercles' vein, a tyrant's vein; a lover is more condoling."))
-
-((privmsg 4 "PRIVMSG #chan :hi tester")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :alice: As the ox hath his bow, sir, the horse his curb, and the falcon her bells, so man hath his desires; and as pigeons bill, so wedlock would be nibbling.")
- (0.1 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :bob: Most friendship is feigning, most loving mere folly.")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :alice: To employ you towards this Roman. Come, our queen."))
-
-((quit 5 "QUIT :" quit)
- (0.0 ":tester!~u@yuvqisyu7m7qs.irc QUIT :Quit: " quit)
- (0.0 ":chester!~u@yuvqisyu7m7qs.irc QUIT :Quit: " quit))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "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, 13 Jun 2021 05:45:20 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4")
- (0 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10.2 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((join 15 "JOIN #chan")
- (0 ":tester!~u@yuvqisyu7m7qs.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :tester @alice bob")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-
-((mode 10 "MODE #chan")
- (0.0 ":irc.foonet.org 324 tester #chan +nt")
- (0.0 ":irc.foonet.org 329 tester #chan 1623563121")
- (0.0 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :tester, welcome!")
- (0.0 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :tester, welcome!")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :alice: Marry, that, I think, be young Petruchio.")
- (0.4 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :bob: You speak of him when he was less furnished than now he is with that which makes him both without and within.")
- (0.2 ":chester!~u@yuvqisyu7m7qs.irc JOIN #chan")
- (0.1 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :chester, welcome!")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :chester, welcome!")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :alice: That ever eye with sight made heart lament.")
- (0.1 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :bob: The bitter past, more welcome is the sweet.")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :alice: Dispatch, I say, and find the forester."))
-
-((privmsg 3 "PRIVMSG #chan :chester: hi")
- (0.1 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :bob: This was lofty! Now name the rest of the players. This is Ercles' vein, a tyrant's vein; a lover is more condoling.")
- (0.1 ":chester!~u@yuvqisyu7m7qs.irc PRIVMSG #chan :hi tester")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :alice: As the ox hath his bow, sir, the horse his curb, and the falcon her bells, so man hath his desires; and as pigeons bill, so wedlock would be nibbling.")
- (0.1 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :bob: Most friendship is feigning, most loving mere folly.")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :alice: To employ you towards this Roman. Come, our queen."))
-
-((quit 4 "QUIT :" quit)
- (0 ":tester!~u@yuvqisyu7m7qs.irc QUIT :Quit: " quit))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER tester 0 * :tester")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 26 May 2024 09:32:55 UTC")
- (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=25 :are supported by this server")
- (0.02 ":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.03 ":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")
- (0.00 ":irc.foonet.org 221 tester +Zi")
- (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."))
-
-((mode 10 "MODE tester +i")
- (0.00 ":irc.foonet.org 221 tester +Zi")
- (0.07 ":dummy!~u@psu3bp52z9f34.irc PRIVMSG tester :hi"))
-
-((join 10 "JOIN #chan")
- (0.02 ":tester!~u@psu3bp52z9f34.irc JOIN #chan")
- (0.06 ":irc.foonet.org 353 tester = #chan :bob dummy tester @fsbot alice")
- (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.00 ":alice!~u@zmmipd3xfii2w.irc PRIVMSG #chan :tester, welcome!")
- (0.03 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :tester, welcome!"))
-
-((mode-chan 10 "MODE #chan")
- (0.02 ":irc.foonet.org 324 tester #chan +Cnt")
- (0.01 ":irc.foonet.org 329 tester #chan 1716715981"))
-
-((privmsg-chan-a 10 "PRIVMSG #chan :hi channel")
- (0.06 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :Perchance, Iago, I will ne'er go home.")
-
- ;; Bob (now known) sends us a DM
- (0.07 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG tester :hi")
- (0.02 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :alice: He is most in the company of the right noble Claudio.")
- (0.05 ":alice!~u@zmmipd3xfii2w.irc PRIVMSG #chan :bob: Such were our faults; or then we thought them none.")
- (0.03 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :You, sir, I entertain you for one of my hundred; only I do not like the fashion of your garments: you will say, they are Persian attire; but let them be changed.")
-
- ;; Dummy parts
- (0.01 ":dummy!~u@psu3bp52z9f34.irc PART #chan :bye")
- (0.08 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :alice: To lay a complot to betray thy foes.")
-
- ;; Bob quits
- (0.02 ":bob!~u@zmmipd3xfii2w.irc QUIT :later")
- (0.08 ":alice!~u@zmmipd3xfii2w.irc PRIVMSG #chan :bob: He was famous, sir, in his profession, and it was his great right to be so: Gerard de Narbon."))
-
-;; Bob rejoins
-((privmsg-chan-b 10 "PRIVMSG #chan :bob gone")
-
- (0.04 ":bob!~u@zmmipd3xfii2w.irc JOIN #chan")
- (0.01 ":alice!~u@zmmipd3xfii2w.irc PRIVMSG #chan :bob, welcome back!")
- (0.03 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :Our states are forfeit: seek not to undo us."))
-
-((part 10 "PART #chan :\2ERC\2")
- (0.02 ":tester!~u@psu3bp52z9f34.irc PART #chan :\2ERC\2"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 3 "PASS :changeme"))
-((nick 1 "NICK tester"))
-
-((user 1 "USER user 0 * :tester")
- (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (-0.02 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (-0.02 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (-0.02 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (-0.02 ":irc.foonet.org 254 tester 1 :channels formed")
- (-0.02 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (-0.02 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (-0.02 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (-0.02 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((~mode-user 10 "MODE tester +i")
- (-0.02 ":irc.foonet.org 221 tester +i")
- (-0.02 ":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."))
-
-((~join 10 "JOIN #chan"))
-((eof 5 EOF))
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((join 12 "JOIN #chan")
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620104779")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: But, as it seems, did violence on herself.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Well, this is the forest of Arden.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Signior Iachimo will not from it. Pray, let us follow 'em.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Our queen and all her elves come here anon.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: The ground is bloody; search about the churchyard.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: You have discharged this honestly: keep it to yourself. Many likelihoods informed me of this before, which hung so tottering in the balance that I could neither believe nor misdoubt. Pray you, leave me: stall this in your bosom; and I thank you for your honest care. I will speak with you further anon.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Give me that mattock, and the wrenching iron.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Stand you! You have land enough of your own; but he added to your having, gave you some ground.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Excellent workman! Thou canst not paint a man so bad as is thyself.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: And will you, being a man of your breeding, be married under a bush, like a beggar ? Get you to church, and have a good priest that can tell you what marriage is: this fellow will but join you together as they join wainscot; then one of you will prove a shrunk panel, and like green timber, warp, warp.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Live, and be prosperous; and farewell, good fellow."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((eof 5 EOF))
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((ping 20 "PING"))
-
-((eof 10 EOF))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is still in debug mode."))
-
-((~join-chan 12 "JOIN #chan")
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-
-((~join-spam 12 "JOIN #spam")
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #spam")
- (0 ":irc.foonet.org 353 tester = #spam :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #spam :End of NAMES list"))
-
-((~mode-chan 10 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620104779")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: But, as it seems, did violence on herself.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Well, this is the forest of Arden."))
-
-((mode-spam 20 "MODE #spam")
- (0 ":irc.foonet.org 324 tester #spam +nt")
- (0 ":irc.foonet.org 329 tester #spam 1620104779")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #spam :alice: Signior Iachimo will not from it. Pray, let us follow 'em.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #spam :bob: Our queen and all her elves come here anon."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :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 Tue, 04 May 2021 05:06:18 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode.")
-
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-
-((mode-chan 10 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620104779")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!"))
-
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.znc.in 464 tester :Invalid Password"))
-((linger 1 LINGER))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.znc.in 464 tester :Invalid Password"))
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-
-((~eof 60 EOF))
-((~ping 60 "PING " (group (+ (in "0-9"))))
- (0 "PONG " cookie))
-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :barnet:changeme"))
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
- (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.barnet.org 003 tester :This server was created Tue, 01 Jun 2021 07:49:23 UTC")
- (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.barnet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.barnet.org 254 tester 1 :channels formed")
- (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- ;; No mode answer
- (0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":tester!~u@286u8jcpis84e.irc JOIN #chan")
- (0 ":irc.barnet.org 353 tester = #chan :@joe mike rando tester")
- (0 ":irc.barnet.org 366 tester #chan :End of /NAMES list.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...")
- (0 ":joe!~u@286u8jcpis84e.irc PRIVMSG #chan :[09:19:19] mike: Chi non te vede, non te pretia.")
- (0 ":mike!~u@286u8jcpis84e.irc PRIVMSG #chan :[09:19:28] joe: The valiant heart's not whipt out of his trade.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.")
- (0 ":rando!~u@95i756tt32ym8.irc PRIVMSG tester :[09:18:20] Why'd you pull that scene at the arcade?")
- (0 ":rando!~u@95i756tt32ym8.irc PRIVMSG tester :[09:18:32] I had to mess up this rentacop came after me with nunchucks.")
- (0 ":irc.barnet.org NOTICE tester :[09:13:24] 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 ":irc.barnet.org 305 tester :You are no longer marked as being away"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.barnet.org 324 tester #chan +nt")
- (0 ":irc.barnet.org 329 tester #chan 1622538742")
- (0.1 ":joe!~u@286u8jcpis84e.irc PRIVMSG #chan :mike: By favors several which they did bestow.")
- (0.1 ":mike!~u@286u8jcpis84e.irc PRIVMSG #chan :joe: You, Roderigo! come, sir, I am for you."))
-
-((privmsg-a 10 "PRIVMSG rando :Linda said you were gonna kill me.")
- (0.1 ":joe!~u@286u8jcpis84e.irc PRIVMSG #chan :mike: Play, music, then! Nay, you must do it soon.")
- (0.1 ":rando!~u@95i756tt32ym8.irc PRIVMSG tester :Linda said? I never saw her before I came up here.")
- (0.1 ":mike!~u@286u8jcpis84e.irc PRIVMSG #chan :joe: Of arts inhibited and out of warrant."))
-
-((privmsg-b 10 "PRIVMSG rando :You aren't with Wage?")
- (0.1 ":joe!~u@286u8jcpis84e.irc PRIVMSG #chan :mike: But most of all, agreeing with the proclamation.")
- (0.1 ":rando!~u@95i756tt32ym8.irc PRIVMSG tester :I think you screwed up, Case.")
- (0.1 ":mike!~u@286u8jcpis84e.irc PRIVMSG #chan :joe: Good gentleman, go your gait, and let poor volk pass. An chud ha' bin zwaggered out of my life, 'twould not ha' bin zo long as 'tis by a vortnight. Nay, come not near th' old man; keep out, che vor ye, or ise try whether your costard or my ballow be the harder. Chill be plain with you.")
- ;; Nick change
- (0.1 ":rando!~u@95i756tt32ym8.irc NICK frenemy")
- (0.1 ":joe!~u@286u8jcpis84e.irc PRIVMSG #chan :mike: Till time beget some careful remedy.")
- (0.1 ":frenemy!~u@95i756tt32ym8.irc PRIVMSG tester :I showed up and you just fit me right into your reality picture.")
- (0.1 ":mike!~u@286u8jcpis84e.irc PRIVMSG #chan :joe: For I have lost him on a dangerous sea."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((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 Tue, 01 Jun 2021 07:49:22 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- ;; No mode answer
- (0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":tester!~u@u4mvbswyw8gbg.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :alice @bob rando tester")
- (0 ":irc.foonet.org 366 tester #chan :End of /NAMES list.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...")
- (0 ":bob!~u@u4mvbswyw8gbg.irc PRIVMSG #chan :[09:19:28] alice: Great men should drink with harness on their throats.")
- (0 ":alice!~u@u4mvbswyw8gbg.irc PRIVMSG #chan :[09:19:31] bob: Your lips will feel them the sooner: shallow again. A more sounder instance; come.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.")
- (0 ":rando!~u@bivkhq8yav938.irc PRIVMSG tester :[09:17:51] u thur?")
- (0 ":rando!~u@bivkhq8yav938.irc PRIVMSG tester :[09:17:58] guess not")
- (0 ":irc.foonet.org NOTICE tester :[09:12:53] 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 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1622538742")
- (0.1 ":bob!~u@u4mvbswyw8gbg.irc PRIVMSG #chan :alice: When there is nothing living but thee, thou shalt be welcome. I had rather be a beggar's dog than Apemantus.")
- (0.1 ":alice!~u@u4mvbswyw8gbg.irc PRIVMSG #chan :bob: You have simply misused our sex in your love-prate: we must have your doublot and hose plucked over your head, and show the world what the bird hath done to her own nest."))
-
-((privmsg-a 10 "PRIVMSG rando :I here")
- (0.1 ":bob!~u@u4mvbswyw8gbg.irc PRIVMSG #chan :alice: And I will make thee think thy swan a crow.")
- (0.1 ":rando!~u@bivkhq8yav938.irc PRIVMSG tester :u are dumb")
- (0.1 ":alice!~u@u4mvbswyw8gbg.irc PRIVMSG #chan :bob: Lie not, to say mine eyes are murderers."))
-
-((privmsg-b 10 "PRIVMSG rando :not so")
- (0.1 ":bob!~u@u4mvbswyw8gbg.irc PRIVMSG #chan :alice: Commit myself, my person, and the cause.")
- ;; Nick change
- (0.1 ":rando!~u@bivkhq8yav938.irc NICK frenemy")
- (0.1 ":alice!~u@u4mvbswyw8gbg.irc PRIVMSG #chan :bob: Of raging waste! It cannot hold; it will not.")
- (0.1 ":frenemy!~u@bivkhq8yav938.irc PRIVMSG tester :doubly so")
- (0.1 ":bob!~u@u4mvbswyw8gbg.irc PRIVMSG #chan :alice: These words are razors to my wounded heart."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :unknown")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.00 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.00 ":irc.foonet.org 003 tester :This server was created Thu, 09 May 2024 05:19:24 UTC")
- (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.00 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=25 :are supported by this server")
- (0.00 ":irc.foonet.org 251 tester :There are 0 users and 6 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 6 clients and 0 servers")
- (0.00 ":irc.foonet.org 265 tester 6 6 :Current local users 6, max 6")
- (0.00 ":irc.foonet.org 266 tester 6 6 :Current global users 6, max 6")
- (0.00 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0.00 ":irc.foonet.org 221 tester +i")
- (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((join 10 "JOIN #chan")
- (0.03 ":irc.foonet.org 221 tester +i") ; dupe
- (0.00 ":tester!~u@s8ceryiqkkcxk.irc JOIN #chan")
- (0.04 ":irc.foonet.org 353 tester = #chan :@fsbot bob alice dummy tester")
- (0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.00 ":alice!~u@68v4mpismdues.irc PRIVMSG #chan :tester, welcome!")
- (0.00 ":bob!~u@68v4mpismdues.irc PRIVMSG #chan :tester, welcome!")
- (0.03 ":bob!~u@68v4mpismdues.irc PRIVMSG #chan :That eye that told you so look'd but a-squint."))
-
-((mode-chan 10 "MODE #chan")
- (0.00 ":irc.foonet.org 324 tester #chan +Cnt")
- (0.01 ":irc.foonet.org 329 tester #chan 1715231970")
-
- ;; existing query with dummy
- (0.05 ":dummy!~u@s8ceryiqkkcxk.irc PRIVMSG tester :hi")
- (0.02 ":bob!~u@68v4mpismdues.irc PRIVMSG #chan :alice: Villains, forbear! we are the empress' sons.")
- (0.01 ":alice!~u@68v4mpismdues.irc PRIVMSG #chan :bob: This matter of marrying his king's daughter,wherein he must be weighed rather by her value than his own,words him, I doubt not, a great deal from the matter.")
-
- ;; dummy quits
- (0.07 ":dummy!~u@s8ceryiqkkcxk.irc QUIT :Quit: \2ERC\2 5.5.0.29.1 (IRC client for GNU Emacs 29.3.50)")
- (0.03 ":bob!~u@68v4mpismdues.irc PRIVMSG #chan :We will afflict the emperor in his pride.")
- (0.03 ":alice!~u@68v4mpismdues.irc PRIVMSG #chan :bob: Why, then, is my pump well flowered.")
- (0.05 ":bob!~u@68v4mpismdues.irc PRIVMSG #chan :Alas! sir, I know not Jupiter; I never drank with him in all my life.")
-
- ;; rejoins as warwick
- (0.03 ":warwick!~u@s8ceryiqkkcxk.irc JOIN #chan")
- (0.00 ":bob!~u@68v4mpismdues.irc PRIVMSG #chan :warwick, welcome!")
- (0.00 ":alice!~u@68v4mpismdues.irc PRIVMSG #chan :warwick, welcome!")
- (0.03 ":warwick!~u@s8ceryiqkkcxk.irc PRIVMSG #chan :hola")
- (0.03 ":alice!~u@68v4mpismdues.irc PRIVMSG #chan :bob: And stint thou too, I pray thee, nurse, say I.")
-
- ;; Makes contact in a query
- (0.02 ":warwick!~u@s8ceryiqkkcxk.irc PRIVMSG tester :howdy")
- (0.03 ":alice!~u@68v4mpismdues.irc PRIVMSG #chan :bob: Nor more willingly leaves winter; such summer-birds are men. Gentlemen, our dinner will not recompense this long stay: feast your ears with the music awhile, if they will fare so harshly o' the trumpet's sound; we shall to 't presently.")
- (0.03 ":bob!~u@68v4mpismdues.irc PRIVMSG #chan :If it please your honour, I know not well what they are; but precise villains they are, that I am sure of, and void of all profanation in the world that good Christians ought to have.")
-
- ;; warwick renicks back to dummy
- (0.08 ":warwick!~u@s8ceryiqkkcxk.irc NICK dummy")
- (0.04 ":bob!~u@68v4mpismdues.irc PRIVMSG #chan :Pleasure and action make the hours seem short.")
- (0.01 ":dummy!~u@s8ceryiqkkcxk.irc PRIVMSG tester :hey")
- (0.02 ":alice!~u@68v4mpismdues.irc PRIVMSG #chan :bob: Than those that have more cunning to be strange."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :foonet:changeme"))
-((nick 1 "NICK tester"))
-((user 1 "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 Mon, 31 May 2021 09:56:24 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 254 tester 2 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4")
- (0 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 8 "MODE tester +i")
- ;; No mode answer
- (0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":tester!~u@gq7yjr7gsu7nn.irc JOIN #foo")
- (0 ":irc.foonet.org 353 tester = #foo :alice @bob Lal tester")
- (0 ":irc.foonet.org 366 tester #foo :End of /NAMES list.")
- (0 ":***!znc@znc.in PRIVMSG #foo :Buffer Playback...")
- (0 ":alice!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :[10:00:02] bob: All that he is hath reference to your highness.")
- (0 ":bob!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :[10:00:06] alice: Excellent workman! Thou canst not paint a man so bad as is thyself.")
- (0 ":***!znc@znc.in PRIVMSG #foo :Playback Complete.")
- (0 ":irc.foonet.org NOTICE tester :[09:56:57] 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 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-
-((mode 10 "MODE #foo")
- (0 ":irc.foonet.org 324 tester #foo +nt")
- (0 ":irc.foonet.org 329 tester #foo 1622454985")
- (0.1 ":alice!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :bob: Farewell, pretty lady: you must hold the credit of your father.")
- (0.1 ":bob!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :alice: On Thursday, sir ? the time is very short."))
-
-((privmsg-a 10 "PRIVMSG #foo :hi")
- (0.2 ":Lal!~u@b82mytupn2t5k.irc PRIVMSG tester :hello")
- (0.2 ":bob!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :alice: And brought to yoke, the enemies of Rome.")
- (0.2 ":alice!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :bob: Thou art thy father's daughter; there's enough."))
-
-((privmsg-b 10 "PRIVMSG Lal :hi")
- (0.2 ":bob!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :alice: Here are the beetle brows shall blush for me.")
- (0.2 ":Lal!~u@b82mytupn2t5k.irc NICK Linguo")
- (0.2 ":alice!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :bob: He hath abandoned his physicians, madam; under whose practices he hath persecuted time with hope, and finds no other advantage in the process but only the losing of hope by time."))
-
-((privmsg-c 10 "PRIVMSG Linguo :howdy Linguo")
- (0.1 ":bob!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :alice: And brought to yoke, the enemies of Rome.")
- (0.2 ":Linguo!~u@b82mytupn2t5k.irc PART #foo"))
-
-((part 10 "PART #foo :\2ERC\2")
- (0 ":tester!~u@gq7yjr7gsu7nn.irc PART #foo :\2ERC\2")
- (0.1 ":Linguo!~u@b82mytupn2t5k.irc PRIVMSG tester :get along little doggie"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :foonet:changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.foonet.org 001 tester :Welcome to the FooNet Internet Relay Chat Network tester")
- (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org[188.240.145.101/6697], running version solanum-1.0-dev")
- (0 ":irc.foonet.org 003 tester :This server was created Sat May 22 2021 at 19:04:17 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org solanum-1.0-dev DGQRSZaghilopsuwz CFILMPQSbcefgijklmnopqrstuvz bkloveqjfI")
- (0 ":irc.foonet.org 005 tester WHOX FNC KNOCK SAFELIST ELIST=CTU CALLERID=g MONITOR=100 ETRACE CHANTYPES=# EXCEPTS INVEX CHANMODES=eIbq,k,flj,CFLMPQScgimnprstuz :are supported by this server")
- (0 ":irc.foonet.org 005 tester CHANLIMIT=#:250 PREFIX=(ov)@+ MAXLIST=bqeI:100 MODES=4 NETWORK=foonet STATUSMSG=@+ CASEMAPPING=rfc1459 NICKLEN=16 MAXNICKLEN=16 CHANNELLEN=50 TOPICLEN=390 DEAF=D :are supported by this server")
- (0 ":irc.foonet.org 005 tester TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,MONITOR: EXTBAN=$,ajrxz CLIENTVER=3.0 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 33 users and 14113 invisible on 17 servers")
- (0 ":irc.foonet.org 252 tester 34 :IRC Operators online")
- (0 ":irc.foonet.org 254 tester 12815 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 726 clients and 1 servers")
- (0 ":irc.foonet.org 265 tester 726 739 :Current local users 726, max 739")
- (0 ":irc.foonet.org 266 tester 14146 14541 :Current global users 14146, max 14541")
- (0 ":irc.foonet.org 250 tester :Highest connection count: 740 (739 clients) (3790 connections received)")
- (0 ":tester!~u@gq7yjr7gsu7nn.irc NICK :dummy")
- (0 ":irc.foonet.org 375 dummy :- irc.foonet.org Message of the Day - ")
- (0 ":irc.foonet.org 372 dummy :- This server provided by NORDUnet/SUNET")
- (0 ":irc.foonet.org 372 dummy :- Welcome to foonet, the IRC network for free & open-source software")
- (0 ":irc.foonet.org 372 dummy :- and peer directed projects.")
- (0 ":irc.foonet.org 372 dummy :- ")
- (0 ":irc.foonet.org 372 dummy :- Please visit us in #libera for questions and support.")
- (0 ":irc.foonet.org 376 dummy :End of /MOTD command."))
-
-((mode-user 10.2 "MODE dummy +i")
- (0 ":dummy!~u@gq7yjr7gsu7nn.irc MODE dummy :+RZi")
- (0 ":irc.znc.in 306 dummy :You have been marked as being away")
- (0 ":dummy!~u@gq7yjr7gsu7nn.irc JOIN #foo")
-
- (0 ":irc.foonet.org 353 dummy = #foo :alice @bob Lal dummy")
- (0 ":irc.foonet.org 366 dummy #foo :End of /NAMES list.")
- (0 ":***!znc@znc.in PRIVMSG #foo :Buffer Playback...")
- (0 ":alice!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :[10:00:02] bob: All that he is hath reference to your highness.")
- (0 ":bob!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :[10:00:06] alice: Excellent workman! Thou canst not paint a man so bad as is thyself.")
- (0 ":***!znc@znc.in PRIVMSG #foo :Playback Complete.")
- (0 ":irc.foonet.org NOTICE dummy :[09:56:57] 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 ":irc.foonet.org 305 dummy :You are no longer marked as being away"))
-
-((mode 10 "MODE #foo")
- (0 ":irc.foonet.org 324 dummy #foo +nt")
- (0 ":irc.foonet.org 329 dummy #foo 1622454985")
- (0.1 ":alice!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :bob: Farewell, pretty lady: you must hold the credit of your father.")
- (0.1 ":bob!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :alice: On Thursday, sir ? the time is very short."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :foonet:changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.foonet.org 001 tester :Welcome to the FooNet Internet Relay Chat Network tester")
- (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org[188.240.145.101/6697], running version solanum-1.0-dev")
- (0 ":irc.foonet.org 003 tester :This server was created Sat May 22 2021 at 19:04:17 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org solanum-1.0-dev DGQRSZaghilopsuwz CFILMPQSbcefgijklmnopqrstuvz bkloveqjfI")
- (0 ":irc.foonet.org 005 tester WHOX FNC KNOCK SAFELIST ELIST=CTU CALLERID=g MONITOR=100 ETRACE CHANTYPES=# EXCEPTS INVEX CHANMODES=eIbq,k,flj,CFLMPQScgimnprstuz :are supported by this server")
- (0 ":irc.foonet.org 005 tester CHANLIMIT=#:250 PREFIX=(ov)@+ MAXLIST=bqeI:100 MODES=4 NETWORK=foonet STATUSMSG=@+ CASEMAPPING=rfc1459 NICKLEN=16 MAXNICKLEN=16 CHANNELLEN=50 TOPICLEN=390 DEAF=D :are supported by this server")
- (0 ":irc.foonet.org 005 tester TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,MONITOR: EXTBAN=$,ajrxz CLIENTVER=3.0 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 33 users and 14113 invisible on 17 servers")
- (0 ":irc.foonet.org 252 tester 34 :IRC Operators online")
- (0 ":irc.foonet.org 254 tester 12815 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 726 clients and 1 servers")
- (0 ":irc.foonet.org 265 tester 726 739 :Current local users 726, max 739")
- (0 ":irc.foonet.org 266 tester 14146 14541 :Current global users 14146, max 14541")
- (0 ":irc.foonet.org 250 tester :Highest connection count: 740 (739 clients) (3790 connections received)")
- (0 ":irc.foonet.org 375 tester :- irc.foonet.org Message of the Day - ")
- (0 ":irc.foonet.org 372 tester :- This server provided by NORDUnet/SUNET")
- (0 ":irc.foonet.org 372 tester :- Welcome to foonet, the IRC network for free & open-source software")
- (0 ":irc.foonet.org 372 tester :- and peer directed projects.")
- (0 ":irc.foonet.org 372 tester :- ")
- (0 ":irc.foonet.org 372 tester :- Please visit us in #libera for questions and support.")
- (0 ":irc.foonet.org 376 tester :End of /MOTD command."))
-
-((mode-user 10 "MODE tester +i")
- (0 ":tester!~u@gq7yjr7gsu7nn.irc MODE tester :+RZi")
- (0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":tester!~u@gq7yjr7gsu7nn.irc JOIN #foo")
-
- (0 ":irc.foonet.org 353 tester = #foo :alice @bob Lal tester")
- (0 ":irc.foonet.org 366 tester #foo :End of /NAMES list.")
- (0 ":***!znc@znc.in PRIVMSG #foo :Buffer Playback...")
- (0 ":alice!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :[10:00:02] bob: All that he is hath reference to your highness.")
- (0 ":bob!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :[10:00:06] alice: Excellent workman! Thou canst not paint a man so bad as is thyself.")
- (0 ":***!znc@znc.in PRIVMSG #foo :Playback Complete.")
- (0 ":irc.foonet.org NOTICE tester :[09:56:57] 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 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-
-((mode-foo 10 "MODE #foo")
- (0 ":irc.foonet.org 324 tester #foo +nt")
- (0 ":irc.foonet.org 329 tester #foo 1622454985")
- (0.1 ":alice!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :bob: Farewell, pretty lady: you must hold the credit of your father.")
- (0.1 ":bob!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :alice: On Thursday, sir ? the time is very short."))
-
-((nick 10 "NICK dummy")
- (0 ":tester!~u@gq7yjr7gsu7nn.irc NICK :dummy")
- (0.1 ":dummy!~u@gq7yjr7gsu7nn.irc MODE dummy :+RZi")
- (0.1 ":bob!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :dummy: Hi."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :unknown")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.00 ":irc.foonet.org 003 tester :This server was created Sun, 12 May 2024 00:41:10 UTC")
- (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=25 :are supported by this server")
- (0.00 ":irc.foonet.org 251 tester :There are 0 users and 6 invisible on 1 server(s)")
- (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.02 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0.00 ":irc.foonet.org 254 tester 2 :channels formed")
- (0.01 ":irc.foonet.org 255 tester :I have 6 clients and 0 servers")
- (0.00 ":irc.foonet.org 265 tester 6 6 :Current local users 6, max 6")
- (0.00 ":irc.foonet.org 266 tester 6 6 :Current global users 6, max 6")
- (0.00 ":irc.foonet.org 422 tester :MOTD File is missing")
- (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."))
-
-((mode-user 10 "MODE tester +i"))
-
-((join 10 "JOIN #chan")
- (0.00 ":irc.foonet.org 221 tester +i")
- (0.00 ":tester!~u@hyyensdmcrjxc.irc JOIN #chan")
- (0.02 ":irc.foonet.org 353 tester = #chan :someone tester @fsbot alice bob observer")
- (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.00 ":bob!~u@zb3s8yrduykma.irc PRIVMSG #chan :tester, welcome!")
- (0.01 ":alice!~u@zb3s8yrduykma.irc PRIVMSG #chan :tester, welcome!"))
-
-((mode-chan 10 "MODE #chan")
- (0.00 ":irc.foonet.org 324 tester #chan +Cnt")
- (0.02 ":irc.foonet.org 329 tester #chan 1715474476")
- (0.09 ":bob!~u@zb3s8yrduykma.irc PRIVMSG #chan :alice: And, uncle, so will I, an if I live.")
- (0.03 ":alice!~u@zb3s8yrduykma.irc PRIVMSG #chan :bob: Speak to the people, and they pity her."))
-
-((privmsg-observer 10 "PRIVMSG observer :hi")
- (0.04 ":observer!~u@hyyensdmcrjxc.irc PRIVMSG tester :hi?")
- (0.07 ":bob!~u@zb3s8yrduykma.irc PRIVMSG #chan :To ask of whence you are: report it."))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.03 ":tester!~u@hyyensdmcrjxc.irc QUIT :Quit: \2ERC\2 5.6-git (IRC client for GNU Emacs 30.0.50)")
- (0.03 "ERROR :Quit: \2ERC\2 5.6-git (IRC client for GNU Emacs 30.0.50)"))
-
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK dummy"))
-((user 10 "USER user 0 * :unknown")
- (0.01 ":irc.foonet.org 001 dummy :Welcome to the foonet IRC Network dummy")
- (0.01 ":irc.foonet.org 002 dummy :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.01 ":irc.foonet.org 003 dummy :This server was created Sun, 12 May 2024 00:41:10 UTC")
- (0.00 ":irc.foonet.org 004 dummy irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.03 ":irc.foonet.org 005 dummy AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.03 ":irc.foonet.org 005 dummy KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 dummy draft/CHATHISTORY=25 :are supported by this server")
- (0.00 ":irc.foonet.org 251 dummy :There are 0 users and 6 invisible on 1 server(s)")
- (0.00 ":irc.foonet.org 252 dummy 0 :IRC Operators online")
- (0.00 ":irc.foonet.org 253 dummy 0 :unregistered connections")
- (0.00 ":irc.foonet.org 254 dummy 2 :channels formed")
- (0.00 ":irc.foonet.org 255 dummy :I have 6 clients and 0 servers")
- (0.00 ":irc.foonet.org 265 dummy 6 6 :Current local users 6, max 6")
- (0.00 ":irc.foonet.org 266 dummy 6 6 :Current global users 6, max 6")
- (0.03 ":irc.foonet.org 422 dummy :MOTD File is missing")
- (0.00 ":irc.foonet.org 221 dummy +i")
- (0.00 ":irc.foonet.org NOTICE dummy :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."))
-
-((mode-user 10 "MODE dummy +i"))
-
-((join-chan 10 "JOIN #chan")
- (0.01 ":irc.foonet.org 221 dummy +i")
- (0.00 ":dummy!~u@hyyensdmcrjxc.irc JOIN #chan")
- (0.02 ":irc.foonet.org 353 dummy = #chan :@fsbot alice bob observer someone dummy")
- (0.01 ":irc.foonet.org 366 dummy #chan :End of NAMES list")
- (0.00 ":bob!~u@zb3s8yrduykma.irc PRIVMSG #chan :dummy, welcome!")
- (0.01 ":alice!~u@zb3s8yrduykma.irc PRIVMSG #chan :dummy, welcome!"))
-
-((mode-chan 10 "MODE #chan")
- (0.00 ":irc.foonet.org 324 dummy #chan +Cnt")
- (0.02 ":irc.foonet.org 329 dummy #chan 1715474476")
- (0.09 ":bob!~u@zb3s8yrduykma.irc PRIVMSG #chan :alice: Indeed, sir, he that sleeps feels not the toothache; but a man that were to sleep your sleep, and a hangman to help him to bed, I think he would change places with his officer; for look you, sir, you know not which way you shall go.")
- (0.03 ":alice!~u@zb3s8yrduykma.irc PRIVMSG #chan :bob: Pray you, sir, deliver me this paper."))
-
-((privmsg-observer 10 "PRIVMSG observer :hola")
- (0.01 ":bob!~u@zb3s8yrduykma.irc PRIVMSG #chan :alice: In manner and form following, sir; all those three: I was seen with her in the manor-house, sitting with her upon the form, and taken following her into the park; which, put together, is, in manner and form following. Now, sir, for the manner,it is the manner of a man to speak to a woman, for the form,in some form.")
- (0.05 ":alice!~u@zb3s8yrduykma.irc PRIVMSG #chan :In Isbel's case and mine own. Service is no heritage; and I think I shall never have the blessing of God till I have issue o' my body, for they say barnes are blessings.")
- (0.01 ":observer!~u@hyyensdmcrjxc.irc PRIVMSG dummy :whodis?")
- (0.02 ":bob!~u@zb3s8yrduykma.irc PRIVMSG #chan :alice: Have here bereft my brother of his life."))
-
-((nick-tester 10 "NICK tester")
- (0.02 ":dummy!~u@hyyensdmcrjxc.irc NICK tester")
-
- (0.04 ":alice!~u@zb3s8yrduykma.irc PRIVMSG #chan :bob: You have too courtly a wit for me: I'll rest.")
- (0.07 ":bob!~u@zb3s8yrduykma.irc PRIVMSG #chan :alice: And abstinence engenders maladies."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK chester"))
-((user 1 "USER user 0 * :chester")
- (0 ":irc.foonet.org 001 chester :Welcome to the foonet IRC Network chester")
- (0 ":irc.foonet.org 002 chester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.foonet.org 003 chester :This server was created Sun, 13 Jun 2021 05:45:20 UTC")
- (0 ":irc.foonet.org 004 chester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 chester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 chester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 chester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 chester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 chester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 chester 1 :unregistered connections")
- (0 ":irc.foonet.org 254 chester 1 :channels formed")
- (0 ":irc.foonet.org 255 chester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 chester 3 4 :Current local users 3, max 4")
- (0 ":irc.foonet.org 266 chester 3 4 :Current global users 3, max 4")
- (0 ":irc.foonet.org 422 chester :MOTD File is missing"))
-
-((mode-user 10 "MODE chester +i")
- (0 ":irc.foonet.org 221 chester +i")
- (0 ":irc.foonet.org NOTICE chester :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."))
-
-((join 14 "JOIN #chan")
- (0 ":chester!~u@yuvqisyu7m7qs.irc JOIN #chan")
- (0 ":irc.foonet.org 353 chester = #chan :tester chester @alice bob")
- (0 ":irc.foonet.org 366 chester #chan :End of NAMES list"))
-
-((mode 10 "MODE #chan")
- (0.0 ":irc.foonet.org 324 chester #chan +nt")
- (0.0 ":irc.foonet.org 329 chester #chan 1623563121")
- (0.0 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :chester, welcome!")
- (0.0 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :chester, welcome!")
- (0 ":tester!~u@gq7yjr7gsu7nn.irc NICK :dummy")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :alice: That ever eye with sight made heart lament.")
- (0.1 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :bob: The bitter past, more welcome is the sweet.")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :alice: Dispatch, I say, and find the forester."))
-
-((linger 10 LINGER))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "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, 13 Jun 2021 05:45:20 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4")
- (0 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((join 15 "JOIN #chan")
- (0 ":tester!~u@yuvqisyu7m7qs.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :tester @alice bob")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-
-((mode 10 "MODE #chan")
- (0.0 ":irc.foonet.org 324 tester #chan +nt")
- (0.0 ":irc.foonet.org 329 tester #chan 1623563121")
- (0.0 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :tester, welcome!")
- (0.0 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :tester, welcome!")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :alice: Marry, that, I think, be young Petruchio.")
- (0.4 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :bob: You speak of him when he was less furnished than now he is with that which makes him both without and within.")
- (0.2 ":chester!~u@yuvqisyu7m7qs.irc JOIN #chan")
- (0.1 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :chester, welcome!")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :chester, welcome!"))
-
-((nick 5 "NICK dummy")
- (0 ":tester!~u@gq7yjr7gsu7nn.irc NICK :dummy")
- (0.1 ":dummy!~u@gq7yjr7gsu7nn.irc MODE dummy :+RZi")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :alice: That ever eye with sight made heart lament.")
- (0.1 ":alice!~u@wyb9b355rgzi8.irc PRIVMSG #chan :bob: The bitter past, more welcome is the sweet.")
- (0.1 ":bob!~u@wyb9b355rgzi8.irc PRIVMSG #chan :alice: Dispatch, I say, and find the forester."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 3 "PASS :barnet:changeme"))
-((nick 3 "NICK tester"))
-((user 3 "USER user 0 * :tester")
- (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
- (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.barnet.org 003 tester :This server was created Wed, 05 May 2021 09:05:33 UTC")
- (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.barnet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.barnet.org 254 tester 1 :channels formed")
- (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10.2 "MODE tester +i")
- ;; No mode answer
- (0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":tester!~u@wvys46tx8tpmk.irc JOIN #chan")
- (0 ":irc.barnet.org 353 tester = #chan :joe @mike tester")
- (0 ":irc.barnet.org 366 tester #chan :End of /NAMES list.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...")
- (0 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :[09:09:16] joe: Tush! none but minstrels like of sonneting.")
- (0 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :[09:09:19] mike: Prithee, nuncle, be contented; 'tis a naughty night to swim in. Now a little fire in a wide field were like an old lecher's heart; a small spark, all the rest on's body cold. Look! here comes a walking fire.")
- (0 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :[09:09:22] joe: My name is Edgar, and thy father's son.")
- (0 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :[09:09:26] mike: Good my lord, be good to me; your honor is accounted a merciful man; good my lord.")
- (0 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :[09:09:31] joe: Thy child shall live, and I will see it nourish'd.")
- (0 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :[09:09:33] mike: Quick, quick; fear nothing; I'll be at thy elbow.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.")
- (0 ":irc.barnet.org NOTICE tester :[09:05:35] 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 ":irc.barnet.org 305 tester :You are no longer marked as being away"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.barnet.org 324 tester #chan +nt")
- (0 ":irc.barnet.org 329 tester #chan 1620205534")
- (0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: That will be given to the loudest noise we make.")
- (0.1 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :mike: If it please your honor, I am the poor duke's constable, and my name is Elbow: I do lean upon justice, sir; and do bring in here before your good honor two notorious benefactors.")
- (0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: Following the signs, woo'd but the sign of she.")
- (0.5 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :mike: That, sir, which I will not report after her.")
- (0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: Boyet, prepare: I will away to-night.")
- (0.1 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :mike: If the man be a bachelor, sir, I can; but if he be a married man, he is his wife's head, and I can never cut off a woman's head.")
- (0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: Thyself upon thy virtues, they on thee.")
- (0.1 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :mike: Arm it in rags, a pigmy's straw doth pierce it."))
-
-((part 5.1 "PART #chan :" quit)
- (0 ":tester!~u@wvys46tx8tpmk.irc PART #chan :" quit))
-
-((join 10.1 "JOIN #chan")
- (0 ":tester!~u@wvys46tx8tpmk.irc JOIN #chan")
- (0 ":irc.barnet.org 353 tester = #chan :@mike joe tester")
- (0 ":irc.barnet.org 366 tester #chan :End of NAMES list")
- (0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :tester, welcome!")
- (0 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :tester, welcome!"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.barnet.org 324 tester #chan +nt")
- (0 ":irc.barnet.org 329 tester #chan 1620205534")
- (0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: Chi non te vede, non te pretia.")
- (0.1 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :mike: Well, if ever thou dost fall from this faith, thou wilt prove a notable argument.")
- (0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: Of heavenly oaths, vow'd with integrity.")
- (0.1 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :mike: These herblets shall, which we upon you strew.")
- (0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: Aaron will have his soul black like his face."))
-
-((linger 0.5 LINGER))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :foonet:changeme"))
-((nick 1 "NICK tester"))
-((user 1 "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 Wed, 05 May 2021 09:05:34 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 12 "MODE tester +i")
- ;; No mode answer
- (0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":tester!~u@247eaxkrufj44.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :alice @bob tester")
- (0 ":irc.foonet.org 366 tester #chan :End of /NAMES list.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...")
- (0 ":alice!~u@yppdd5tt4admc.irc PRIVMSG #chan :[09:07:19] bob: Is this; she hath bought the name of whore thus dearly.")
- (0 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :[09:07:24] alice: He sent to me, sir,Here he comes.")
- (0 ":alice!~u@yppdd5tt4admc.irc PRIVMSG #chan :[09:07:26] bob: Till I torment thee for this injury.")
- (0 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :[09:07:29] alice: There's an Italian come; and 'tis thought, one of Leonatus' friends.")
- (0 ":alice!~u@yppdd5tt4admc.irc PRIVMSG #chan :[09:09:33] bob: Ay, and the particular confirmations, point from point, to the full arming of the verity.")
- (0 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :[09:09:35] alice: Kneel in the streets and beg for grace in vain.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.")
- (0 ":irc.foonet.org NOTICE tester :[09:06:05] 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 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620205534")
- (0.5 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :alice: Nor I no strength to climb without thy help.")
- (0.1 ":alice!~u@yppdd5tt4admc.irc PRIVMSG #chan :bob: Nothing, but let him have thanks. Demand of him my condition, and what credit I have with the duke.")
- (0.1 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :alice: Show me this piece. I am joyful of your sights.")
- (0.2 ":alice!~u@yppdd5tt4admc.irc PRIVMSG #chan :bob: Whilst I can shake my sword or hear the drum."))
-
-((part 5 "PART #chan :" quit)
- (0 ":tester!~u@247eaxkrufj44.irc PART #chan :" quit))
-
-((join 10 "JOIN #chan")
- (0 ":tester!~u@247eaxkrufj44.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :@bob alice tester")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.1 ":alice!~u@yppdd5tt4admc.irc PRIVMSG #chan :tester, welcome!")
- (0 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :tester, welcome!"))
-
-((mode 10 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620205534")
- (0.1 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :alice: Thou desirest me to stop in my tale against the hair.")
- (0.1 ":alice!~u@yppdd5tt4admc.irc PRIVMSG #chan :bob: And dar'st not stand, nor look me in the face.")
- (0.1 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :alice: It should not be, by the persuasion of his new feasting.")
- (0.1 ":alice!~u@yppdd5tt4admc.irc PRIVMSG #chan :bob: It was not given me, nor I did not buy it.")
- (0.1 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :alice: He that would vouch it in any place but here.")
- (0.1 ":alice!~u@yppdd5tt4admc.irc PRIVMSG #chan :bob: In everything I wait upon his will.")
- (0.1 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :alice: Thou counterfeit'st most lively."))
-
-((linger 8 LINGER))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :barnet:changeme"))
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
- (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.barnet.org 003 tester :This server was created Sun, 25 Apr 2021 11:28:28 UTC")
- (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.barnet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.barnet.org 254 tester 1 :channels formed")
- (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10.2 "MODE tester +i")
- ;; No mode answer
- (0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":irc.barnet.org NOTICE tester :[11:29:00] 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 ":irc.barnet.org 305 tester :You are no longer marked as being away"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((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")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10.2 "MODE tester +i")
- ;; No mode answer
- (0 ":irc.znc.in 306 tester :You have been marked as being away")
- (0 ":irc.foonet.org NOTICE tester :[11:29:00] 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 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 12 Nov 2023 17:40:20 UTC")
- (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.02 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
- (0.01 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)")
- (0.01 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.01 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0.01 ":irc.foonet.org 254 tester 2 :channels formed")
- (0.01 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers")
- (0.01 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4")
- (0.01 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
- (0.02 ":irc.foonet.org 422 tester :MOTD File is missing")
- (0.00 ":irc.foonet.org 221 tester +i")
- (0.01 ":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."))
-
-((mode-tester 10 "MODE tester +i"))
-
-((join-chan 10 "JOIN #chan")
- (0.00 ":irc.foonet.org 221 tester +i")
- (0.01 ":tester!~u@ggpg6r3a68wak.irc JOIN #chan")
- (0.03 ":irc.foonet.org 353 tester = #chan :@fsbot bob alice tester")
- (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.00 ":bob!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :tester, welcome!")
- (0.01 ":alice!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :tester, welcome!"))
-
-((mode-chan 10 "MODE #chan")
- (0.00 ":irc.foonet.org 324 tester #chan +Cnt")
- (0.02 ":irc.foonet.org 329 tester #chan 1699810829")
- (0.01 ":alice!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :bob: To prove him false that says I love thee not.")
- (0.02 ":bob!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :alice: For hands, to do Rome service, are but vain."))
-
-((privmsg-action 10 "PRIVMSG #chan :\1ACTION sad\1")
- (0.07 ":alice!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :bob: Spotted, detested, and abominable."))
-
-((privmsg-me 10 "PRIVMSG #chan :/me sad")
- (0.03 ":bob!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :Marcus, my brother! 'tis sad Titus calls."))
-
-((privmsg-sv 10 "PRIVMSG #chan :I'm using ERC " (+ (not " ")) " with GNU Emacs")
- (0.07 ":bob!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :alice: You still wrangle with her, Boyet, and she strikes at the brow."))
-
-((privmsg-sm 10 "PRIVMSG #chan :I'm using the following modules: `erc-autojoin-mode', ")
- (0.04 ":alice!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :No, not till Thursday; there is time enough."))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.05 ":tester!~u@ggpg6r3a68wak.irc QUIT :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)")
- (0.02 "ERROR :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 6 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER tester@vanilla/barnet 0 * :tester")
- (0.01 ":soju.im 001 tester :Welcome to soju, tester")
- (0.01 ":soju.im 002 tester :Your host is soju.im")
- (0.00 ":soju.im 004 tester soju.im soju aiwroO OovaimnqpsrtklbeI")
- (0.53 ":soju.im 005 tester CHATHISTORY=1000 CASEMAPPING=ascii BOUNCER_NETID=2 AWAYLEN=390 CHANLIMIT=#:100 INVEX NETWORK=barnet NICKLEN=32 WHOX MODES BOT=B ELIST=U MAXLIST=beI:60 :are supported")
- (0.01 ":soju.im 005 tester TOPICLEN=390 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 EXCEPTS EXTBAN=,m KICKLEN=390 TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 MAXTARGETS=4 MONITOR=100 CHANTYPES=# PREFIX=(qaohv)~&@%+ UTF8ONLY :are supported")
- (0.22 ":soju.im 221 tester +Zi")
- (0.00 ":soju.im 422 tester :Use /motd to read the message of the day"))
-
-((mode-tester 5 "MODE tester +i")
- (0.00 ":tester!tester@10.0.2.100 JOIN #chan")
- (0.06 ":soju.im 353 tester = #chan :tester @mike joe")
- (0.01 ":soju.im 366 tester #chan :End of /NAMES list")
- (0.23 ":irc.barnet.org 221 tester +Zi"))
-
-((mode-chan-a 5 "MODE #chan")
- (0.00 ":soju.im 324 tester #chan +tn")
- (0.01 ":soju.im 329 tester #chan 1652878846")
- (0.01 ":joe!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :mike: There is five in the first show.")
- (0.00 ":mike!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :joe: Sir, I was an inward of his. A shy fellow was the duke; and, I believe I know the cause of his withdrawing.")
- (0.00 ":joe!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :mike: Proud of employment, willingly I go.")
- (0.09 ":mike!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :joe: Dull not device by coldness and delay.")
- (0.09 ":joe!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :mike: Our states are forfeit: seek not to undo us.")
- (0.06 ":mike!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :joe: Come, you are too severe a moraler. As the time, the place, and the condition of this country stands, I could heartily wish this had not befallen, but since it is as it is, mend it for your own good.")
- (0.06 ":joe!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :mike: Who hath upon him still that natural stamp.")
- (0.07 ":mike!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :joe: Arraign her first; 'tis Goneril. I here take my oath before this honourable assembly, she kicked the poor king her father.")
- (0.06 ":joe!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :mike: Lady, I will commend you to mine own heart.")
- (0.08 ":mike!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :joe: Look, what I will not, that I cannot do.")
- (0.08 ":joe!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :mike: That he would wed me, or else die my lover.")
- (0.08 ":mike!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :joe: Come your way, sir. Bless you, good father friar.")
- (0.08 ":joe!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :mike: Under correction, sir, we know whereuntil it doth amount.")
- (0.08 ":mike!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :joe: For I am nothing if not critical.")
- (0.06 ":joe!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :mike: Once more I'll read the ode that I have writ.")
- (0.06 ":mike!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :joe: This is the foul fiend Flibbertigibbet: he begins at curfew, and walks till the first cock; he gives the web and the pin, squints the eye, and makes the harelip; mildews the white wheat, and hurts the poor creature of earth.")
- (0.06 ":joe!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :mike: Sir, I praise the Lord for you, and so may my parishioners; for their sons are well tutored by you, and their daughters profit very greatly under you: you are a good member of the commonwealth.")
- (0.08 ":mike!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :joe: If it please your honor, I know not well what they are; but precise villains they are, that I am sure of, and void of all profanation in the world that good Christians ought to have.")
- ;; Unexpected disconnect
- (0.03 ":BouncerServ!BouncerServ@BouncerServ NOTICE tester :disconnected from barnet: failed to handle messages: failed to read IRC command: read tcp [::1]:54990->[::1]:6668: read: software caused connection abort")
- ;; Eventual reconnect
- (0.79 ":BouncerServ!BouncerServ@BouncerServ NOTICE tester :connected to barnet")
- ;; No MOTD or other numerics
- (0.01 ":soju.im 005 tester AWAYLEN=390 BOT=B CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m INVEX KICKLEN=390 :are supported")
- (0.01 ":soju.im 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported")
- (0.22 ":irc.barnet.org 221 tester +Zi")
- (0.01 ":irc.barnet.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.")
- ;; Server-initialed join
- (0.01 ":tester!tester@10.0.2.100 JOIN #chan"))
-
-((mode-chan-b 5 "MODE #chan")
- (0.22 ":soju.im 353 tester = #chan :@mike joe tester")
- (0.00 ":soju.im 366 tester #chan :End of /NAMES list")
- (0.00 ":soju.im 324 tester #chan +nt")
- (0.00 ":soju.im 329 tester #chan 1652878846")
- (0.00 ":mike!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :tester, welcome!")
- (0.00 ":joe!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :tester, welcome!")
- (0.06 ":soju.im 324 tester #chan +nt")
- (0.00 ":soju.im 329 tester #chan 1652878846")
- (0.62 ":joe!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :mike: Thou art my brother; so we'll hold thee ever.")
- (0.00 ":mike!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :joe: Very well! go to! I cannot go to, man; nor 'tis not very well: by this hand, I say, it is very scurvy, and begin to find myself fobbed in it.")
- (0.00 ":joe!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :mike: The heir of Alen on, Katharine her name.")
- (0.09 ":mike!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :joe: Go to; farewell! put money enough in your purse."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 5 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER tester@vanilla/foonet 0 * :tester")
- (0.01 ":soju.im 001 tester :Welcome to soju, tester")
- (0.02 ":soju.im 002 tester :Your host is soju.im")
- (0.01 ":soju.im 004 tester soju.im soju aiwroO OovaimnqpsrtklbeI")
- (0.00 ":soju.im 005 tester CHATHISTORY=1000 CASEMAPPING=ascii BOUNCER_NETID=1 CHANTYPES=# PREFIX=(qaohv)~&@%+ UTF8ONLY AWAYLEN=390 NICKLEN=32 WHOX CHANLIMIT=#:100 INVEX NETWORK=foonet MODES :are supported")
- (0.00 ":soju.im 005 tester TOPICLEN=390 BOT=B ELIST=U MAXLIST=beI:60 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 EXCEPTS EXTBAN=,m KICKLEN=390 MAXTARGETS=4 MONITOR=100 :are supported")
- (0.00 ":soju.im 221 tester +Zi")
- (0.00 ":soju.im 422 tester :Use /motd to read the message of the day"))
-
-((mode 5 "MODE tester +i")
- (0.2 ":irc.foonet.org 221 tester +Zi")
- (0.0 ":tester!tester@10.0.2.100 JOIN #chan")
- (0.0 ":soju.im 353 tester = #chan :tester @alice bob")
- (0.1 ":soju.im 366 tester #chan :End of /NAMES list")
- (0.0 ":bob!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :alice: Princely shall be thy usage every way.")
- (0.1 ":alice!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :bob: Tell me thy reason why thou wilt marry."))
-
-((mode 5 "MODE #chan")
- (0.00 ":soju.im 324 tester #chan +nt")
- (0.01 ":soju.im 329 tester #chan 1652878847")
- (0.02 ":bob!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :alice: There is no leprosy but what thou speak'st.")
- (0.09 ":alice!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :bob: For I upon this bank will rest my head.")
- (0.01 ":bob!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :alice: To ruffle in the commonwealth of Rome.")
- (0.08 ":alice!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :bob: For I can nowhere find him like a man.")
- (0.09 ":bob!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :alice: Ay, sir; but she will none, she gives you thanks.")
- (0.05 ":alice!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :bob: That man should be at woman's command, and yet no hurt done! Though honesty be no puritan, yet it will do no hurt; it will wear the surplice of humility over the black gown of a big heart. I am going, forsooth: the business is for Helen to come hither.")
- (0.07 ":bob!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :alice: Indeed, I should have asked you that before.")
- (0.09 ":alice!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :bob: Faith, we met, and found the quarrel was upon the seventh cause.")
- (0.05 ":bob!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :alice: And then, I hope, thou wilt be satisfied.")
- (0.06 ":alice!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :bob: Well, I will forget the condition of my estate, to rejoice in yours.")
- (0.05 ":bob!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :alice: Ah! sirrah, this unlook'd-for sport comes well.")
- (0.01 ":alice!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :bob: Mayst thou inherit too! Welcome to Paris.")
- (0.04 ":bob!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :alice: That I would choose, were I to choose anew.")
- (0.08 ":alice!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :bob: Good Tom Drum, lend me a handkercher: so, I thank thee. Wait on me home, I'll make sport with thee: let thy curtsies alone, they are scurvy ones.")
- (0.06 ":bob!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :alice: Excellent workman! Thou canst not paint a man so bad as is thyself.")
- (0.07 ":alice!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :bob: That every braggart shall be found an ass.")
- (0.07 ":bob!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :alice: This is but a custom in your tongue; you bear a graver purpose, I hope.")
- (0.02 ":alice!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :bob: Well, we will have such a prologue, and it shall be written in eight and six.")
- (0.01 ":bob!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :alice: Tell me thy reason why thou wilt marry.")
- (0.06 ":alice!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :bob: According to the measure of their states.")
-
- ;; Unexpected disconnect
- (0.07 ":BouncerServ!BouncerServ@BouncerServ NOTICE tester :disconnected from foonet: failed to handle messages: failed to read IRC command: read tcp [::1]:57224->[::1]:6667: read: software caused connection abort")
- ;; Eventual reconnect
- (1.02 ":BouncerServ!BouncerServ@BouncerServ NOTICE tester :connected to foonet")
- ;; No MOTD or other numerics
- (0.01 ":soju.im 005 tester AWAYLEN=390 BOT=B CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m INVEX KICKLEN=390 :are supported")
- (0.02 ":soju.im 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported")
- (0.02 ":irc.foonet.org 221 tester +Zi")
- (0.23 ":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.")
- ;; Server-initialed join
- (0.02 ":tester!tester@10.0.2.100 JOIN #chan"))
-
-((mode 5 "MODE #chan")
- (0.03 ":soju.im 353 tester = #chan :@alice bob tester")
- (0.03 ":soju.im 366 tester #chan :End of /NAMES list")
- (0.00 ":soju.im 324 tester #chan +nt")
- (0.00 ":soju.im 329 tester #chan 1652878847")
- (0.00 ":bob!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :tester, welcome!")
- (0.00 ":alice!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :tester, welcome!")
- (0.46 ":soju.im 324 tester #chan +nt")
- (0.01 ":soju.im 329 tester #chan 1652878847")
- (0.00 ":bob!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :alice: Thou desirest me to stop in my tale against the hair.")
- (0.07 ":alice!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :bob: But my intents are fix'd and will not leave me.")
- (0.09 ":bob!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :alice: That last is true; the sweeter rest was mine.")
- (0.09 ":alice!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :bob: No matter whither, so you come not here.")
- (0.09 ":bob!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :alice: My lord, in heart; and let the health go round."))
-
-((linger 12 LINGER))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 6 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER tester@vanilla/barnet 0 * :tester")
- (0.00 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
- (0.01 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version ergo-v2.8.0")
- (0.01 ":irc.barnet.org 003 tester :This server was created Thu, 19 May 2022 05:33:02 UTC")
- (0.00 ":irc.barnet.org 004 tester irc.barnet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.barnet.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.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet 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.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0.00 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0.00 ":irc.barnet.org 252 tester 0 :IRC Operators online")
- (0.11 ":irc.barnet.org 254 tester 1 :channels formed")
- (0.00 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers")
- (0.00 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.00 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.00 ":irc.barnet.org 422 tester :MOTD File is missing"))
-
-((mode 5 "MODE tester +i")
- (0.0 ":tester!~u@fsr9fwzfeeybc.irc JOIN #chan")
- (0.05 ":irc.barnet.org 353 tester = #chan :@joe mike tester")
- (0.01 ":irc.barnet.org 366 tester #chan :End of /NAMES list.")
- (0.0 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...")
- (0.0 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :[05:48:13] mike: But send the midwife presently to me.")
- (0.01 ":mike!~u@6t6jcije78we2.irc PRIVMSG #chan :[05:48:18] joe: Alas! poor rogue, I think, i' faith, she loves me.")
- (0.01 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :[05:48:20] mike: They did not bless us with one happy word.")
- (0.01 ":mike!~u@6t6jcije78we2.irc PRIVMSG #chan :[05:48:24] joe: And hear the sentence of your moved prince.")
- (0.21 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :[05:48:29] mike: Swear me to this, and I will ne'er say no.")
- (0.01 ":mike!~u@6t6jcije78we2.irc PRIVMSG #chan :[05:48:32] joe: As they had seen me with these hangman's hands.")
- (0.01 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :[05:48:34] mike: Boyet, prepare: I will away to-night.")
- (0.01 ":mike!~u@6t6jcije78we2.irc PRIVMSG #chan :[05:48:36] joe: For being a little bad: so may my husband.")
- (0.04 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.")
- (0.0 ":irc.barnet.org 221 tester +Zi")
- (2.55 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :mike: And whirl along with thee about the globe."))
-
-((mode 5 "MODE #chan")
- (0.00 ":irc.barnet.org 324 tester #chan +nt")
- (0.00 ":irc.barnet.org 329 tester #chan 1652938384")
- (0.06 ":mike!~u@6t6jcije78we2.irc PRIVMSG #chan :joe: Unless good-counsel may the cause remove.")
- (0.00 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :mike: Thyself domestic officers thine enemy.")
- (0.01 ":mike!~u@6t6jcije78we2.irc PRIVMSG #chan :joe: Go after her: she's desperate; govern her.")
- (0.30 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :mike: Or else to heaven she heaves them for revenge.")
- (0.01 ":mike!~u@6t6jcije78we2.irc PRIVMSG #chan :joe: Keep up your bright swords, for the dew will rust them.")
- (0.04 ":*status!znc@znc.in PRIVMSG tester :Disconnected from IRC (Connection aborted). Reconnecting...")
- (0.41 ":*status!znc@znc.in PRIVMSG tester :Disconnected from IRC. Reconnecting...")
- (0.59 ":*status!znc@znc.in PRIVMSG tester :Connected!")
- (0.02 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
- (0.01 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version ergo-v2.8.0")
- (0.01 ":irc.barnet.org 003 tester :This server was created Thu, 19 May 2022 05:33:02 UTC")
- (0.01 ":irc.barnet.org 004 tester irc.barnet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.01 ":irc.barnet.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.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet 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.22 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0.00 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0.01 ":irc.barnet.org 252 tester 0 :IRC Operators online")
- (0.00 ":irc.barnet.org 253 tester 0 :unregistered connections")
- (0.00 ":irc.barnet.org 254 tester 1 :channels formed")
- (0.00 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers")
- (0.00 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.17 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.00 ":irc.barnet.org 422 tester :MOTD File is missing")
- (0.01 ":irc.barnet.org 221 tester +Zi")
- (0.00 ":irc.barnet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")
- (0.05 ":irc.barnet.org 352 tester * ~u fsr9fwzfeeybc.irc irc.barnet.org tester H :0 ZNC - https://znc.in")
- (0.02 ":irc.barnet.org 315 tester tester!*@* :End of WHO list")
- (0.08 ":tester!~u@fsr9fwzfeeybc.irc JOIN #chan"))
-
-((mode 5 "MODE #chan")
- (0.05 ":irc.barnet.org 353 tester = #chan :mike tester @joe")
- (0.01 ":irc.barnet.org 366 tester #chan :End of NAMES list")
- (0.00 ":mike!~u@6t6jcije78we2.irc PRIVMSG #chan :tester, welcome!")
- (0.00 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :tester, welcome!")
- (0.02 ":irc.barnet.org 324 tester #chan +nt")
- (0.01 ":irc.barnet.org 329 tester #chan 1652938384")
- (0.00 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :mike: See, here he comes, and I must ply my theme.")
- (0.00 ":mike!~u@6t6jcije78we2.irc PRIVMSG #chan :joe: Confine yourself but in a patient list.")
- (0.00 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :mike: And bide the penance of each three years' day.")
- (0.00 ":mike!~u@6t6jcije78we2.irc PRIVMSG #chan :joe: Bid me farewell, and let me hear thee going.")
- (0.00 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :mike: Nor shall not, if I do as I intend.")
- (0.00 ":mike!~u@6t6jcije78we2.irc PRIVMSG #chan :joe: Our corn's to reap, for yet our tithe's to sow.")
- (0.00 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :mike: And almost broke my heart with extreme laughter.")
- (0.00 ":mike!~u@6t6jcije78we2.irc PRIVMSG #chan :joe: Of modern seeming do prefer against him.")
- (0.00 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :mike: Like humble-visag'd suitors, his high will.")
- (0.00 ":mike!~u@6t6jcije78we2.irc PRIVMSG #chan :joe: But yet, poor Claudio! There's no remedy.")
- (0.00 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :mike: Let him make treble satisfaction.")
- (0.00 ":mike!~u@6t6jcije78we2.irc PRIVMSG #chan :joe: He's that he is; I may not breathe my censure.")
- (0.00 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :mike: To check their folly, passion's solemn tears.")
- (0.00 ":mike!~u@6t6jcije78we2.irc PRIVMSG #chan :joe: Villain, I have done thy mother.")
- (0.00 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :mike: Please you, therefore, draw nigh, and take your places.")
- (0.00 ":mike!~u@6t6jcije78we2.irc PRIVMSG #chan :joe: You shall not be admitted to his sight.")
- (0.00 ":joe!~u@6t6jcije78we2.irc PRIVMSG #chan :mike: Sir, you shall present before her the Nine Worthies. Sir Nathaniel, as concerning some entertainment of time, some show in the posterior of this day, to be rendered by our assistance, at the king's command, and this most gallant, illustrate, and learned gentleman, before the princess; I say, none so fit as to present the Nine Worthies.")
- (0.00 ":mike!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :joe: Go to; farewell! put money enough in your purse."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 6 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER tester@vanilla/foonet 0 * :tester")
- (0.16 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.00 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.8.0")
- (0.00 ":irc.foonet.org 003 tester :This server was created Thu, 19 May 2022 05:33:02 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 3 invisible on 1 server(s)")
- (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.00 ":irc.foonet.org 254 tester 1 :channels formed")
- (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.00 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode 6 "MODE tester +i")
- (0.00 ":tester!~u@rmtvrz9zcwbdq.irc JOIN #chan")
- (0.09 ":irc.foonet.org 353 tester = #chan :@alice bob tester")
- (0.00 ":irc.foonet.org 366 tester #chan :End of /NAMES list.")
- (0.00 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...")
- (0.00 ":bob!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :[05:48:11] alice: And be aveng'd on cursed Tamora.")
- (0.00 ":alice!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :[05:48:13] bob: The stronger part of it by her own letters, which make her story true, even to the point of her death: her death itself, which could not be her office to say is come, was faithfully confirmed by the rector of the place.")
- (0.01 ":bob!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :[05:48:15] alice: The ape is dead, and I must conjure him.")
- (0.00 ":alice!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :[05:48:17] bob: Not so; but I answer you right painted cloth, from whence you have studied your questions.")
- (0.01 ":bob!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :[05:48:21] alice: The valiant Paris seeks you for his love.")
- (0.00 ":alice!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :[05:48:26] bob: To prison with her; and away with him.")
- (0.00 ":bob!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :[05:48:30] alice: Tell them there I have gold; look, so I have.")
- (0.00 ":alice!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :[05:48:35] bob: Will even weigh, and both as light as tales.")
- (0.00 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.")
- (0.00 ":irc.foonet.org 221 tester +Zi")
- (0.08 ":bob!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :alice: By some vile forfeit of untimely death."))
-
-((mode 3.51 "MODE #chan")
- (0.1 ":irc.foonet.org 324 tester #chan +nt")
- (0.0 ":irc.foonet.org 329 tester #chan 1652938384")
- (0.0 ":alice!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :bob: What does this knave here ? Get you gone, sirrah: the complaints I have heard of you I do not all believe: 'tis my slowness that I do not; for I know you lack not folly to commit them, and have ability enough to make such knaveries yours.")
- (0.0 ":bob!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :alice: When sects and factions were newly born.")
- (0.1 ":alice!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :bob: Fall, when Love please! marry, to each, but one.")
- (0.1 ":bob!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :alice: For I ne'er saw true beauty till this night.")
- (0.1 ":alice!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :bob: Or say, sweet love, what thou desir'st to eat.")
- (0.1 ":bob!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :alice: Yes, and will nobly him remunerate.")
- (0.1 ":*status!znc@znc.in PRIVMSG tester :Disconnected from IRC (Connection aborted). Reconnecting...")
- (0.4 ":*status!znc@znc.in PRIVMSG tester :Disconnected from IRC. Reconnecting...")
- (0.9 ":*status!znc@znc.in PRIVMSG tester :Connected!")
- (0.0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.8.0")
- (0.0 ":irc.foonet.org 003 tester :This server was created Thu, 19 May 2022 05:33:02 UTC")
- (0.0 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.1 ":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.0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0.0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0.0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0.0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0.1 ":irc.foonet.org 254 tester 1 :channels formed")
- (0.0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0.0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.0 ":irc.foonet.org 422 tester :MOTD File is missing")
- (0.0 ":irc.foonet.org 221 tester +Zi")
- (0.0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")
- (0.6 ":irc.foonet.org 352 tester * ~u rmtvrz9zcwbdq.irc irc.foonet.org tester H :0 ZNC - https://znc.in")
- (0.0 ":irc.foonet.org 315 tester tester!*@* :End of WHO list")
- (0.0 ":tester!~u@rmtvrz9zcwbdq.irc JOIN #chan"))
-
-((mode 6 "MODE #chan")
- (0.0 ":irc.foonet.org 353 tester = #chan :@alice bob tester")
- (0.0 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.0 ":alice!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :tester, welcome!")
- (0.0 ":bob!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :tester, welcome!")
- (0.0 ":alice!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :bob: Being of no power to make his wishes good.")
- (0.0 ":irc.foonet.org 324 tester #chan +nt")
- (0.0 ":irc.foonet.org 329 tester #chan 1652938384")
- (0.0 ":bob!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :alice: In everything I wait upon his will.")
- (0.0 ":alice!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :bob: Make choice of which your highness will see first.")
- (0.0 ":bob!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :alice: We waste our lights in vain, like lamps by day.")
- (0.0 ":alice!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :bob: No, I know that; but it is fit I should commit offence to my inferiors.")
- (0.1 ":bob!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :alice: By my head, here come the Capulets.")
- (0.0 ":alice!~u@rmtvrz9zcwbdq.irc PRIVMSG #chan :bob: Well, I will forget the condition of my estate, to rejoice in yours.")
- (0.0 ":bob!~u@h35cf3bf7rbt4.irc PRIVMSG #chan :alice: My lord, in heart; and let the health go round."))
-
-((linger 12 LINGER))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :changeme"))
-((nick 10 "NICK tester"))
-((user 10 "USER tester@vanilla/foonet 0 * :tester")
- (0.00 ":irc.znc.in 001 tester :Welcome to ZNC")
- (0.03 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...")
- (0.01 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...")
- (0.00 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...")
- (0.01 ":*status!znc@znc.in PRIVMSG tester :Connected!")
- (0.02 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.01 ":irc.foonet.org 003 tester :This server was created Wed, 31 Jan 2024 10:58:16 UTC")
- (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
- (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0.00 ":irc.foonet.org 254 tester 1 :channels formed")
- (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.00 ":irc.foonet.org 422 tester :MOTD File is missing")
- (0.00 ":irc.foonet.org 221 tester +Zi")
- (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."))
-
-((mode 10 "MODE tester +i")
- (0.01 ":irc.foonet.org 352 tester * ~u pfa3tpa5ig5ty.irc irc.foonet.org tester H :0 ZNC - https://znc.in")
- (0.01 ":irc.foonet.org 315 tester tester :End of WHO list")
-
- (0.02 ":tester!~u@pfa3tpa5ig5ty.irc JOIN #chan")
- (0.03 ":irc.foonet.org 353 tester = #chan :bob tester @alice eve"))
-
-((mode 10 "MODE #chan")
- (0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.00 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!")
- (0.01 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!")
- (0.01 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: And see how he will take it at your hands.")
- (0.02 ":irc.foonet.org 221 tester +Zi")
- (0.01 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Fear not, my lord, your servant shall do so.")
- (0.02 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: If I thrive well, I'll visit thee again.")
- (0.01 ":irc.foonet.org 324 tester #chan +Cnt")
- (0.03 ":irc.foonet.org 329 tester #chan 1706698713")
- (0.05 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Let it be forbid, sir; so should I be a great deal of his act.")
- (0.04 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: And see a fearful sight of blood and death.")
- (0.00 ":eve!~u@euegh6mj3y8r2.irc PRIVMSG #chan :hola")
- (0.01 ":eve!~u@euegh6mj3y8r2.irc NICK :Evel")
- (0.01 ":Evel!~u@euegh6mj3y8r2.irc PRIVMSG #chan :hell o")
- (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: His highness comes post from Marseilles, of as able body as when he numbered thirty: he will be here to-morrow, or I am deceived by him that in such intelligence hath seldom failed.")
- (0.03 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: See, by good hap, yonder's my lord; I have sweat to see his honour.")
- (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: With the rich worth of your virginity.")
-
- (0.02 ":*status!znc@znc.in PRIVMSG tester :Disconnected from IRC. Reconnecting...")
- (0.05 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...")
- (0.03 ":*status!znc@znc.in PRIVMSG tester :Connected!")
- (0.01 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.04 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.01 ":irc.foonet.org 003 tester :This server was created Wed, 31 Jan 2024 10:58:16 UTC")
- (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.03 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
- (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0.00 ":irc.foonet.org 254 tester 1 :channels formed")
- (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.00 ":irc.foonet.org 422 tester :MOTD File is missing")
- (0.02 ":irc.foonet.org 221 tester +i")
- (0.01 ":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 352 tester * ~u hrn2ea3rpeyck.irc irc.foonet.org tester H :0 ZNC - https://znc.in")
- (0.01 ":irc.foonet.org 315 tester tester :End of WHO list")
- (0.02 ":tester!~u@hrn2ea3rpeyck.irc JOIN #chan"))
-
-((mode 10 "MODE #chan")
- (0.00 ":irc.foonet.org 353 tester = #chan :tester @alice bob")
- (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.00 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!")
- (0.01 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!")
- (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Nay, I assure you, a peace concluded.")
- (0.03 ":irc.foonet.org 324 tester #chan +Cnt")
- (0.01 ":irc.foonet.org 329 tester #chan 1706698713")
- (0.05 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: But, in defence, by mercy, 'tis most just.")
- (0.04 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Or to drown my clothes, and say I was stripped."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :unknown")
- (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
- (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.barnet.org 003 tester :This server was created Tue, 04 May 2021 05:06:19 UTC")
- (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.barnet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.barnet.org 253 tester 0 :unregistered connections")
- (0 ":irc.barnet.org 254 tester 1 :channels formed")
- (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0 ":irc.barnet.org 221 tester +i")
- (0 ":irc.barnet.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."))
-
-((join 10 "JOIN #bar")
- (0 ":tester!~u@jnu48g2wrycbw.irc JOIN #bar")
- (0 ":irc.barnet.org 353 tester = #bar :@mike joe tester")
- (0 ":irc.barnet.org 366 tester #bar :End of NAMES list"))
-
-((mode-bar 10 "MODE #bar")
- (0 ":irc.barnet.org 324 tester #bar +nt")
- (0 ":irc.barnet.org 329 tester #bar 1620104779")
- (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :tester, welcome!")
- (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :tester, welcome!")
- (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: Whipp'd first, sir, and hang'd after.")
- (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: We have yet many among us can gripe as hard as Cassibelan; I do not say I am one, but I have a hand. Why tribute ? why should we pay tribute ? If C sar can hide the sun from us with a blanket, or put the moon in his pocket, we will pay him tribute for light; else, sir, no more tribute, pray you now."))
-
-((privmsg-2 10 "PRIVMSG #bar :2 barnet only")
- (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: Double and treble admonition, and still forfeit in the same kind ? This would make mercy swear, and play the tyrant.")
- (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: And secretly to greet the empress' friends."))
-
-((privmsg-4 10 "PRIVMSG #bar :\1ACTION 4 barnet only\1")
- (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: You have not been inquired after: I have sat here all day.")
- (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: That same Berowne I'll torture ere I go."))
-
-((privmsg-5 10 "PRIVMSG #bar :5 all nets"))
-
-((privmsg-6 10 "PRIVMSG #bar :\1ACTION 6 all nets\1")
- (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: For mine own part,no offence to the general, nor any man of quality,I hope to be saved.")
- (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: Mehercle! if their sons be ingenuous, they shall want no instruction; if their daughters be capable, I will put it to them. But, vir sapit qui pauca loquitur. A soul feminine saluteth us."))
-
-((quit 5 "QUIT :\2ERC\2")
- (0 ":tester!~u@jnu48g2wrycbw.irc QUIT :Quit"))
-
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :unknown")
- (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((join 10 "JOIN #foo")
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #foo")
- (0 ":irc.foonet.org 353 tester = #foo :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #foo :End of NAMES list"))
-
-((mode-foo 10 "MODE #foo")
- (0 ":irc.foonet.org 324 tester #foo +nt")
- (0 ":irc.foonet.org 329 tester #foo 1620104779")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :tester, welcome!")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :tester, welcome!")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: But, as it seems, did violence on herself.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Well, this is the forest of Arden."))
-
-((privmsg-1 10 "PRIVMSG #foo :1 foonet only")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Signior Iachimo will not from it. Pray, let us follow 'em.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Our queen and all her elves come here anon."))
-
-((privmsg-3 10 "PRIVMSG #foo :\1ACTION 3 foonet only\1")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: The ground is bloody; search about the churchyard.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: You have discharged this honestly: keep it to yourself. Many likelihoods informed me of this before, which hung so tottering in the balance that I could neither believe nor misdoubt. Pray you, leave me: stall this in your bosom; and I thank you for your honest care. I will speak with you further anon."))
-
-((privmsg-5 10 "PRIVMSG #foo :5 all nets"))
-
-((privmsg-6 10 "PRIVMSG #foo :\1ACTION 6 all nets\1")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Give me that mattock, and the wrenching iron.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Stand you! You have land enough of your own; but he added to your having, gave you some ground."))
-
-((privmsg-6 10 "PRIVMSG #foo :7 all live nets")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Excellent workman! Thou canst not paint a man so bad as is thyself."))
-
-((privmsg-6 10 "PRIVMSG #foo :\1ACTION 8 all live nets\1")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: And will you, being a man of your breeding, be married under a bush, like a beggar ? Get you to church, and have a good priest that can tell you what marriage is: this fellow will but join you together as they join wainscot; then one of you will prove a shrunk panel, and like green timber, warp, warp.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Live, and be prosperous; and farewell, good fellow."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 12 Mar 2023 02:30:29 UTC")
- (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
- (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0.00 ":irc.foonet.org 254 tester 1 :channels formed")
- (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0.00 ":irc.foonet.org 375 tester :- irc.foonet.org Message of the day - ")
- (0.00 ":irc.foonet.org 372 tester :- This is the default Ergo MOTD.")
- (0.01 ":irc.foonet.org 372 tester :- ")
- (0.02 ":irc.foonet.org 372 tester :- For more information on using these, see MOTDFORMATTING.md")
- (0.00 ":irc.foonet.org 376 tester :End of MOTD command"))
-
-((mode 10 "MODE tester +i")
- (0.00 ":irc.foonet.org 221 tester +i")
- (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")
- (0.05 ":irc.foonet.org 221 tester +i"))
-
-((motd-1 10 "MOTD")
- (0.08 ":irc.foonet.org 375 tester :- irc.foonet.org Message of the day - ")
- (0.02 ":irc.foonet.org 372 tester :- This is the default Ergo MOTD.")
- (0.01 ":irc.foonet.org 372 tester :- ")
- (0.00 ":irc.foonet.org 372 tester :- For more information on using these, see MOTDFORMATTING.md")
- (0.00 ":irc.foonet.org 376 tester :End of MOTD command"))
-
-((motd-2 10 "MOTD irc1.foonet.org")
- (0.08 ":irc1.foonet.org 375 tester :- irc1.foonet.org Message of the day - ")
- (0.02 ":irc1.foonet.org 372 tester :- This is the default Ergo MOTD.")
- (0.01 ":irc1.foonet.org 372 tester :- ")
- (0.00 ":irc1.foonet.org 372 tester :- For more information on using these, see MOTDFORMATTING.md")
- (0.00 ":irc1.foonet.org 376 tester :End of MOTD command"))
-
-((motd-3 10 "MOTD fake.foonet.org")
- (0.00 ":irc.foonet.org 402 tester fake.foonet.org :No such server"))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.07 ":tester!~u@h3f95zveyc38a.irc QUIT :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)")
- (0.01 "ERROR :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0.07 ":ircnet.hostsailor.com 020 * :Please wait while we process your connection.")
- (0.03 ":ircnet.hostsailor.com 001 tester :Welcome to the Internet Relay Network tester!~user@93.184.216.34")
- (0.02 ":ircnet.hostsailor.com 002 tester :Your host is ircnet.hostsailor.com, running version 2.11.2p3+0PNv1.06")
- (0.03 ":ircnet.hostsailor.com 003 tester :This server was created Thu May 20 2021 at 17:13:24 EDT")
- (0.01 ":ircnet.hostsailor.com 004 tester ircnet.hostsailor.com 2.11.2p3+0PNv1.06 aoOirw abeiIklmnoOpqrRstv")
- (0.00 ":ircnet.hostsailor.com 005 tester RFC2812 PREFIX=(ov)@+ CHANTYPES=#&!+ MODES=3 CHANLIMIT=#&!+:42 NICKLEN=15 TOPICLEN=255 KICKLEN=255 MAXLIST=beIR:64 CHANNELLEN=50 IDCHAN=!:5 CHANMODES=beIR,k,l,imnpstaqrzZ :are supported by this server")
- (0.01 ":ircnet.hostsailor.com 005 tester PENALTY FNC EXCEPTS=e INVEX=I CASEMAPPING=ascii NETWORK=IRCnet :are supported by this server")
- (0.01 ":ircnet.hostsailor.com 042 tester 0PNHANAWX :your unique ID")
- (0.01 ":ircnet.hostsailor.com 251 tester :There are 18711 users and 2 services on 26 servers")
- (0.01 ":ircnet.hostsailor.com 252 tester 63 :operators online")
- (0.01 ":ircnet.hostsailor.com 253 tester 4 :unknown connections")
- (0.01 ":ircnet.hostsailor.com 254 tester 10493 :channels formed")
- (0.01 ":ircnet.hostsailor.com 255 tester :I have 933 users, 0 services and 1 servers")
- (0.01 ":ircnet.hostsailor.com 265 tester 933 1328 :Current local users 933, max 1328")
- (0.01 ":ircnet.hostsailor.com 266 tester 18711 25625 :Current global users 18711, max 25625")
- (0.02 ":ircnet.hostsailor.com 375 tester :- ircnet.hostsailor.com Message of the Day - ")
- (0.01 ":ircnet.hostsailor.com 372 tester :- 17/11/2023 3:08")
- (0.02 ":ircnet.hostsailor.com 376 tester :End of MOTD command."))
-
-((mode 10 "MODE tester +i")
- (0.00 ":ircnet.hostsailor.com NOTICE tester :Your connection is secure (SSL/TLS).")
- (0.01 ":tester MODE tester :+i"))
-
-((squery 10 "SQUERY alis :help list")
- (0.08 ":Alis@hub.uk NOTICE tester :Searches for a channel")
- (0.01 ":Alis@hub.uk NOTICE tester :/SQUERY Alis LIST mask [-options]")
- (0.04 ":Alis@hub.uk NOTICE tester :[...]")
- (0.01 ":Alis@hub.uk NOTICE tester :See also: HELP EXAMPLES"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :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 Tue, 04 May 2021 05:06:18 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((join 10 "JOIN #chan")
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-
-((mode-chan 10 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620104779")
- (0 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
- (0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!"))
-
-((vhost 10 "VHOST tester changeme")
- (0 ":irc.foonet.org NOTICE tester :Setting your VHost: some.host.test.cc")
- (0 ":irc.foonet.org 396 tester some.host.test.cc :is now your displayed host")
- (0 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: But, as it seems, did violence on herself.")
- (0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Well, this is the forest of Arden."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((open 10 "Hi")
- (0 "Hola"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "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 Mon, 31 May 2021 09:56:24 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 254 tester 2 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4")
- (0 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- ;; No mode answer
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")
- (0.2 ":dummy!~u@34n9brushbpj2.irc PRIVMSG tester :\C-aDCC CHAT chat 2130706433 " port "\C-a"))
+++ /dev/null
-;;; erc-d-i.el --- IRC helpers for ERC test server -*- lexical-binding: t -*-
-
-;; Copyright (C) 2020-2025 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 'cl-lib)
-(require 'subr-x)
-
-(cl-defstruct (erc-d-i-message (:conc-name erc-d-i-message.))
- "Identical to `erc-response'.
-When member `compat' is nil, it means the raw message was decoded as
-UTF-8 text before parsing, which is nonstandard."
- (unparsed "" :type string)
- (sender "" :type string)
- (command "" :type string)
- (command-args nil :type (list-of string))
- (contents "" :type string)
- (tags nil :type (list-of (cons symbol string)))
- (compat t :type boolean))
-
-(defconst erc-d-i--tag-escapes
- '((";" . "\\:") (" " . "\\s") ("\\" . "\\\\") ("\r" . "\\r") ("\n" . "\\n")))
-
-;; These are not mirror inverses; unescaping may drop stranded or
-;; misplaced backslashes.
-
-(defconst erc-d-i--tag-escaped-regexp (rx (or ?\; ?\ ?\\ ?\r ?\n)))
-
-(defconst erc-d-i--tag-unescaped-regexp
- (rx (or "\\:" "\\s" "\\\\" "\\r" "\\n"
- (seq "\\" (or string-end (not (or ":" "s" "n" "r" "\\")))))))
-
-(defun erc-d-i--unescape-tag-value (str)
- "Undo substitution of char placeholders in raw tag value STR."
- (replace-regexp-in-string erc-d-i--tag-unescaped-regexp
- (lambda (s)
- (or (car (rassoc s erc-d-i--tag-escapes))
- (substring s 1)))
- str t t))
-
-(defun erc-d-i--escape-tag-value (str)
- "Swap out banned chars in tag value STR with message representation."
- (replace-regexp-in-string erc-d-i--tag-escaped-regexp
- (lambda (s)
- (cdr (assoc s erc-d-i--tag-escapes)))
- str t t))
-
-(defconst erc-d-i--invalid-tag-regexp (rx (any "\0\7\r\n; ")))
-
-(defun erc-d-i--validate-tags (raw)
- "Validate tags portion of some RAW incoming message.
-RAW must not have a leading \"@\" or a trailing space. The spec says
-validation shouldn't be performed on keys and that undecodeable values
-or ones with illegal (unescaped) chars may be dropped. This does not
-respect any of that. Its purpose is to catch bad input created by us."
- (unless (> 4094 (string-bytes raw))
- ;; 417 ERR_INPUTTOOLONG Input line was too long
- (error "Message tags exceed 4094 bytes: %S" raw))
- (let (tags
- (tag-strings (split-string raw ";")))
- (dolist (s tag-strings (nreverse tags))
- (let* ((m (if (>= emacs-major-version 28)
- (string-search "=" s)
- (string-match-p "=" s)))
- (key (if m (substring s 0 m) s))
- (val (when-let* (m ; check first, like (m), but shadow
- (v (substring s (1+ m)))
- ((not (string-equal v ""))))
- (when (string-match-p erc-d-i--invalid-tag-regexp v)
- (error "Bad tag: %s" s))
- (thread-first v
- (decode-coding-string 'utf-8 t)
- (erc-d-i--unescape-tag-value)))))
- (when (string-empty-p key)
- (error "Tag missing key: %S" s))
- (setf (alist-get (intern key) tags) val)))))
-
-(defun erc-d-i--parse-message (s &optional decode)
- "Parse string S into `erc-d-i-message' object.
-With DECODE, decode as UTF-8 text."
- (when (string-suffix-p "\r\n" s)
- (error "Unstripped message encountered"))
- (when decode
- (setq s (decode-coding-string s 'utf-8 t)))
- (let ((mes (make-erc-d-i-message :unparsed s :compat (not decode)))
- tokens)
- (when-let (((not (string-empty-p s)))
- ((eq ?@ (aref s 0)))
- (m (string-match " " s))
- (u (substring s 1 m)))
- (setf (erc-d-i-message.tags mes) (erc-d-i--validate-tags u)
- s (substring s (1+ m))))
- (if-let ((m (string-search " :" s))
- (other-toks (split-string (substring s 0 m) " " t))
- (rest (substring s (+ 2 m))))
- (setf (erc-d-i-message.contents mes) rest
- tokens (nconc other-toks (list rest)))
- (setf tokens (split-string s " " t " ")
- (erc-d-i-message.contents mes) (car (last tokens))))
- (when (and tokens (eq ?: (aref (car tokens) 0)))
- (setf (erc-d-i-message.sender mes) (substring (pop tokens) 1)))
- (setf (erc-d-i-message.command mes) (or (pop tokens) "")
- (erc-d-i-message.command-args mes) tokens)
- mes))
-
-(provide 'erc-d-i)
-;;; erc-d-i.el ends here
+++ /dev/null
-;;; erc-d-t.el --- ERT helpers for ERC test server -*- lexical-binding: t -*-
-
-;; Copyright (C) 2020-2025 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:
-
-(eval-and-compile
- (let* ((d (file-name-directory (or (macroexp-file-name) buffer-file-name)))
- (load-path (cons (directory-file-name d) load-path)))
- (require 'erc-d-u)))
-
-(require 'ert)
-
-(defun erc-d-t-kill-related-buffers ()
- "Kill all erc- or erc-d- related buffers."
- (let (buflist)
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (when (or erc-d-u--process-buffer
- (derived-mode-p 'erc-mode 'erc-dcc-chat-mode))
- (push buf buflist))))
- (dolist (buf buflist)
- (when (and (boundp 'erc-server-flood-timer)
- (timerp erc-server-flood-timer))
- (cancel-timer erc-server-flood-timer))
- (when-let ((proc (get-buffer-process buf)))
- (delete-process proc))
- (when (buffer-live-p buf)
- (kill-buffer buf))))
- (while (when-let ((buf (pop erc-d-u--canned-buffers)))
- (kill-buffer buf))))
-
-(defun erc-d-t-silence-around (orig &rest args)
- "Run ORIG function with ARGS silently.
-Use this on `erc-handle-login' and `erc-server-connect'."
- (let ((inhibit-message t))
- (apply orig args)))
-
-(defvar erc-d-t-cleanup-sleep-secs 0.1)
-
-(defmacro erc-d-t-with-cleanup (bindings cleanup &rest body)
- "Execute BODY and run CLEANUP form regardless of outcome.
-`let*'-bind BINDINGS and make them available in BODY and CLEANUP.
-After CLEANUP, destroy any values in BINDINGS that remain bound to
-buffers or processes. Sleep `erc-d-t-cleanup-sleep-secs' before
-returning."
- (declare (indent 2))
- `(let* ,bindings
- (unwind-protect
- (progn ,@body)
- ,cleanup
- (when noninteractive
- (let (bufs procs)
- (dolist (o (list ,@(mapcar (lambda (b) (or (car-safe b) b))
- bindings)))
- (when (bufferp o)
- (push o bufs))
- (when (processp o)
- (push o procs)))
- (dolist (proc procs)
- (delete-process proc)
- (when-let ((buf (process-buffer proc)))
- (push buf bufs)))
- (dolist (buf bufs)
- (when-let ((proc (get-buffer-process buf)))
- (delete-process proc))
- (when (bufferp buf)
- (ignore-errors (kill-buffer buf)))))
- (sleep-for erc-d-t-cleanup-sleep-secs)))))
-
-(defvar erc-d-t--wait-message-prefix "Awaiting: ")
-
-(defmacro erc-d-t-wait-for (max-secs msg &rest body)
- "Wait for BODY to become non-nil.
-Or signal error with MSG after MAX-SECS. When MAX-SECS is negative,
-signal if BODY is ever non-nil before MAX-SECS elapses. On success,
-return BODY's value.
-
-Note: this assumes BODY is waiting on a peer's output. It tends to
-artificially accelerate consumption of all process output, which may not
-be desirable."
- (declare (indent 2))
- (unless (or (stringp msg) (memq (car-safe msg) '(format concat)))
- (push msg body)
- (setq msg (prin1-to-string body)))
- (let ((inverted (make-symbol "inverted"))
- (time-out (make-symbol "time-out"))
- (result (make-symbol "result")))
- `(ert-info ((concat erc-d-t--wait-message-prefix ,msg))
- (let ((,time-out (abs ,max-secs))
- (,inverted (< ,max-secs 0))
- (,result ',result))
- (with-timeout (,time-out (if ,inverted
- (setq ,inverted nil)
- (error "Failed awaiting: %s" ,msg)))
- (while (not (setq ,result (progn ,@body)))
- (when (and (accept-process-output nil 0.1) (not noninteractive))
- (redisplay))))
- (when ,inverted
- (error "Failed awaiting: %s" ,msg))
- ,result))))
-
-(defmacro erc-d-t-ensure-for (max-secs msg &rest body)
- "Ensure BODY remains non-nil for MAX-SECS.
-On failure, emit MSG."
- (declare (indent 2))
- (unless (or (stringp msg) (memq (car-safe msg) '(format concat)))
- (push msg body)
- (setq msg (prin1-to-string body)))
- `(let ((erc-d-t--wait-message-prefix "Sustaining: "))
- (erc-d-t-wait-for (- (abs ,max-secs)) ,msg (not (progn ,@body)))))
-
-(defun erc-d-t-search-for (timeout text &optional from on-success)
- "Wait for TEXT to appear in current buffer before TIMEOUT secs.
-With marker or number FROM, only consider the portion of the buffer from
-that point forward. If TEXT is a cons, interpret it as an RX regular
-expression. If ON-SUCCESS is a function, call it when TEXT is found."
- (save-restriction
- (widen)
- (let* ((rxp (consp text))
- (fun (if rxp #'search-forward-regexp #'search-forward))
- (pat (if rxp (rx-to-string text) text))
- res)
- (erc-d-t-wait-for timeout (format "string: %s" text)
- (goto-char (or from (point-min)))
- (setq res (funcall fun pat nil t))
- (if (and on-success res)
- (funcall on-success)
- res)))))
-
-(defun erc-d-t-absent-for (timeout text &optional from on-success)
- "Assert TEXT doesn't appear in current buffer for TIMEOUT secs."
- (erc-d-t-search-for (- (abs timeout)) text from on-success))
-
-(defun erc-d-t-make-expecter ()
- "Return function to search for new output in buffer.
-Assume new text is only inserted at or after `erc-insert-marker'.
-
-The returned function works like `erc-d-t-search-for', but it never
-revisits previously covered territory, and the optional fourth argument,
-ON-SUCCESS, is nonexistent. To reset, specify a FROM argument."
- (let (positions)
- (lambda (timeout text &optional reset-from)
- (let* ((pos (cdr (assq (current-buffer) positions)))
- (erc-d-t--wait-message-prefix (and (< timeout 0) "Sustaining: "))
- (cb (lambda ()
- (unless pos
- (push (cons (current-buffer) (setq pos (make-marker)))
- positions))
- (marker-position
- (set-marker pos (min (point) (1- (point-max))))))))
- (when reset-from
- (set-marker pos reset-from))
- (erc-d-t-search-for timeout text pos cb)))))
-
-(provide 'erc-d-t)
-;;; erc-d-t.el ends here
+++ /dev/null
-;;; erc-d-tests.el --- tests for erc-d -*- lexical-binding: t -*-
-
-;; Copyright (C) 2020-2025 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 (expand-file-name ".." (ert-resource-directory))
- load-path)))
- (require 'erc-d)
- (require 'erc-d-t)))
-
-(require 'erc)
-
-;; Temporary kludge to silence warning
-(put 'erc-parse-tags 'erc-v3-warned-p t)
-
-(ert-deftest erc-d-u--canned-load-dialog--basic ()
- (should-not (get-buffer "basic.eld"))
- (should-not erc-d-u--canned-buffers)
- (let* ((exes (erc-d-u--canned-load-dialog 'basic))
- (reap (lambda ()
- (cl-loop with e = (erc-d-u--read-dialog exes)
- for s = (erc-d-u--read-exchange e)
- while s collect s))))
- (should (get-buffer "basic.eld"))
- (should (memq (get-buffer "basic.eld") erc-d-u--canned-buffers))
- (should (equal (funcall reap) '((pass 10.0 "PASS " (? ?:) "changeme"))))
- (should (equal (funcall reap) '((nick 0.2 "NICK tester"))))
- (let ((r (funcall reap)))
- (should (equal (car r) '(user 0.2 "USER user 0 * :tester")))
- (should (equal
- (car (last r))
- '(0 ":irc.example.org 422 tester :MOTD File is missing"))))
- (should (equal (car (funcall reap)) '(mode-user 5 "MODE tester +i")))
- (should (equal (funcall reap)
- '((mode-chan 3.2 "MODE #chan")
- (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))))
- ;; See `define-error' site for `iter-end-of-sequence'
- (ert-info ("EOB detected") (should-not (erc-d-u--read-dialog exes))))
- (should-not (get-buffer "basic.eld"))
- (should-not erc-d-u--canned-buffers))
-
-(defun erc-d-tests--make-hunk-reader (hunks)
- (let ((p (erc-d-u--read-dialog hunks)))
- (lambda () (erc-d-u--read-exchange p))))
-
-;; Fuzzies need to be able to access any non-exhausted genny.
-(ert-deftest erc-d-u--canned-load-dialog--intermingled ()
- (should-not (get-buffer "basic.eld"))
- (should-not erc-d-u--canned-buffers)
- (let* ((exes (erc-d-u--canned-load-dialog 'basic))
- (pass (erc-d-tests--make-hunk-reader exes))
- (nick (erc-d-tests--make-hunk-reader exes))
- (user (erc-d-tests--make-hunk-reader exes))
- (modu (erc-d-tests--make-hunk-reader exes))
- (modc (erc-d-tests--make-hunk-reader exes)))
-
- (should (equal (funcall user) '(user 0.2 "USER user 0 * :tester")))
- (should (equal (funcall modu) '(mode-user 5 "MODE tester +i")))
- (should (equal (funcall modc) '(mode-chan 3.2 "MODE #chan")))
-
- (cl-loop repeat 8 do (funcall user)) ; skip a few
- (should (equal (funcall user)
- '(0 ":irc.example.org 254 tester 1 :channels formed")))
- (should (equal (funcall modu)
- '(0 ":irc.example.org 221 tester +Zi")))
- (should (equal (cl-loop for s = (funcall modc) while s collect s) ; done
- '((0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))))
-
- (cl-loop repeat 3 do (funcall user))
- (cl-loop repeat 3 do (funcall modu))
-
- (ert-info ("Change up the order")
- (should
- (equal (funcall modu)
- '(0 ":irc.example.org 366 alice #chan :End of NAMES list")))
- (should
- (equal (funcall user)
- '(0 ":irc.example.org 422 tester :MOTD File is missing"))))
-
- ;; Exhaust these
- (should (equal (cl-loop for s = (funcall pass) while s collect s) ; done
- '((pass 10.0 "PASS " (? ?:) "changeme"))))
- (should (equal (cl-loop for s = (funcall nick) while s collect s) ; done
- '((nick 0.2 "NICK tester"))))
-
- (ert-info ("End of file but no teardown because hunks outstanding")
- (should-not (erc-d-u--read-dialog exes))
- (should (get-buffer "basic.eld")))
-
- ;; Finish
- (should-not (funcall user))
- (should-not (funcall modu)))
-
- (should-not (get-buffer "basic.eld"))
- (should-not erc-d-u--canned-buffers))
-
-;; This indirectly tests `erc-d-u--canned-read' cleanup/teardown
-
-(ert-deftest erc-d-u--rewrite-for-slow-mo ()
- (should-not (get-buffer "basic.eld"))
- (should-not (get-buffer "basic.eld<2>"))
- (should-not (get-buffer "basic.eld<3>"))
- (should-not erc-d-u--canned-buffers)
- (let ((exes (erc-d-u--canned-load-dialog 'basic))
- (exes-lower (erc-d-u--canned-load-dialog 'basic))
- (exes-custom (erc-d-u--canned-load-dialog 'basic))
- (reap (lambda (e) (cl-loop with p = (erc-d-u--read-dialog e)
- for s = (erc-d-u--read-exchange p)
- while s collect s))))
- (should (get-buffer "basic.eld"))
- (should (get-buffer "basic.eld<2>"))
- (should (get-buffer "basic.eld<3>"))
- (should (equal (list (get-buffer "basic.eld<3>")
- (get-buffer "basic.eld<2>")
- (get-buffer "basic.eld"))
- erc-d-u--canned-buffers))
-
- (ert-info ("Rewrite for slowmo basic")
- (setq exes (erc-d-u--rewrite-for-slow-mo 10 exes))
- (should (equal (funcall reap exes)
- '((pass 20.0 "PASS " (? ?:) "changeme"))))
- (should (equal (funcall reap exes)
- '((nick 10.2 "NICK tester"))))
- (let ((r (funcall reap exes)))
- (should (equal (car r) '(user 10.2 "USER user 0 * :tester")))
- (should (equal
- (car (last r))
- '(0 ":irc.example.org 422 tester :MOTD File is missing"))))
- (should (equal (car (funcall reap exes))
- '(mode-user 15 "MODE tester +i")))
- (should (equal (car (funcall reap exes))
- '(mode-chan 13.2 "MODE #chan")))
- (should-not (erc-d-u--read-dialog exes)))
-
- (ert-info ("Rewrite for slowmo bounded")
- (setq exes-lower (erc-d-u--rewrite-for-slow-mo -5 exes-lower))
- (should (equal (funcall reap exes-lower)
- '((pass 10.0 "PASS " (? ?:) "changeme"))))
- (should (equal (funcall reap exes-lower)
- '((nick 5 "NICK tester"))))
- (should (equal (car (funcall reap exes-lower))
- '(user 5 "USER user 0 * :tester")))
- (should (equal (car (funcall reap exes-lower))
- '(mode-user 5 "MODE tester +i")))
- (should (equal (car (funcall reap exes-lower))
- '(mode-chan 5 "MODE #chan")))
- (should-not (erc-d-u--read-dialog exes-lower)))
-
- (ert-info ("Rewrite for slowmo custom")
- (setq exes-custom (erc-d-u--rewrite-for-slow-mo
- (lambda (n) (* 2 n)) exes-custom))
- (should (equal (funcall reap exes-custom)
- '((pass 20.0 "PASS " (? ?:) "changeme"))))
- (should (equal (funcall reap exes-custom)
- '((nick 0.4 "NICK tester"))))
- (should (equal (car (funcall reap exes-custom))
- '(user 0.4 "USER user 0 * :tester")))
- (should (equal (car (funcall reap exes-custom))
- '(mode-user 10 "MODE tester +i")))
- (should (equal (car (funcall reap exes-custom))
- '(mode-chan 6.4 "MODE #chan")))
- (should-not (erc-d-u--read-dialog exes-custom))))
-
- (should-not (get-buffer "basic.eld"))
- (should-not (get-buffer "basic.eld<2>"))
- (should-not (get-buffer "basic.eld<3>"))
- (should-not erc-d-u--canned-buffers))
-
-(ert-deftest erc-d--active-ex-p ()
- (let ((ring (make-ring 5)))
- (ert-info ("Empty ring returns nil for not active")
- (should-not (erc-d--active-ex-p ring)))
- (ert-info ("One fuzzy member returns nil for not active")
- (ring-insert ring (make-erc-d-exchange :tag '~foo))
- (should-not (erc-d--active-ex-p ring)))
- (ert-info ("One active member returns t for active")
- (ring-insert-at-beginning ring (make-erc-d-exchange :tag 'bar))
- (should (erc-d--active-ex-p ring)))))
-
-(defun erc-d-tests--parse-message-upstream (raw)
- "Hack shim for parsing RAW line recvd from peer."
- (cl-letf (((symbol-function #'erc-handle-parsed-server-response)
- (lambda (_ p) p)))
- (let ((erc-active-buffer nil))
- (erc-parse-server-response nil raw))))
-
-(ert-deftest erc-d-i--validate-tags ()
- (should (erc-d-i--validate-tags
- (concat "batch=4cc99692bf24a4bec4aa03da437364f5;"
- "time=2021-01-04T00:32:13.839Z")))
- (should (erc-d-i--validate-tags "+foo=bar;baz=spam"))
- (should (erc-d-i--validate-tags "foo=\\:ok;baz=\\s"))
- (should (erc-d-i--validate-tags "foo=\303\247edilla"))
- (should (erc-d-i--validate-tags "foo=\\"))
- (should (erc-d-i--validate-tags "foo=bar\\baz"))
- (should-error (erc-d-i--validate-tags "foo=\\\\;baz=\\\r\\\n"))
- (should-error (erc-d-i--validate-tags "foo=\n"))
- (should-error (erc-d-i--validate-tags "foo=\0ok"))
- (should-error (erc-d-i--validate-tags "foo=bar baz"))
- (should-error (erc-d-i--validate-tags "foo=bar\r"))
- (should-error (erc-d-i--validate-tags "foo=bar;")))
-
-(ert-deftest erc-d-i--parse-message ()
- (let* ((raw (concat "@time=2020-11-23T09:10:33.088Z "
- ":tilde.chat BATCH +1 chathistory :#meta"))
- (upstream (erc-d-tests--parse-message-upstream raw))
- (ours (erc-d-i--parse-message raw)))
-
- (ert-info ("Baseline upstream")
- (should (equal (erc-response.unparsed upstream) raw))
- (should (equal (erc-response.sender upstream) "tilde.chat"))
- (should (equal (erc-response.command upstream) "BATCH"))
- (should (equal (erc-response.command-args upstream)
- '("+1" "chathistory" "#meta")))
- (should (equal (erc-response.contents upstream) "#meta")))
-
- (ert-info ("Ours my not compare cl-equalp but is otherwise the same")
- (should (equal (erc-d-i-message.unparsed ours) raw))
- (should (equal (erc-d-i-message.sender ours) "tilde.chat"))
- (should (equal (erc-d-i-message.command ours) "BATCH"))
- (should (equal (erc-d-i-message.command-args ours)
- '("+1" "chathistory" "#meta")))
- (should (equal (erc-d-i-message.contents ours) "#meta"))
- (should (equal (erc-d-i-message.tags ours)
- '((time . "2020-11-23T09:10:33.088Z")))))
-
- (ert-info ("No compat decodes the whole message as utf-8")
- (setq ours (erc-d-i--parse-message
- "@foo=\303\247edilla TAGMSG #ch\303\240n"
- 'decode))
- (should-not (erc-d-i-message.compat ours))
- (should (equal (erc-d-i-message.command-args ours) '("#chàn")))
- (should (equal (erc-d-i-message.contents ours) "#chàn"))
- (should (equal (erc-d-i-message.tags ours) '((foo . "çedilla")))))))
-
-(ert-deftest erc-d-i--parse-message/privmsg ()
- (dolist (raw '(":Bob!~bob@gnu.org PRIVMSG #chan :one two"
- ":Bob!~bob@gnu.org PRIVMSG #chan one"
- ":Bob!~bob@gnu.org PRIVMSG #chan : "
- ":Bob!~bob@gnu.org PRIVMSG #chan :"
- "@account=bob :Bob!~bob@gnu.org PRIVMSG #chan one"
- "@foo=bar;baz :Bob!~bob@gnu.org PRIVMSG #chan :one"))
- (dolist (slot '(unparsed
- sender
- command
- command-args
- contents
- tags))
- (let ((ours (erc-d-i--parse-message raw))
- (orig (erc-d-tests--parse-message-upstream raw)))
- (ert-info ((format "slot: `%s', orig: %S, ours: %S"
- slot orig ours))
- (if (eq slot 'tags)
- (should (equal (erc-response.tags orig)
- (mapcar (pcase-lambda (`(,key . ,value))
- (if value
- (list (symbol-name key) value)
- (list (symbol-name key))))
- (reverse (erc-d-i-message.tags ours)))))
- (should
- (equal (cl-struct-slot-value 'erc-d-i-message slot ours)
- (cl-struct-slot-value 'erc-response slot orig)))))))))
-
-(ert-deftest erc-d-i--unescape-tag-value ()
- (should (equal (erc-d-i--unescape-tag-value
- "\\sabc\\sdef\\s\\sxyz\\s")
- " abc def xyz "))
- (should (equal (erc-d-i--unescape-tag-value
- "\\\\abc\\\\def\\\\\\\\xyz\\\\")
- "\\abc\\def\\\\xyz\\"))
- (should (equal (erc-d-i--unescape-tag-value "a\\bc") "abc"))
- (should (equal (erc-d-i--unescape-tag-value
- "\\\\abc\\\\def\\\\\\\\xyz\\")
- "\\abc\\def\\\\xyz"))
- (should (equal (erc-d-i--unescape-tag-value "a\\:b\\r\\nc\\sd")
- "a;b\r\nc d")))
-
-(ert-deftest erc-d-i--escape-tag-value ()
- (should (equal (erc-d-i--escape-tag-value " abc def xyz ")
- "\\sabc\\sdef\\s\\sxyz\\s"))
- (should (equal (erc-d-i--escape-tag-value "\\abc\\def\\\\xyz\\")
- "\\\\abc\\\\def\\\\\\\\xyz\\\\"))
- (should (equal (erc-d-i--escape-tag-value "a;b\r\nc d")
- "a\\:b\\r\\nc\\sd")))
-
-;; TODO add tests for msg-join, mask-match, userhost-split,
-;; validate-hostname
-
-(ert-deftest erc-d-i--parse-message--irc-parser-tests ()
- (let* ((data (with-temp-buffer
- (insert-file-contents
- (expand-file-name "irc-parser-tests.eld"
- (ert-resource-directory)))
- (read (current-buffer))))
- (tests (assoc-default 'tests (assoc-default 'msg-split data)))
- input atoms m ours)
- (dolist (test tests)
- (setq input (assoc-default 'input test)
- atoms (assoc-default 'atoms test)
- m (erc-d-i--parse-message input))
- (ert-info ("Parses tags correctly")
- (setq ours (erc-d-i-message.tags m))
- (if-let ((tags (assoc-default 'tags atoms)))
- (pcase-dolist (`(,key . ,value) ours)
- (should (string= (cdr (assq key tags)) (or value ""))))
- (should-not ours)))
- (ert-info ("Parses verbs correctly")
- (setq ours (erc-d-i-message.command m))
- (if-let ((verbs (assoc-default 'verb atoms)))
- (should (string= (downcase verbs) (downcase ours)))
- (should (string-empty-p ours))))
- (ert-info ("Parses sources correctly")
- (setq ours (erc-d-i-message.sender m))
- (if-let ((source (assoc-default 'source atoms)))
- (should (string= source ours))
- (should (string-empty-p ours))))
- (ert-info ("Parses params correctly")
- (setq ours (erc-d-i-message.command-args m))
- (if-let ((params (assoc-default 'params atoms)))
- (should (equal ours params))
- (should-not ours))))))
-
-(defun erc-d-tests--new-ex (existing raw-hunk)
- (let* ((f (lambda (_) (pop raw-hunk)))
- (sd (make-erc-d-u-scan-d :f f)))
- (setf (erc-d-exchange-hunk existing) (make-erc-d-u-scan-e :sd sd)
- (erc-d-exchange-spec existing) (make-erc-d-spec)))
- (erc-d--iter existing))
-
-(ert-deftest erc-d--render-entries ()
- (let* ((erc-nick "foo")
- (dialog (make-erc-d-dialog :vars `((:a . 1)
- (c . ((a b) (: a space b)))
- (d . (c alpha digit))
- (bee . 2)
- (f . ,(lambda () "3"))
- (i . erc-nick))))
- (exchange (make-erc-d-exchange :dialog dialog))
- (mex (apply-partially #'erc-d-tests--new-ex exchange))
- it)
-
- (erc-d-exchange-reload dialog exchange)
-
- (ert-info ("Baseline Outgoing")
- (setq it (funcall mex '((0 "abc"))))
- (should (equal (funcall it) 0))
- (should (equal (funcall it) "abc")))
-
- (ert-info ("Incoming are regexp escaped")
- (setq it (funcall mex '((i 0.0 "fsf" ".org"))))
- (should (equal (cons (funcall it) (funcall it)) '(i . 0.0)))
- (should (equal (funcall it) "\\`fsf\\.org")))
-
- (ert-info ("Incoming can access vars via rx-let")
- (setq it (funcall mex '((i 0.0 bee))))
- (should (equal (cons (funcall it) (funcall it)) '(i . 0.0)))
- (should (equal (funcall it) "\\`\002")))
-
- (ert-info ("Incoming rx-let params")
- (setq it (funcall mex '((i 0.0 d))))
- (should (equal (cons (funcall it) (funcall it)) '(i . 0.0)))
- (should (equal (funcall it) "\\`[[:alpha:]][[:space:]][[:digit:]]")))
-
- (ert-info ("Incoming literal rx forms")
- (setq it (funcall mex '((i 0.0 (= 3 alpha) ".org"))))
- (should (equal (cons (funcall it) (funcall it)) '(i . 0.0)))
- (should (equal (funcall it) "\\`[[:alpha:]]\\{3\\}\\.org")))
-
- (ert-info ("Self-quoting disallowed")
- (setq it (funcall mex '((0 :a "abc"))))
- (should (equal (funcall it) 0))
- (should-error (funcall it)))
-
- (ert-info ("Global vars and short vars")
- (setq it (funcall mex '((0 i f erc-nick))))
- (should (equal (funcall it) 0))
- (should (equal (funcall it) "foo3foo")))
-
- (ert-info ("Exits clean")
- (should-not (funcall it))
- (should (equal (erc-d-dialog-vars dialog)
- `((:a . 1)
- (c . ((a b) (: a space b)))
- (d . (c alpha digit))
- (bee . 2)
- (f . ,(alist-get 'f (erc-d-dialog-vars dialog)))
- (i . erc-nick)))))))
-
-(ert-deftest erc-d--render-entries--matches ()
- (let* ((alist (list
- (cons 'f (lambda (a) (funcall a :match 1)))
- (cons 'g (lambda () (match-string 2 "foo bar baz")))
- (cons 'h (lambda (a) (concat (funcall a :match 0)
- (funcall a :request))))
- (cons 'i (lambda (_ e) (erc-d-exchange-request e)))
- (cons 'j (lambda ()
- (set-match-data '(0 1))
- (match-string 0 "j")))))
- (dialog (make-erc-d-dialog :vars alist))
- (exchange (make-erc-d-exchange :dialog dialog
- :request "foo bar baz"
- ;; 11 222
- :match-data '(4 11 4 6 8 11)))
- (mex (apply-partially #'erc-d-tests--new-ex exchange))
- it)
-
- (erc-d-exchange-reload dialog exchange)
-
- (ert-info ("One arg, match")
- (setq it (funcall mex '((0 f))))
- (should (equal (funcall it) 0))
- (should (equal (funcall it) "ba")))
-
- (ert-info ("No args")
- (setq it (funcall mex '((0 g))))
- (should (equal (funcall it) 0))
- (should (equal (funcall it) "baz")))
-
- (ert-info ("Second arg is exchange object")
- (setq it (funcall mex '((0 i))))
- (should (equal (funcall it) 0))
- (should (equal (funcall it) "foo bar baz")))
-
- (ert-info ("One arg, multiple calls")
- (setq it (funcall mex '((0 h))))
- (should (equal (funcall it) 0))
- (should (equal (funcall it) "bar bazfoo bar baz")))
-
- (ert-info ("Match data restored")
- (setq it (funcall mex '((0 j))))
- (should (equal (funcall it) 0))
- (should (equal (funcall it) "j"))
-
- (setq it (funcall mex '((0 g))))
- (should (equal (funcall it) 0))
- (should (equal (funcall it) "baz")))
-
- (ert-info ("Bad signature")
- (let ((qlist (list 'f '(lambda (p q x) (ignore)))))
- (setf (erc-d-dialog-vars dialog) qlist)
- (should-error (erc-d-exchange-reload dialog exchange))))))
-
-(ert-deftest erc-d--render-entries--dynamic ()
- (let* ((alist (list
- (cons 'foo "foo")
- (cons 'f (lambda (a) (funcall a :get-binding 'foo)))
- (cons 'h (lambda (a) (upcase (funcall a :get-var 'foo))))
- (cons 'g (lambda (a)
- (funcall a :rebind 'g (funcall a :get-var 'f))
- "bar"))
- (cons 'j (lambda (a) (funcall a :set "123") "abc"))
- (cons 'k (lambda () "abc"))))
- (dialog (make-erc-d-dialog :vars alist))
- (exchange (make-erc-d-exchange :dialog dialog))
- (mex (apply-partially #'erc-d-tests--new-ex exchange))
- it)
-
- (erc-d-exchange-reload dialog exchange)
-
- (ert-info ("Initial reference calls function")
- (setq it (funcall mex '((0 j) (0 j))))
- (should (equal (funcall it) 0))
- (should (equal (funcall it) "abc")))
-
- (ert-info ("Subsequent reference expands to string")
- (should (equal (funcall it) 0))
- (should (equal (funcall it) "123")))
-
- (ert-info ("Outside manipulation: initial reference calls function")
- (setq it (funcall mex '((0 k) (0 k))))
- (should (equal (funcall it) 0))
- (should (equal (funcall it) "abc")))
-
- (ert-info ("Outside manipulation: subsequent reference expands to string")
- (erc-d-exchange-rebind dialog exchange 'k "123")
- (should (equal (funcall it) 0))
- (should (equal (funcall it) "123")))
-
- (ert-info ("Swap one function for another")
- (setq it (funcall mex '((0 g) (0 g))))
- (should (equal (funcall it) 0))
- (should (equal (funcall it) "bar"))
- (should (equal (funcall it) 0))
- (should (equal (funcall it) "foo")))
-
- (ert-info ("Bindings accessible inside functions")
- (setq it (funcall mex '((0 f h))))
- (should (equal (funcall it) 0))
- (should (equal (funcall it) "fooFOO")))
-
- (ert-info ("Rebuild alist by sending flag")
- (setq it (funcall mex '((0 f) (1 f) (2 f) (i 3 f))))
- (should (equal (funcall it) 0))
- (should (equal (funcall it) "foo"))
- (erc-d-exchange-rebind dialog exchange 'f "bar")
- (should (equal (funcall it) 1))
- (should (equal (funcall it) "bar"))
- (setq alist (setf (alist-get 'f (erc-d-dialog-vars dialog))
- (lambda nil "baz")))
- (should (eq (funcall it) 2))
- (should (equal (funcall it 'reload) "baz"))
- (setq alist (setf (alist-get 'f (erc-d-dialog-vars dialog)) "spam"))
- (should (eq (funcall it) 'i))
- (should (eq (funcall it 'reload) 3))
- (should (equal (funcall it) "\\`spam")))))
-
-(ert-deftest erc-d-t-with-cleanup ()
- (should-not (get-buffer "*echo*"))
- (should-not (get-buffer "*foo*"))
- (should-not (get-buffer "*bar*"))
- (should-not (get-buffer "*baz*"))
- (erc-d-t-with-cleanup
- ((echo (start-process "echo" (get-buffer-create "*echo*") "sleep" "1"))
- (buffer-foo (get-buffer-create "*foo*"))
- (buffer-bar (get-buffer-create "*bar*"))
- (clean-up (list (intern (process-name echo)))) ; let*
- buffer-baz)
- (ert-info ("Clean Up")
- (should (equal clean-up '(ran echo)))
- (should (bufferp buffer-baz))
- (should (bufferp buffer-foo))
- (setq buffer-foo nil))
- (setq buffer-baz (get-buffer-create "*baz*"))
- (push 'ran clean-up))
- (ert-info ("Buffers and procs destroyed")
- (should-not (get-buffer "*echo*"))
- (should-not (get-buffer "*bar*"))
- (should-not (get-buffer "*baz*")))
- (ert-info ("Buffer foo spared")
- (should (get-buffer "*foo*"))
- (kill-buffer "*foo*")))
-
-(ert-deftest erc-d-t-wait-for ()
- :tags '(:unstable)
- (let (v)
- (run-at-time 0.2 nil (lambda () (setq v t)))
- (should (erc-d-t-wait-for 0.4 "result becomes non-nil" v))
- (should-error (erc-d-t-wait-for 0.4 "result stays nil" (not v)))
- (setq v nil)
- (should-not (erc-d-t-wait-for -0.4 "inverted stays nil" v))
- (run-at-time 0.2 nil (lambda () (setq v t)))
- (setq v nil)
- (should-error (erc-d-t-wait-for -0.4 "inverted becomes non-nil" v))))
-
-(defvar erc-d-tests-with-server-password "changeme")
-
-;; Compromise between removing `autojoin' from `erc-modules' entirely
-;; and allowing side effects to meddle excessively
-(defvar erc-autojoin-channels-alist)
-
-;; This is only meant to be used by tests in this file.
-(cl-defmacro erc-d-tests-with-server ((dumb-server-var erc-server-buffer-var)
- dialog &rest body)
- "Create server for DIALOG and run BODY.
-DIALOG may also be a list of dialogs. ERC-SERVER-BUFFER-VAR and
-DUMB-SERVER-VAR are bound accordingly in BODY."
- (declare (indent 2))
- (when (eq '_ dumb-server-var)
- (setq dumb-server-var (make-symbol "dumb-server-var")))
- (when (eq '_ erc-server-buffer-var)
- (setq erc-server-buffer-var (make-symbol "erc-server-buffer-var")))
- (if (listp dialog)
- (setq dialog (mapcar (lambda (f) (list 'quote f)) dialog))
- (setq dialog `((quote ,dialog))))
- `(let* (auth-source-do-cache
- (,dumb-server-var (erc-d-run "localhost" t ,@dialog))
- ,erc-server-buffer-var
- ;;
- (erc-server-flood-penalty 0.05)
- erc-autojoin-channels-alist
- erc-after-connect
- erc-server-auto-reconnect)
- (should-not erc-d--slow-mo)
- (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
- ;; Allow important messages through, even in -batch mode.
- (advice-add #'erc-handle-login :around #'erc-d-t-silence-around)
- (advice-add #'erc-server-connect :around #'erc-d-t-silence-around)
- (unless (or noninteractive erc-debug-irc-protocol)
- (erc-toggle-debug-irc-protocol))
- (setq ,erc-server-buffer-var
- (erc :server "localhost"
- :password erc-d-tests-with-server-password
- :port (process-contact ,dumb-server-var :service)
- :nick "tester"
- :full-name "tester"))
- (unwind-protect
- (progn
- ,@body
- (erc-d-t-wait-for 1 "dumb-server death"
- (not (process-live-p ,dumb-server-var))))
- (when (process-live-p erc-server-process)
- (delete-process erc-server-process))
- (advice-remove #'erc-handle-login #'erc-d-t-silence-around)
- (advice-remove #'erc-server-connect #'erc-d-t-silence-around)
- (when noninteractive
- (kill-buffer ,erc-server-buffer-var)
- (erc-d-t-kill-related-buffers)))))
-
-(defmacro erc-d-tests-with-failure-spy (found func-syms &rest body)
- "Wrap functions with advice for inspecting errors caused by BODY.
-Do this for functions whose names appear in FUNC-SYMS. When running
-advice code, add errors to list FOUND. Note: the teardown finalizer is
-not added by default. Also, `erc-d-linger-secs' likely has to be
-nonzero for this to work."
- (declare (indent 2))
- ;; Catch errors thrown by timers that `should-error'ignores
- `(progn
- (let ((ad (lambda (f o &rest r)
- (condition-case err
- (apply o r)
- (error (push err ,found)
- (advice-remove f 'spy))))))
- (dolist (sym ,func-syms)
- (advice-add sym :around (apply-partially ad sym) '((name . spy)))))
- (progn ,@body)
- (dolist (sym ,func-syms)
- (advice-remove sym 'spy))
- (setq ,found (nreverse ,found))))
-
-(ert-deftest erc-d-run-nonstandard-messages ()
- :tags '(:expensive-test)
- (let* ((erc-d-linger-secs 0.2)
- (dumb-server (erc-d-run "localhost" t 'nonstandard))
- (dumb-server-buffer (get-buffer "*erc-d-server*"))
- (expect (erc-d-t-make-expecter))
- client)
- (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
- (setq client (open-network-stream "erc-d-client" nil
- "localhost"
- (process-contact dumb-server :service)
- :coding 'binary))
- (ert-info ("Server splits CRLF delimited lines")
- (process-send-string client "ONE one\r\nTWO two\r\n")
- (with-current-buffer dumb-server-buffer
- (funcall expect 1 '(: "<- nonstandard:" (+ digit) " ONE one" eol))
- (funcall expect 1 '(regex "<- nonstandard:[[:digit:]]+ TWO two$"))))
- (ert-info ("Server doesn't discard empty lines")
- (process-send-string client "\r\n")
- (with-current-buffer dumb-server-buffer
- (funcall expect 1 '(regex "<- nonstandard:[[:digit:]]+ $"))))
- (ert-info ("Server preserves spaces")
- (process-send-string client " \r\n")
- (with-current-buffer dumb-server-buffer
- (funcall expect 1 '(regex "<- nonstandard:[[:digit:]]+ \\{2\\}$")))
- (process-send-string client " \r\n")
- (with-current-buffer dumb-server-buffer
- (funcall expect 1 '(regex "<- nonstandard:[[:digit:]]+ \\{3\\}$"))))
- (erc-d-t-wait-for 3 "dumb-server death"
- (not (process-live-p dumb-server)))
- (delete-process client)
- (when noninteractive
- (kill-buffer dumb-server-buffer))))
-
-(ert-deftest erc-d-run-basic ()
- :tags '(:expensive-test)
- (erc-d-tests-with-server (_ _) basic
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (erc-d-t-search-for 2 "hey"))
- (when noninteractive
- (kill-buffer "#chan"))))
-
-(ert-deftest erc-d-run-eof ()
- :tags '(:expensive-test)
- (skip-unless noninteractive)
- (erc-d-tests-with-server (_ erc-s-buf) eof
- (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#chan"))
- (erc-d-t-search-for 2 "hey"))
- (with-current-buffer erc-s-buf
- (process-send-eof erc-server-process))))
-
-(ert-deftest erc-d-run-eof-fail ()
- :tags '(:expensive-test)
- (let (errors)
- (erc-d-tests-with-failure-spy errors '(erc-d--teardown)
- (erc-d-tests-with-server (_ _) eof
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (erc-d-t-search-for 2 "hey"))
- (erc-d-t-wait-for 10 errors)))
- (should (string-match-p "Timed out awaiting request.*__EOF__"
- (cadr (pop errors))))))
-
-(ert-deftest erc-d-run-linger ()
- :tags '(:unstable :expensive-test)
- (erc-d-tests-with-server (dumb-s _) linger
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (erc-d-t-search-for 2 "hey"))
- (with-current-buffer (process-buffer dumb-s)
- (erc-d-t-search-for 2 "Lingering for 1.00 seconds"))
- (with-current-buffer (process-buffer dumb-s)
- (erc-d-t-search-for 3 "Lingered for 1.00 seconds"))))
-
-(ert-deftest erc-d-run-linger-fail ()
- :tags '(:unstable :expensive-test)
- (let ((erc-server-flood-penalty 0.1)
- errors)
- (erc-d-tests-with-failure-spy
- errors '(erc-d--teardown erc-d-command)
- (erc-d-tests-with-server (_ _) linger
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (erc-d-t-search-for 2 "hey")
- (erc-cmd-MSG "#chan hi"))
- (erc-d-t-wait-for 10 "Bad match" errors)))
- (should (string-match-p "Match failed.*hi" (cadr (pop errors))))))
-
-(ert-deftest erc-d-run-linger-direct ()
- :tags '(:unstable :expensive-test)
- (let* ((dumb-server (erc-d-run "localhost" t
- 'linger-multi-a 'linger-multi-b))
- (port (process-contact dumb-server :service))
- (dumb-server-buffer (get-buffer "*erc-d-server*"))
- (client-buffer-a (get-buffer-create "*erc-d-client-a*"))
- (client-buffer-b (get-buffer-create "*erc-d-client-b*"))
- (start (current-time))
- client-a client-b)
- (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
- (setq client-a (open-network-stream "erc-d-client-a" client-buffer-a
- "localhost" port
- :coding 'binary)
- client-b (open-network-stream "erc-d-client-b" client-buffer-b
- "localhost" port
- :coding 'binary))
- (process-send-string client-a "PASS :a\r\n")
- (sleep-for 0.01)
- (process-send-string client-b "PASS :b\r\n")
- (sleep-for 0.01)
- (erc-d-t-wait-for 3 "dumb-server death"
- (not (process-live-p dumb-server)))
- (ert-info ("Ensure linger of one second")
- (should (time-less-p 1 (time-subtract (current-time) start)))
- (should (time-less-p (time-subtract (current-time) start) 1.5)))
- (delete-process client-a)
- (delete-process client-b)
- (when noninteractive
- (kill-buffer client-buffer-a)
- (kill-buffer client-buffer-b)
- (kill-buffer dumb-server-buffer))))
-
-(ert-deftest erc-d-run-drop-direct ()
- :tags '(:unstable)
- (let* ((dumb-server (erc-d-run "localhost" t 'drop-a 'drop-b))
- (port (process-contact dumb-server :service))
- (dumb-server-buffer (get-buffer "*erc-d-server*"))
- (client-buffer-a (get-buffer-create "*erc-d-client-a*"))
- (client-buffer-b (get-buffer-create "*erc-d-client-b*"))
- (start (current-time))
- client-a client-b)
- (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
- (setq client-a (open-network-stream "erc-d-client-a" client-buffer-a
- "localhost" port
- :coding 'binary)
- client-b (open-network-stream "erc-d-client-b" client-buffer-b
- "localhost" port
- :coding 'binary))
- (process-send-string client-a "PASS :a\r\n")
- (sleep-for 0.01)
- (process-send-string client-b "PASS :b\r\n")
- (erc-d-t-wait-for 3 "client-a dies" (not (process-live-p client-a)))
- (should (time-less-p (time-subtract (current-time) start) 0.32))
- (erc-d-t-wait-for 3 "dumb-server death"
- (not (process-live-p dumb-server)))
- (ert-info ("Ensure linger of one second")
- (should (time-less-p 1 (time-subtract (current-time) start))))
- (delete-process client-a)
- (delete-process client-b)
- (when noninteractive
- (kill-buffer client-buffer-a)
- (kill-buffer client-buffer-b)
- (kill-buffer dumb-server-buffer))))
-
-(ert-deftest erc-d-run-no-match ()
- :tags '(:expensive-test)
- (let ((erc-d-linger-secs 1)
- erc-server-auto-reconnect
- errors)
- (erc-d-tests-with-failure-spy errors '(erc-d--teardown erc-d-command)
- (erc-d-tests-with-server (_ erc-server-buffer) no-match
- (with-current-buffer erc-server-buffer
- (erc-d-t-search-for 2 "away")
- (erc-cmd-JOIN "#foo")
- (erc-d-t-wait-for 10 "Bad match" errors))))
- (should (string-match-p "Match failed.*foo.*chan" (cadr (pop errors))))
- (should-not (get-buffer "#foo"))))
-
-(ert-deftest erc-d-run-timeout ()
- :tags '(:expensive-test)
- (let ((erc-d-linger-secs 1)
- err errors)
- (erc-d-tests-with-failure-spy errors '(erc-d--teardown)
- (erc-d-tests-with-server (_ _) timeout
- (erc-d-t-wait-for 10 "error caught" errors)))
- (setq err (pop errors))
- (should (eq (car err) 'erc-d-timeout))
- (should (string-match-p "Timed out" (cadr err)))))
-
-(ert-deftest erc-d-run-unexpected ()
- :tags '(:expensive-test)
- (let ((erc-d-linger-secs 2)
- errors)
- (erc-d-tests-with-failure-spy
- errors '(erc-d--teardown erc-d-command)
- (erc-d-tests-with-server (_ _) unexpected
- (ert-info ("All specs consumed when more input arrives")
- (erc-d-t-wait-for 10 "error caught" (cdr errors)))))
- (should (string-match-p "unexpected.*MODE" (cadr (pop errors))))
- ;; Nonsensical normally because func would have already exited when
- ;; first error was thrown
- (should (string-match-p "Match failed" (cadr (pop errors))))))
-
-(ert-deftest erc-d-run-unexpected-depleted ()
- :tags '(:expensive-test)
- (let ((erc-d-linger-secs 3)
- errors)
- (erc-d-tests-with-failure-spy errors '(erc-d--teardown erc-d-command)
- (let* ((dumb-server-buffer (get-buffer-create "*erc-d-server*"))
- (dumb-server (erc-d-run "localhost" t 'depleted))
- (expect (erc-d-t-make-expecter))
- (client-buf (get-buffer-create "*erc-d-client*"))
- client-proc)
- (with-current-buffer dumb-server-buffer
- (erc-d-t-search-for 3 "Starting"))
- (setq client-proc (make-network-process
- :buffer client-buf
- :name "erc-d-client"
- :family 'ipv4
- :noquery t
- :coding 'binary
- :service (process-contact dumb-server :service)
- :host "localhost"))
- (with-current-buffer dumb-server-buffer
- (funcall expect 3 "open from"))
- (process-send-string client-proc "PASS :changeme\r\n")
- (sleep-for 0.01)
- (process-send-string client-proc "NICK tester\r\n")
- (sleep-for 0.01)
- (process-send-string client-proc "USER user 0 * :tester\r\n")
- (sleep-for 0.01)
- (when (process-live-p client-proc)
- (process-send-string client-proc "BLAH :too much\r\n")
- (sleep-for 0.01))
- (with-current-buffer client-buf
- (funcall expect 3 "Welcome to the Internet"))
- (erc-d-t-wait-for 2 "dumb-server death"
- (not (process-live-p dumb-server)))
- (delete-process client-proc)
- (when noninteractive
- (kill-buffer client-buf)
- (kill-buffer dumb-server-buffer))))
- (should (string-match-p "unexpected.*BLAH" (cadr (pop errors))))
- ;; Wouldn't happen IRL
- (should (string-match-p "unexpected.*BLAH" (cadr (pop errors))))
- (should-not errors)))
-
-(defun erc-d-tests--dynamic-match-user (_dialog exchange)
- "Shared pattern/response handler for canned dynamic DIALOG test."
- (should (string= (match-string 1 (erc-d-exchange-request exchange))
- "tester")))
-
-(defun erc-d-tests--run-dynamic ()
- "Perform common assertions for \"dynamic\" dialog."
- (erc-d-tests-with-server (dumb-server erc-server-buffer) dynamic
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (erc-d-t-search-for 2 "tester: hey"))
- (with-current-buffer erc-server-buffer
- (let ((expect (erc-d-t-make-expecter)))
- (funcall expect 2 "host is irc.fsf.org")
- (funcall expect 2 "modes for tester")))
- (with-current-buffer (process-buffer dumb-server)
- (erc-d-t-search-for 2 "irc.fsf.org"))
- (when noninteractive
- (kill-buffer "#chan"))))
-
-(ert-deftest erc-d-run-dynamic-default-match ()
- :tags '(:expensive-test)
- (let* (dynamic-tally
- (erc-d-tmpl-vars '((user . "user")
- (ignored . ((a b) (: a space b)))
- (realname . (group (+ graph)))))
- (nick (lambda (a)
- (push '(nick . match-user) dynamic-tally)
- (funcall a :set (funcall a :match 1) 'export)))
- (dom (lambda (a)
- (push '(dom . match-user) dynamic-tally)
- (funcall a :set erc-d-server-fqdn)))
- (erc-d-match-handlers
- (list :user (lambda (d e)
- (erc-d-exchange-rebind d e 'nick nick)
- (erc-d-exchange-rebind d e 'dom dom)
- (erc-d-tests--dynamic-match-user d e))
- :mode-user (lambda (d e)
- (erc-d-exchange-rebind d e 'nick "tester")
- (erc-d-exchange-rebind d e 'dom dom))))
- (erc-d-server-fqdn "irc.fsf.org"))
- (erc-d-tests--run-dynamic)
- (should (equal '((dom . match-user) (nick . match-user) (dom . match-user))
- dynamic-tally))))
-
-(ert-deftest erc-d-run-dynamic-default-match-rebind ()
- :tags '(:expensive-test)
- (let* (tally
- ;;
- (erc-d-tmpl-vars '((user . "user")
- (ignored . ((a b) (: a space b)))
- (realname . (group (+ graph)))))
- (erc-d-match-handlers
- (list :user
- (lambda (d e)
- (erc-d-exchange-rebind
- d e 'nick
- (lambda (a)
- (push 'bind-nick tally)
- (funcall a :rebind 'nick (funcall a :match 1) 'export)))
- (erc-d-exchange-rebind
- d e 'dom
- (lambda ()
- (push 'bind-dom tally)
- (erc-d-exchange-rebind d e 'dom erc-d-server-fqdn)))
- (erc-d-tests--dynamic-match-user d e))
- :mode-user
- (lambda (d e)
- (erc-d-exchange-rebind d e 'nick "tester")
- (erc-d-exchange-rebind d e 'dom erc-d-server-fqdn))))
- (erc-d-server-fqdn "irc.fsf.org"))
- (erc-d-tests--run-dynamic)
- (should (equal '(bind-nick bind-dom) tally))))
-
-(ert-deftest erc-d-run-dynamic-runtime-stub ()
- :tags '(:expensive-test)
- (let ((erc-d-tmpl-vars '((token . (group (or "barnet" "foonet")))))
- (erc-d-match-handlers
- (list :pass (lambda (d _e)
- (erc-d-load-replacement-dialog d 'dynamic-foonet))))
- (erc-d-tests-with-server-password "foonet:changeme"))
- (erc-d-tests-with-server (_ erc-server-buffer)
- (dynamic-stub dynamic-foonet)
- (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#chan"))
- (erc-d-t-search-for 2 "alice:")
- (erc-d-t-absent-for 0.1 "joe"))
- (with-current-buffer erc-server-buffer
- (let ((expect (erc-d-t-make-expecter)))
- (funcall expect 2 "host is irc.foonet.org")
- (funcall expect 2 "NETWORK=FooNet")))
- (when noninteractive
- (kill-buffer "#chan")))))
-
-(ert-deftest erc-d-run-dynamic-runtime-stub-skip ()
- :tags '(:expensive-test)
- (let ((erc-d-tmpl-vars '((token . "barnet")))
- (erc-d-match-handlers
- (list :pass (lambda (d _e)
- (erc-d-load-replacement-dialog
- d 'dynamic-barnet 1))))
- (erc-d-tests-with-server-password "barnet:changeme"))
- (erc-d-tests-with-server (_ erc-server-buffer)
- (dynamic-stub dynamic-barnet)
- (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#chan"))
- (erc-d-t-search-for 2 "joe:")
- (erc-d-t-absent-for 0.1 "alice"))
- (with-current-buffer erc-server-buffer
- (let ((expect (erc-d-t-make-expecter)))
- (funcall expect 2 "host is irc.barnet.org")
- (funcall expect 2 "NETWORK=BarNet")))
- (when noninteractive
- (kill-buffer "#chan")))))
-
-;; Two servers, in-process, one client per
-(ert-deftest erc-d-run-dual-direct ()
- :tags '(:expensive-test)
- (let* ((erc-d--slow-mo -1)
- (server-a (erc-d-run "localhost" t "erc-d-server-a" 'dynamic-foonet))
- (server-b (erc-d-run "localhost" t "erc-d-server-b" 'dynamic-barnet))
- (server-a-buffer (get-buffer "*erc-d-server-a*"))
- (server-b-buffer (get-buffer "*erc-d-server-b*"))
- (client-a-buffer (get-buffer-create "*erc-d-client-a*"))
- (client-b-buffer (get-buffer-create "*erc-d-client-b*"))
- client-a client-b)
- (with-current-buffer server-a-buffer (erc-d-t-search-for 4 "Starting"))
- (with-current-buffer server-b-buffer (erc-d-t-search-for 4 "Starting"))
- (setq client-a (make-network-process
- :buffer client-a-buffer
- :name "erc-d-client-a"
- :family 'ipv4
- :noquery t
- :coding 'binary
- :service (process-contact server-a :service)
- :host "localhost")
- client-b (make-network-process
- :buffer client-b-buffer
- :name "erc-d-client-b"
- :family 'ipv4
- :noquery t
- :coding 'binary
- :service (process-contact server-b :service)
- :host "localhost"))
- ;; Also tests slo-mo indirectly because FAKE would fail without it
- (process-send-string client-a "NICK tester\r\n")
- (process-send-string client-b "FAKE noop\r\nNICK tester\r\n")
- (sleep-for 0.01)
- (process-send-string client-a "USER user 0 * :tester\r\n")
- (process-send-string client-b "USER user 0 * :tester\r\n")
- (sleep-for 0.01)
- (process-send-string client-a "MODE tester +i\r\n")
- (process-send-string client-b "MODE tester +i\r\n")
- (sleep-for 0.01)
- (process-send-string client-a "MODE #chan\r\n")
- (process-send-string client-b "MODE #chan\r\n")
- (sleep-for 0.01)
- (erc-d-t-wait-for 2 "server-a death" (not (process-live-p server-a)))
- (erc-d-t-wait-for 2 "server-b death" (not (process-live-p server-b)))
- (when noninteractive
- (kill-buffer client-a-buffer)
- (kill-buffer client-b-buffer)
- (kill-buffer server-a-buffer)
- (kill-buffer server-b-buffer))))
-
-;; This can be removed; only exists to get a baseline for next test
-(ert-deftest erc-d-run-fuzzy-direct ()
- :tags '(:expensive-test)
- (let* ((erc-d-tmpl-vars
- `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t)))))
- (dumb-server (erc-d-run "localhost" t 'fuzzy))
- (dumb-server-buffer (get-buffer "*erc-d-server*"))
- (client-buffer (get-buffer-create "*erc-d-client*"))
- client)
- (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
- (setq client (make-network-process
- :buffer client-buffer
- :name "erc-d-client"
- :family 'ipv4
- :noquery t
- :coding 'binary
- :service (process-contact dumb-server :service)
- :host "localhost"))
- ;; We could also just send this as a single fatty
- (process-send-string client "PASS :changeme\r\n")
- (sleep-for 0.01)
- (process-send-string client "NICK tester\r\n")
- (sleep-for 0.01)
- (process-send-string client "USER user 0 * :tester\r\n")
- (sleep-for 0.01)
- (process-send-string client "MODE tester +i\r\n")
- (sleep-for 0.01)
- (process-send-string client "JOIN #bar\r\n")
- (sleep-for 0.01)
- (process-send-string client "JOIN #foo\r\n")
- (sleep-for 0.01)
- (process-send-string client "MODE #bar\r\n")
- (sleep-for 0.01)
- (process-send-string client "MODE #foo\r\n")
- (sleep-for 0.01)
- (erc-d-t-wait-for 1 "dumb-server death"
- (not (process-live-p dumb-server)))
- (when noninteractive
- (kill-buffer client-buffer)
- (kill-buffer dumb-server-buffer))))
-
-;; Without adjusting penalty, takes ~15 secs. With is comparable to direct ^.
-(ert-deftest erc-d-run-fuzzy ()
- :tags '(:expensive-test)
- (let ((erc-server-flood-penalty 1.2) ; penalty < margin/sends is basically 0
- (erc-d-linger-secs 0.1)
- (erc-d-tmpl-vars
- `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t)))))
- erc-server-auto-reconnect)
- (erc-d-tests-with-server (_ erc-server-buffer) fuzzy
- (with-current-buffer erc-server-buffer
- (erc-d-t-search-for 2 "away")
- (goto-char erc-input-marker)
- (erc-cmd-JOIN "#bar"))
- (erc-d-t-wait-for 2 (get-buffer "#bar"))
- (with-current-buffer erc-server-buffer
- (erc-cmd-JOIN "#foo"))
- (erc-d-t-wait-for 20 (get-buffer "#foo"))
- (with-current-buffer "#bar"
- (erc-d-t-search-for 1 "was created on"))
- (with-current-buffer "#foo"
- (erc-d-t-search-for 5 "was created on")))))
-
-(ert-deftest erc-d-run-no-block ()
- :tags '(:expensive-test)
- (let ((erc-server-flood-penalty 1)
- (erc-d-linger-secs 1.2)
- (expect (erc-d-t-make-expecter))
- erc-server-auto-reconnect)
- (erc-d-tests-with-server (_ erc-server-buffer) no-block
- (with-current-buffer erc-server-buffer
- (funcall expect 2 "away")
- (funcall expect 1 erc-prompt)
- (with-current-buffer erc-server-buffer (erc-cmd-JOIN "#foo")))
- (with-current-buffer (erc-d-t-wait-for 2 (get-buffer "#foo"))
- (funcall expect 2 "was created on"))
-
- (ert-info ("Join #bar")
- (with-current-buffer erc-server-buffer (erc-cmd-JOIN "#bar"))
- (erc-d-t-wait-for 2 (get-buffer "#bar")))
-
- (with-current-buffer "#bar" (funcall expect 1 "was created on"))
-
- (ert-info ("Server expects next pattern but keeps sending")
- (with-current-buffer "#foo" (funcall expect 2 "Rosalind, I will "))
- (with-current-buffer "#bar" (funcall expect 1 "hi 123"))
- (with-current-buffer "#foo"
- (should-not (search-forward "<bob> I am heard" nil t))
- (funcall expect 1.5 "<bob> I am heard"))))))
-
-(defun erc-d-tests--run-proxy-direct (dumb-server dumb-server-buffer port)
- "Start DUMB-SERVER with DUMB-SERVER-BUFFER and PORT.
-These are steps shared by in-proc and subproc variants testing a
-bouncer-like setup."
- (when (version< emacs-version "28") (ert-skip "TODO connection refused"))
- (let ((client-buffer-foo (get-buffer-create "*erc-d-client-foo*"))
- (client-buffer-bar (get-buffer-create "*erc-d-client-bar*"))
- (expect (erc-d-t-make-expecter))
- client-foo
- client-bar)
- (setq client-foo (make-network-process
- :buffer client-buffer-foo
- :name "erc-d-client-foo"
- :family 'ipv4
- :noquery t
- :coding 'binary
- :service port
- :host "localhost")
- client-bar (make-network-process
- :buffer client-buffer-bar
- :name "erc-d-client-bar"
- :family 'ipv4
- :noquery t
- :coding 'binary
- :service port
- :host "localhost"))
- (with-current-buffer dumb-server-buffer
- (funcall expect 3 "open from"))
- (process-send-string client-foo "PASS :foo:changeme\r\n")
- (process-send-string client-bar "PASS :bar:changeme\r\n")
- (sleep-for 0.01)
- (process-send-string client-foo "NICK tester\r\n")
- (process-send-string client-bar "NICK tester\r\n")
- (sleep-for 0.01)
- (process-send-string client-foo "USER user 0 * :tester\r\n")
- (process-send-string client-bar "USER user 0 * :tester\r\n")
- (sleep-for 0.01)
- (process-send-string client-foo "MODE tester +i\r\n")
- (process-send-string client-bar "MODE tester +i\r\n")
- (sleep-for 0.01)
- (with-current-buffer client-buffer-foo
- (funcall expect 3 "FooNet")
- (funcall expect 3 "irc.foo.net")
- (funcall expect 3 "marked as being away")
- (goto-char (point-min))
- (should-not (search-forward "bar" nil t)))
- (with-current-buffer client-buffer-bar
- (funcall expect 3 "BarNet")
- (funcall expect 3 "irc.bar.net")
- (funcall expect 3 "marked as being away")
- (goto-char (point-min))
- (should-not (search-forward "foo" nil t)))
- (erc-d-t-wait-for 2 "dumb-server death"
- (not (process-live-p dumb-server)))
- (delete-process client-foo)
- (delete-process client-bar)
- (when noninteractive
- (kill-buffer client-buffer-foo)
- (kill-buffer client-buffer-bar)
- (kill-buffer dumb-server-buffer))))
-
-;; This test shows the simplest way to set up template variables: put
-;; everything needed for the whole session in `erc-d-tmpl-vars' before
-;; starting the server.
-
-(ert-deftest erc-d-run-proxy-direct-spec-vars ()
- :tags '(:expensive-test)
- (let* ((dumb-server-buffer (get-buffer-create "*erc-d-server*"))
- (erc-d-linger-secs 0.5)
- (erc-d-tmpl-vars
- `((network . (group (+ alpha)))
- (fqdn . ,(lambda (a)
- (let ((network (funcall a :match 1 'pass)))
- (should (member network '("foo" "bar")))
- (funcall a :set (concat "irc." network ".net")))))
- (net . ,(lambda (a)
- (let ((network (funcall a :match 1 'pass)))
- (should (member network '("foo" "bar")))
- (concat (capitalize network) "Net"))))))
- (dumb-server (erc-d-run "localhost" t 'proxy-foonet 'proxy-barnet))
- (port (process-contact dumb-server :service)))
- (with-current-buffer dumb-server-buffer
- (erc-d-t-search-for 3 "Starting"))
- (erc-d-tests--run-proxy-direct dumb-server dumb-server-buffer port)))
-
-(cl-defun erc-d-tests--start-server (&key dialogs buffer linger program libs)
- "Start and return a server in a subprocess using BUFFER and PORT.
-DIALOGS are symbols representing the base names of dialog files in
-`erc-d-u-canned-dialog-dir'. LIBS are extra files to load."
- (push (locate-library "erc-d" nil (list erc-d-u--library-directory)) libs)
- (cl-assert (car libs))
- (let* ((args `("erc-d-server" ,buffer
- ,(concat invocation-directory invocation-name)
- "-Q" "-batch" "-L" ,erc-d-u--library-directory
- ,@(let (o) (while libs (push (pop libs) o) (push "-l" o)) o)
- "-eval" ,(format "%S" program) "-f" "erc-d-serve"
- ,@(when linger (list "--linger" (number-to-string linger)))
- ,@(mapcar #'erc-d-u--expand-dialog-symbol dialogs)))
- (proc (apply #'start-process args)))
- (set-process-query-on-exit-flag proc nil)
- (with-current-buffer buffer
- (erc-d-t-search-for 5 "Starting")
- (search-forward " (")
- (backward-char))
- (let ((pair (read buffer)))
- (cons proc (cdr pair)))))
-
-(ert-deftest erc-d-run-proxy-direct-subprocess ()
- :tags '(:expensive-test)
- (let* ((buffer (get-buffer-create "*erc-d-server*"))
- ;; These are quoted because they're passed as printed forms to subproc
- (fqdn '(lambda (a e)
- (let* ((d (erc-d-exchange-dialog e))
- (name (erc-d-dialog-name d)))
- (funcall a :set (if (eq name 'proxy-foonet)
- "irc.foo.net"
- "irc.bar.net")))))
- (net '(lambda (a)
- (funcall a :rebind 'net
- (if (eq (funcall a :dialog-name) 'proxy-foonet)
- "FooNet"
- "BarNet"))))
- (program `(setq erc-d-tmpl-vars '((fqdn . ,fqdn)
- (net . ,net)
- (network . (group (+ alpha))))))
- (port (erc-d-tests--start-server
- :linger 0.3
- :program program
- :buffer buffer
- :dialogs '(proxy-foonet proxy-barnet)))
- (server (pop port)))
- (erc-d-tests--run-proxy-direct server buffer port)))
-
-(ert-deftest erc-d-run-proxy-direct-subprocess-lib ()
- :tags '(:expensive-test)
- (let* ((buffer (get-buffer-create "*erc-d-server*"))
- (lib (expand-file-name "proxy-subprocess.el"
- (ert-resource-directory)))
- (port (erc-d-tests--start-server :linger 0.3
- :buffer buffer
- :dialogs '(proxy-foonet proxy-barnet)
- :libs (list lib)))
- (server (pop port)))
- (erc-d-tests--run-proxy-direct server buffer port)))
-
-(ert-deftest erc-d-run-no-pong ()
- :tags '(:expensive-test)
- (let* (erc-d-auto-pong
- ;;
- (erc-d-tmpl-vars
- `((nonce . (group (: digit digit)))
- (echo . ,(lambda (a)
- (should (string= (funcall a :match 1) "42")) "42"))))
- (dumb-server-buffer (get-buffer-create "*erc-d-server*"))
- (dumb-server (erc-d-run "localhost" t 'no-pong))
- (expect (erc-d-t-make-expecter))
- (client-buf (get-buffer-create "*erc-d-client*"))
- client-proc)
- (with-current-buffer dumb-server-buffer
- (erc-d-t-search-for 3 "Starting"))
- (setq client-proc (make-network-process
- :buffer client-buf
- :name "erc-d-client"
- :family 'ipv4
- :noquery t
- :coding 'binary
- :service (process-contact dumb-server :service)
- :host "localhost"))
- (with-current-buffer dumb-server-buffer
- (funcall expect 3 "open from"))
- (process-send-string client-proc "PASS :changeme\r\nNICK tester\r\n")
- (sleep-for 0.01)
- (process-send-string client-proc "USER user 0 * :tester\r\n")
- (sleep-for 0.01)
- (process-send-string client-proc "MODE tester +i\r\n")
- (sleep-for 0.01)
- (with-current-buffer client-buf
- (funcall expect 3 "ExampleOrg")
- (funcall expect 3 "irc.example.org")
- (funcall expect 3 "marked as being away"))
- (ert-info ("PING is not intercepted by specialized method")
- (process-send-string client-proc "PING 42\r\n")
- (with-current-buffer client-buf
- (funcall expect 3 "PONG")))
- (erc-d-t-wait-for 2 "dumb-server death"
- (not (process-live-p dumb-server)))
- (delete-process client-proc)
- (when noninteractive
- (kill-buffer client-buf)
- (kill-buffer dumb-server-buffer))))
-
-;; Inspect replies as they arrive within a single exchange, i.e., ensure we
-;; don't regress to prior buggy version in which inspection wasn't possible
-;; until all replies had been sent by the server.
-(ert-deftest erc-d-run-incremental ()
- :tags '(:expensive-test)
- (let ((erc-server-flood-penalty 0)
- (expect (erc-d-t-make-expecter))
- erc-d-linger-secs)
- (erc-d-tests-with-server (_ erc-server-buffer) incremental
- (with-current-buffer erc-server-buffer
- (funcall expect 3 "marked as being away"))
- (with-current-buffer erc-server-buffer
- (erc-cmd-JOIN "#foo"))
- (with-current-buffer (erc-d-t-wait-for 1 (get-buffer "#foo"))
- (funcall expect 1 "Users on #foo")
- (funcall expect 1 "Look for me")
- (not (search-forward "Done" nil t))
- (funcall expect 10 "Done")
- (erc-send-message "Hi")))))
-
-(ert-deftest erc-d-unix-socket-direct ()
- :tags '(:expensive-test)
- (skip-unless (featurep 'make-network-process '(:family local)))
- (let* ((erc-d-linger-secs 0.1)
- (sock (expand-file-name "erc-d.sock" temporary-file-directory))
- (dumb-server (erc-d-run nil sock 'basic))
- (dumb-server-buffer (get-buffer "*erc-d-server*"))
- (client-buffer (get-buffer-create "*erc-d-client*"))
- client)
- (with-current-buffer "*erc-d-server*"
- (erc-d-t-search-for 4 "Starting"))
- (unwind-protect
- (progn
- (setq client (make-network-process
- :buffer client-buffer
- :name "erc-d-client"
- :family 'local
- :noquery t
- :coding 'binary
- :service sock))
- (process-send-string client "PASS :changeme\r\n")
- (sleep-for 0.01)
- (process-send-string client "NICK tester\r\n")
- (sleep-for 0.01)
- (process-send-string client "USER user 0 * :tester\r\n")
- (sleep-for 0.1)
- (process-send-string client "MODE tester +i\r\n")
- (sleep-for 0.01)
- (process-send-string client "MODE #chan\r\n")
- (sleep-for 0.01)
- (erc-d-t-wait-for 1 "dumb-server death"
- (not (process-live-p dumb-server)))
- (when noninteractive
- (kill-buffer client-buffer)
- (kill-buffer dumb-server-buffer)))
- (delete-file sock))))
-
-(ert-deftest erc-d-run-direct-foreign-protocol ()
- :tags '(:expensive-test)
- (let* ((server (erc-d-run "localhost" t "erc-d-server" 'foreign
- :ending "\n"))
- (server-buffer (get-buffer "*erc-d-server*"))
- (client-buffer (get-buffer-create "*erc-d-client*"))
- client)
- (with-current-buffer server-buffer (erc-d-t-search-for 4 "Starting"))
- (setq client (make-network-process
- :buffer client-buffer
- :name "erc-d-client"
- :family 'ipv4
- :noquery t
- :coding 'binary
- :service (process-contact server :service)
- :host "localhost"))
- (process-send-string client "ONE one\n")
- (with-current-buffer client-buffer
- (erc-d-t-search-for 5 "echo ONE one"))
- (process-send-string client "TWO two\n")
- (with-current-buffer client-buffer
- (erc-d-t-search-for 2 "echo TWO two"))
- (erc-d-t-wait-for 2 "server death" (not (process-live-p server)))
- (when noninteractive
- (kill-buffer client-buffer)
- (kill-buffer server-buffer))))
-
-;;; erc-d-tests.el ends here
+++ /dev/null
-;;; erc-d-u.el --- Helpers for ERC test server -*- lexical-binding: t -*-
-
-;; Copyright (C) 2020-2025 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:
-
-;; The utilities here are kept separate from those in `erc-d' so that
-;; tests running the server in a subprocess can use them without
-;; having to require the main lib. If migrating outside of test/lisp,
-;; there may be no reason to continue this.
-;;
-;; Another (perhaps misguided) goal here is to avoid having ERC itself
-;; as a dependency.
-;;
-;; FIXME this ^ is no longer the case (ERC is not a dependency)
-
-;;; Code:
-(require 'rx)
-(require 'subr-x)
-(eval-when-compile (require 'ert))
-
-(defvar erc-d-u--canned-buffers nil
- "List of canned dialog buffers currently open for reading.")
-
-(cl-defstruct (erc-d-u-scan-d) ; dialog scanner
- (buf nil :type buffer)
- (done nil :type boolean)
- (last nil :type integer)
- (hunks nil :type (list-of marker))
- (f #'erc-d-u--read-exchange-default :type function))
-
-(cl-defstruct (erc-d-u-scan-e) ; exchange scanner
- (sd nil :type erc-d-u-scan-d)
- (pos nil :type marker))
-
-(defun erc-d-u--read-dialog (info)
- "Read dialog file and stash relevant state in `erc-d-u-scan-d' INFO."
- (if (and (buffer-live-p (erc-d-u-scan-d-buf info))
- (with-current-buffer (erc-d-u-scan-d-buf info)
- (condition-case _err
- (progn
- (when (erc-d-u-scan-d-last info)
- (goto-char (erc-d-u-scan-d-last info))
- (forward-list))
- (setf (erc-d-u-scan-d-last info) (point))
- (down-list)
- (push (set-marker (make-marker) (point))
- (erc-d-u-scan-d-hunks info)))
- ((end-of-buffer scan-error)
- (setf (erc-d-u-scan-d-done info) t)
- nil))))
- (make-erc-d-u-scan-e :sd info :pos (car (erc-d-u-scan-d-hunks info)))
- (unless (erc-d-u-scan-d-hunks info)
- (kill-buffer (erc-d-u-scan-d-buf info))
- nil)))
-
-(defun erc-d-u--read-exchange-default (info)
- "Read from marker in exchange `erc-d-u-scan-e' object INFO."
- (let ((hunks (erc-d-u-scan-e-sd info))
- (pos (erc-d-u-scan-e-pos info)))
- (or (and (erc-d-u-scan-d-hunks hunks)
- (buffer-live-p (erc-d-u-scan-d-buf hunks))
- (with-current-buffer (erc-d-u-scan-d-buf hunks)
- (goto-char pos)
- (condition-case _err
- (read pos)
- ;; Raised unless malformed
- (invalid-read-syntax
- nil))))
- (unless (or (cl-callf (lambda (s) (delq pos s)) ; flip
- (erc-d-u-scan-d-hunks hunks))
- (not (erc-d-u-scan-d-done hunks)))
- (kill-buffer (erc-d-u-scan-d-buf hunks))
- nil))))
-
-(defun erc-d-u--read-exchange (info)
- "Call exchange reader assigned in `erc-d-u-scan-e' object INFO."
- (funcall (erc-d-u-scan-d-f (erc-d-u-scan-e-sd info)) info))
-
-(defun erc-d-u--canned-read (file)
- "Dispense a reader for each exchange in dialog FILE."
- (let ((buf (generate-new-buffer (file-name-nondirectory file))))
- (push buf erc-d-u--canned-buffers)
- (with-current-buffer buf
- (setq-local parse-sexp-ignore-comments t
- coding-system-for-read 'utf-8)
- (add-hook 'kill-buffer-hook
- (lambda () (setq erc-d-u--canned-buffers
- (delq buf erc-d-u--canned-buffers)))
- nil 'local)
- (insert-file-contents-literally file)
- (lisp-data-mode))
- (make-erc-d-u-scan-d :buf buf)))
-
-(defvar erc-d-u--library-directory (file-name-directory load-file-name))
-(defvar erc-d-u-canned-dialog-dir
- (file-name-as-directory (expand-file-name "resources"
- erc-d-u--library-directory)))
-
-(defun erc-d-u--normalize-canned-name (dialog)
- "Return DIALOG name as a symbol without validating it."
- (if (symbolp dialog)
- dialog
- (intern (file-name-base dialog))))
-
-(defvar erc-d-u-canned-file-name-extension ".eld")
-
-(defun erc-d-u--expand-dialog-symbol (dialog)
- "Return filename based on symbol DIALOG."
- (let ((name (symbol-name dialog)))
- (unless (equal (file-name-extension name)
- erc-d-u-canned-file-name-extension)
- (setq name (concat name erc-d-u-canned-file-name-extension)))
- (expand-file-name name erc-d-u-canned-dialog-dir)))
-
-(defun erc-d-u--massage-canned-name (dialog)
- "Return DIALOG in a form acceptable to `erc-d-run'."
- (if (or (symbolp dialog) (file-exists-p dialog))
- dialog
- (erc-d-u--expand-dialog-symbol (intern dialog))))
-
-(defun erc-d-u--canned-load-dialog (dialog)
- "Load dispensing exchanges from DIALOG.
-If DIALOG is a string, consider it a filename. Otherwise find a file
-in `erc-d-u-canned-dialog-dir' with a base name matching the symbol's
-name.
-
-Return an iterator that yields exchanges, each one an iterator of spec
-forms. The first is a so-called request spec and the rest are composed
-of zero or more response specs."
- (when (symbolp dialog)
- (setq dialog (erc-d-u--expand-dialog-symbol dialog)))
- (unless (file-exists-p dialog)
- (error "File not found: %s" dialog))
- (erc-d-u--canned-read dialog))
-
-(defun erc-d-u--read-exchange-slowly (num orig info)
- (when-let ((spec (funcall orig info)))
- (when (symbolp (car spec))
- (setf spec (copy-sequence spec)
- (nth 1 spec) (cond ((functionp num) (funcall num (nth 1 spec)))
- ((< num 0) (max (nth 1 spec) (- num)))
- (t (+ (nth 1 spec) num)))))
- spec))
-
-(defun erc-d-u--rewrite-for-slow-mo (num read-info)
- "Return READ-INFO with a modified reader.
-When NUM is a positive number, delay incoming requests by NUM more
-seconds. If NUM is negative, raise insufficient incoming delays to at
-least -NUM seconds. If NUM is a function, set each delay to whatever it
-returns when called with the existing value."
- (let ((orig (erc-d-u-scan-d-f read-info)))
- (setf (erc-d-u-scan-d-f read-info)
- (apply-partially #'erc-d-u--read-exchange-slowly num orig))
- read-info))
-
-(defun erc-d-u--get-remote-port (process)
- "Return peer TCP port for client PROCESS.
-When absent, just generate an id."
- (let ((remote (plist-get (process-contact process t) :remote)))
- (if (vectorp remote)
- (aref remote (1- (length remote)))
- (format "%s:%d" (process-contact process :local)
- (logand 1023 (time-convert nil 'integer))))))
-
-(defun erc-d-u--format-bind-address (process)
- "Return string or (STRING . INT) for bind address of network PROCESS."
- (let ((local (process-contact process :local)))
- (if (vectorp local) ; inet
- (cons (mapconcat #'number-to-string (seq-subseq local 0 -1) ".")
- (aref local (1- (length local))))
- local)))
-
-(defun erc-d-u--unkeyword (plist)
- "Return a copy of PLIST with keywords keys converted to non-keywords."
- (cl-loop for (key value) on plist by #'cddr
- when (keywordp key)
- do (setq key (intern (substring (symbol-name key) 1)))
- append (list key value)))
-
-(defun erc-d-u--massage-rx-args (key val)
- " Massage val so it's suitable for an `rx-let' binding.
-Handle cases in which VAL is ([ARGLIST] RX-FORM) rather than just
-RX-FORM. KEY becomes the binding name."
- (if (and (listp val)
- (cdr val)
- (not (cddr val))
- (consp (car val)))
- (cons key val)
- (list key val)))
-
-(defvar-local erc-d-u--process-buffer nil
- "Beacon for erc-d process buffers.
-The server process is usually deleted first, but we may want to examine
-the buffer afterward.")
-
-(provide 'erc-d-u)
-;;; erc-d-u.el ends here
+++ /dev/null
-;;; erc-d.el --- A dumb test server for ERC -*- lexical-binding: t -*-
-
-;; Copyright (C) 2020-2025 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:
-
-;; This is a netcat style server for testing ERC. The "d" in the name
-;; stands for "daemon" as well as for "dialog" (as well as for "dumb"
-;; because this server isn't very smart). It either spits out a
-;; canned reply when an incoming request matches the expected regexp
-;; or signals an error and dies. The entry point function is
-;; `erc-d-run'.
-;;
-;; Canned scripts, or "dialogs," should be Lisp-Data files containing
-;; one or more request/reply forms like this:
-;;
-;; | ((mode-chan 1.5 "MODE #chan") ; request: tag, expr, regex
-;; | (0.1 ":irc.org 324 bob #chan +Cint") ; reply: delay, content
-;; | (0.0 ":irc.org 329 bob #chan 12345")) ; reply: ...
-;;
-;; These are referred to as "exchanges." The first element is a list
-;; whose CAR is a descriptive "tag" and whose CDR is an incoming
-;; "spec" representing an inbound message from the client. The rest
-;; of the exchange is composed of outgoing specs representing
-;; server-to-client messages. A tag can be any symbol (ideally unique
-;; in the dialog), but a leading tilde means the request should be
-;; allowed to arrive out of order (within the allotted time).
-;;
-;; The first element in an incoming spec is a number indicating the
-;; maximum number of seconds to wait for a match before raising an
-;; error. The CDR is interpreted as the collective arguments of an
-;; `rx' form to be matched against the raw request (stripped of its
-;; CRLF line ending). A "string-start" backslash assertion, "\\`", is
-;; prepended to all patterns.
-;;
-;; Similarly, the leading number in an *outgoing* spec indicates how
-;; many seconds to wait before sending the line, which is rendered by
-;; concatenating the other members after evaluating each in place.
-;; CRLF line endings are appended on the way out and should be absent.
-;;
-;; Recall that IRC is "asynchronous," meaning some flow intervals
-;; don't jibe with lockstep request-reply semantics. However, for our
-;; purposes, grouping things as [input, output1, ..., outputN] makes
-;; sense, even though input and output may be completely unrelated.
-;;
-;; Template interpolation:
-;;
-;; A rudimentary templating facility is provided for additional
-;; flexibility. However, it's best to keep things simple (even if
-;; overly verbose), so others can easily tell what's going on at a
-;; glance. If necessary, consult existing tests for examples (grep
-;; for the variables `erc-d-tmpl-vars' and `erc-d-match-handlers').
-;;
-;; Subprocess or in-process?:
-;;
-;; Running in-process confers better visibility and easier setup at
-;; the cost of additional cleanup and resource wrangling. With a
-;; subprocess, cleanup happens by pulling the plug, but configuration
-;; means loading a separate file or passing -eval "(forms...)" during
-;; invocation. In some cases, a subprocess may be the only option,
-;; like when trying to avoid `require'ing this file.
-;;
-;; Dialog objects:
-;;
-;; For a given exchange, the first argument passed to a request
-;; handler is the `erc-d-dialog' object representing the overall
-;; conversation with the connecting peer. It can be used to pass
-;; information between handlers during a session. Some important
-;; items are:
-;;
-;; * name (symbol); name of the current dialog
-;;
-;; * queue (ring); a backlog of unhandled raw requests, minus CRLF
-;; endings.
-;;
-;; * timers (list of timers); when run, these send messages originally
-;; deferred as per the most recently matched exchange's delay info.
-;; Normally, all outgoing messages must be sent before another request
-;; is considered. (See `erc-d--send-outgoing' for an escape hatch.)
-;;
-;; * hunks (iterator of iterators); unconsumed exchanges as read from
-;; a Lisp-Data dialog file. The exchange iterators being dispensed
-;; themselves yield portions of member forms as a 2- or 3-part
-;; sequence: [tag] spec. (Here, "hunk" just means "list of raw,
-;; unrendered exchange elements")
-;;
-;; * vars (alist of cons pairs); for sharing state among template
-;; functions during the lifetime of an exchange. Initially populated
-;; by `erc-d-tmpl-vars', these KEY/VALUE pairs are expanded in the
-;; templates and optionally updated by "exchange handlers" (see
-;; `erc-d-match-handlers'). When VALUE is a function, occurrences of
-;; KEY in an outgoing spec are replaced with the result of calling
-;; VALUE with match data set appropriately. See
-;; `erc-d--render-entries' for details.
-;;
-;; * exchanges (ring of erc-d-exchange objects); activated hunks
-;; allowed to match out of order, plus the current active exchange
-;; being yielded from, if any. See `erc-d-exchange'.
-;;
-;; TODO
-;;
-;; - Remove un(der)used functionality and simplify API
-;; - Maybe migrate d-u and d-i dependencies here
-
-;;; Code:
-(eval-and-compile
- (let* ((d (file-name-directory (or (macroexp-file-name) buffer-file-name)))
- (load-path (cons (directory-file-name d) load-path)))
- (require 'erc-d-i)
- (require 'erc-d-u)))
-
-(require 'ring)
-
-(defvar erc-d-server-name "erc-d-server"
- "Default name of a server process and basis for its buffer name.
-Only relevant when starting a server with `erc-d-run'.")
-
-(defvar erc-d-server-fqdn "irc.example.org"
- "Usually the same as the server's RPL_MYINFO \"announced name\".
-Possibly used by overriding handlers, like the one for PING, and/or
-dialog templates for the sender portion of a reply message.")
-
-(defvar erc-d-line-ending "\r\n"
- "Protocol line delimiter for sending and receiving.")
-
-(defvar erc-d-linger-secs nil
- "Seconds to wait before quitting for all dialogs.
-For more granular control, use the provided LINGER `rx' variable (alone)
-as the incoming template spec of a dialog's last exchange.")
-
-(defvar erc-d-tmpl-vars nil
- "An alist of template bindings available to client dialogs.
-Populate it when calling `erc-d-run', and the contents will be made
-available to all client dialogs through the `erc-d-dialog' \"vars\"
-field and (therefore) to all templates as variables when rendering. For
-example, a key/value pair like (network . \"oftc\") will cause instances
-of the (unquoted) symbol `network' to be replaced with \"oftc\" in the
-rendered template string.
-
-This list provides default template bindings common to all dialogs.
-Each new client-connection process makes a shallow copy on init, but the
-usual precautions apply when mutating member items. Within the span of
-a dialog, updates not applicable to all exchanges should die with their
-exchange. See `erc-d--render-entries' for details. In the unlikely
-event that an exchange-specific handler is needed, see
-`erc-d-match-handlers'.")
-
-(defvar erc-d-match-handlers nil
- "A plist of exchange-tag symbols mapped to request-handler functions.
-This is meant to address edge cases for which `erc-d-tmpl-vars' comes up
-short. These may include (1) needing access to the client process
-itself and/or (2) adding or altering outgoing response templates before
-rendering. Note that (2) requires using `erc-d-exchange-rebind' instead
-of manipulating exchange bindings directly.
-
-The hook-like function `erc-d-on-match' calls any handler whose key is
-`eq' to the tag of the currently matched exchange (passing the client
-`erc-d-dialog' as the first argument and the current `erc-d-exchange'
-object as the second). The handler runs just prior to sending the first
-response.")
-
-(defvar erc-d-auto-pong t
- "Handle PING requests automatically.")
-
-(defvar erc-d--in-process t
- "Whether the server is running in the same Emacs as ERT.")
-
-(defvar erc-d--slow-mo nil
- "Adjustment for all incoming timeouts.
-This is to allow for human interaction or a slow Emacs or CI runner.
-The value is the number of seconds to extend all incoming spec timeouts
-by on init. If the value is a negative number, it's negated and
-interpreted as a lower bound to raise all incoming timeouts to. If the
-value is a function, it should take an existing timeout in seconds and
-return a replacement.")
-
-(defconst erc-d--eof-sentinel "__EOF__")
-(defconst erc-d--linger-sentinel "__LINGER__")
-(defconst erc-d--drop-sentinel "__DROP__")
-
-(defvar erc-d--clients nil
- "List containing all clients for this server session.")
-
-;; Some :type names may just be made up (not actual CL types)
-
-(cl-defstruct (erc-d-spec) ; see `erc-d--render-entries'
- (head nil :type symbol) ; or number?
- (entry nil :type list)
- (state 0 :type integer))
-
-(cl-defstruct (erc-d-exchange)
- "Object representing a request/response unit from a canned dialog."
- (dialog nil :type erc-d-dialog) ; owning dialog
- (tag nil :type symbol) ; a.k.a. tag, the caar
- (pattern nil :type string) ; regexp to match requests against
- (inspec nil :type list) ; original unrendered incoming spec
- (hunk nil :type erc-d-u-scan-e) ; active raw exchange hunk being yielded
- (spec nil :type erc-d-spec) ; active spec, see `erc-d--render-entries'
- (timeout nil :type number) ; time allotted for current request
- (timer nil :type timer) ; match timer fires when timeout expires
- (bindings nil :type list) ; `eval'-style env pairs (KEY . VAL) ...
- (rx-bindings nil :type list) ; rx-let bindings
- (deferred nil :type boolean) ; whether sender is paused
- ;; Post-match
- (match-data nil :type match-data) ; from the latest matched request
- (request nil :type string)) ; the original request sans CRLF
-
-(cl-defstruct (erc-d-dialog)
- "Session state for managing a client conversation."
- (process nil :type process) ; client-connection process
- (name nil :type symbol) ; likely the interned stem of the file
- (queue nil :type ring) ; backlog of incoming lines to process
- (hunks nil :type erc-d-u-scan-d) ; nil when done; info on raw exchange hunks
- (timers nil :type list) ; unsent replies
- (vars nil :type list) ; template bindings for rendering
- (exchanges nil :type ring) ; ring of erc-d-exchange objects
- (state nil :type symbol) ; handler's last recorded control state
- (matched nil :type erc-d-exchange) ; currently matched exchange
- (message nil :type erc-d-i-message) ; `erc-d-i-message'
- (match-handlers nil :type list) ; copy of `erc-d-match-handlers'
- (server-fqdn nil :type string) ; copy of `erc-d-server-fqdn'
- (finalizer nil :type function) ; custom teardown, passed dialog and exchange
- ;; Post-match history is a plist whose keys are exchange tags
- ;; (symbols) and whose values are a cons of match-data and request
- ;; values from prior matches.
- (history nil :type list))
-
-(defun erc-d--initialize-client (process)
- "Initialize state variables used by a client PROCESS."
- ;; Discard server-only/owned props
- (process-put process :dialog-dialogs nil)
- (let* ((server (process-get process :server))
- (reader (pop (process-get server :dialog-dialogs)))
- (name (pop reader))
- ;; Copy handlers so they can self-mutate per process
- (mat-h (copy-sequence (process-get process :dialog-match-handlers)))
- (fqdn (copy-sequence (process-get process :dialog-server-fqdn)))
- (vars (copy-sequence (process-get process :dialog-vars)))
- (ending (process-get process :dialog-ending))
- (dialog (make-erc-d-dialog :name name
- :process process
- :queue (make-ring 10)
- :exchanges (make-ring 10)
- :match-handlers mat-h
- :server-fqdn fqdn)))
- ;; Add items expected by convenience commands like `erc-d-exchange-reload'.
- (setf (alist-get 'EOF vars) `(: ,erc-d--eof-sentinel eot)
- (alist-get 'LINGER vars) `(: ,erc-d--linger-sentinel eot)
- (alist-get 'DROP vars) `(: ,erc-d--drop-sentinel eot)
- (erc-d-dialog-vars dialog) vars
- (erc-d-dialog-hunks dialog) reader)
- ;; Add reverse link, register client, launch
- (process-put process :dialog dialog)
- (process-put process :ending ending)
- (process-put process :ending-regexp (rx-to-string `(+ ,ending)))
- (push process erc-d--clients)
- (erc-d--command-refresh dialog nil)
- (erc-d--on-request process)))
-
-(defun erc-d-load-replacement-dialog (dialog replacement &optional skip)
- "Find REPLACEMENT among backlog and swap out current DIALOG's iterator.
-With int SKIP, advance past that many exchanges."
- (let* ((process (erc-d-dialog-process dialog))
- (server (process-get process :server))
- (reader (assoc-default replacement
- (process-get server :dialog-dialogs)
- #'eq)))
- (when skip (while (not (zerop skip))
- (erc-d-u--read-dialog reader)
- (cl-decf skip)))
- (dolist (timer (erc-d-dialog-timers dialog))
- (cancel-timer timer))
- (dolist (exchange (ring-elements (erc-d-dialog-exchanges dialog)))
- (cancel-timer (erc-d-exchange-timer exchange)))
- (setf (erc-d-dialog-hunks dialog) reader)
- (erc-d--command-refresh dialog nil)))
-
-(defvar erc-d--m-debug (getenv "ERC_D_DEBUG"))
-
-(defun erc-d--m (process format-string &rest args)
- "Output ARGS using FORMAT-STRING to PROCESS's buffer or elsewhere."
- (when erc-d--m-debug
- (setq format-string (concat (format-time-string "%s.%N: ") format-string)))
- (let ((insertp (and process erc-d--in-process))
- (buffer (and process (process-buffer (process-get process :server)))))
- (when (and insertp (buffer-live-p buffer))
- (princ (concat (apply #'format format-string args) "\n") buffer))
- (when (or erc-d--m-debug (not insertp))
- (apply #'message format-string args))))
-
-(defun erc-d--log (process string &optional outbound)
- "Log STRING received from or OUTBOUND to PROCESS peer."
- (let ((id (or (process-get process :log-id)
- (let ((port (erc-d-u--get-remote-port process)))
- (process-put process :log-id port) port)))
- (name (erc-d-dialog-name (process-get process :dialog))))
- (if outbound
- (erc-d--m process "-> %s:%s %s" name id string)
- (dolist (line (split-string string (process-get process :ending)))
- (erc-d--m process "<- %s:%s %s" name id line)))))
-
-(defun erc-d--log-process-event (server process msg)
- (erc-d--m server "%s: %s" process (string-trim-right msg)))
-
-(defun erc-d--send (process string)
- "Send STRING to PROCESS peer."
- (erc-d--log process string 'outbound)
- (process-send-string process (concat string (process-get process :ending))))
-
-(define-inline erc-d--fuzzy-p (exchange)
- (inline-letevals (exchange)
- (inline-quote
- (let ((tag (symbol-name (erc-d-exchange-tag ,exchange))))
- (eq ?~ (aref tag 0))))))
-
-(define-error 'erc-d-timeout "Timed out awaiting expected request")
-
-(defun erc-d--finalize-dialog (dialog)
- "Delete client-connection and finalize DIALOG.
-Return associated server."
- (let ((process (erc-d-dialog-process dialog)))
- (setq erc-d--clients (delq process erc-d--clients))
- (dolist (timer (erc-d-dialog-timers dialog))
- (cancel-timer timer))
- (dolist (exchange (ring-elements (erc-d-dialog-exchanges dialog)))
- (cancel-timer (erc-d-exchange-timer exchange)))
- (prog1 (process-get process :server)
- (delete-process process))))
-
-(defun erc-d--teardown (&optional sig &rest msg)
- "Clean up processes and maybe send signal SIG using MSG."
- (unless erc-d--in-process
- (when sig
- (erc-d--m nil "%s %s" sig (apply #'format-message msg)))
- (kill-emacs (if msg 1 0)))
- (let (process servers)
- (while (setq process (pop erc-d--clients))
- (push (erc-d--finalize-dialog (process-get process :dialog)) servers))
- (dolist (server servers)
- (delete-process server)))
- (dolist (timer timer-list)
- (when (memq (timer--function timer)
- '(erc-d--send erc-d--command-handle-all))
- (erc-d--m nil "Stray timer found: %S" (timer--function timer))
- (cancel-timer timer)))
- (when sig
- (dolist (buf erc-d-u--canned-buffers)
- (kill-buffer buf))
- (setq erc-d-u--canned-buffers nil)
- (signal sig (list (apply #'format-message msg)))))
-
-(defun erc-d--teardown-this-dialog-at-least (dialog)
- "Run `erc-d--teardown' after destroying DIALOG if it's the last one."
- (let ((server (process-get (erc-d-dialog-process dialog) :server))
- (us (erc-d-dialog-process dialog)))
- (erc-d--finalize-dialog dialog)
- (cl-assert (not (memq us erc-d--clients)))
- (unless (or (process-get server :dialog-dialogs)
- (catch 'other
- (dolist (process erc-d--clients)
- (when (eq (process-get process :server) server)
- (throw 'other process)))))
- (push us erc-d--clients)
- (erc-d--teardown))))
-
-(defun erc-d--expire (dialog exchange)
- "Raise timeout error for EXCHANGE.
-This will start the teardown for DIALOG."
- (setf (erc-d-exchange-spec exchange) nil)
- (if-let ((finalizer (erc-d-dialog-finalizer dialog)))
- (funcall finalizer dialog exchange)
- (erc-d--teardown 'erc-d-timeout "Timed out awaiting request: %s"
- (list :name (erc-d-exchange-tag exchange)
- :pattern (erc-d-exchange-pattern exchange)
- :timeout (erc-d-exchange-timeout exchange)
- :dialog (erc-d-dialog-name dialog)))))
-
-;; Using `run-at-time' here allows test cases to examine replies as
-;; they arrive instead of forcing tests to wait until an exchange
-;; completes. The `run-at-time' in `erc-d--command-meter-replies'
-;; does the same. When running as a subprocess, a normal while loop
-;; with a `sleep-for' works fine (including with multiple dialogs).
-;; FYI, this issue was still present in older versions that called
-;; this directly from `erc-d--filter'.
-
-(defun erc-d--on-request (process)
- "Handle one request for client-connection PROCESS."
- (when (process-live-p process)
- (let* ((dialog (process-get process :dialog))
- (queue (erc-d-dialog-queue dialog)))
- (unless (ring-empty-p queue)
- (let* ((parsed (ring-remove queue))
- (cmd (intern (erc-d-i-message.command parsed))))
- (setf (erc-d-dialog-message dialog) parsed)
- (erc-d-command dialog cmd)))
- (run-at-time nil nil #'erc-d--on-request process))))
-
-(defun erc-d--drop-p (exchange)
- (memq 'DROP (erc-d-exchange-inspec exchange)))
-
-(defun erc-d--linger-p (exchange)
- (memq 'LINGER (erc-d-exchange-inspec exchange)))
-
-(defun erc-d--fake-eof (dialog)
- "Simulate receiving a fictitious \"EOF\" message from peer."
- (setf (erc-d-dialog-message dialog) ; use downcase for internal cmds
- (make-erc-d-i-message :command "eof" :unparsed erc-d--eof-sentinel))
- (run-at-time nil nil #'erc-d-command dialog 'eof))
-
-(defun erc-d--process-sentinel (process event)
- "Set up or tear down client-connection PROCESS depending on EVENT."
- (erc-d--log-process-event process process event)
- (if (eq 'open (process-status process))
- (erc-d--initialize-client process)
- (let* ((dialog (process-get process :dialog))
- (exes (and dialog (erc-d-dialog-exchanges dialog))))
- (if (and exes (not (ring-empty-p exes)))
- (cond ((string-prefix-p "connection broken" event)
- (erc-d--fake-eof dialog))
- ;; Ignore disconnecting peer when pattern is DROP
- ((and (string-prefix-p "deleted" event)
- (erc-d--drop-p (ring-ref exes -1))))
- (t (erc-d--teardown)))
- (erc-d--teardown)))))
-
-(defun erc-d--filter (process string)
- "Handle input received from peer.
-PROCESS represents a client peer connection and STRING is a raw request
-including line delimiters."
- (let ((queue (erc-d-dialog-queue (process-get process :dialog)))
- (delim (process-get process :ending-regexp)))
- (setq string (concat (process-get process :stashed-input) string))
- (while (and string (string-match delim string))
- (let ((line (substring string 0 (match-beginning 0))))
- (setq string (unless (= (match-end 0) (length string))
- (substring string (match-end 0))))
- (erc-d--log process line nil)
- (ring-insert queue (erc-d-i--parse-message line nil))))
- (when string
- (setf (process-get process :stashed-input) string))))
-
-;; Misc process properties:
-;;
-;; The server property `:dialog-dialogs' is an alist of (symbol
-;; . erc-d-u-scan-d) conses, each of which pairs a dialog's name with
-;; info on its read progress (described above in the Commentary).
-;; This list is populated by `erc-d-run' at the start of each session.
-;;
-;; Client-connection processes keep a reference to their server via a
-;; `:server' property, which can be used to share info with other
-;; clients. There is currently no built-in way to do the same with
-;; clients of other servers. Clients also keep references to their
-;; dialogs and raw messages via `:dialog' and `:stashed-input'.
-;;
-;; The logger stores a unique, human-friendly process name in the
-;; client-process property `:log-id'.
-
-(defun erc-d--start (host service name &rest plist)
- "Serve canned replies on HOST at SERVICE.
-Return the new server process immediately when `erc-d--in-process' is
-non-nil. Otherwise, serve forever. PLIST becomes the plist of the
-server process and is used to initialize the plists of connection
-processes. NAME is used for the process and the buffer."
- (let* ((buf (get-buffer-create (concat "*" name "*")))
- (proc (make-network-process :server t
- :buffer buf
- :noquery t
- :filter #'erc-d--filter
- :log #'erc-d--log-process-event
- :sentinel #'erc-d--process-sentinel
- :name name
- :family (if host 'ipv4 'local)
- :coding 'binary
- :service (or service t)
- :host host
- :plist plist)))
- (process-put proc :server proc)
- ;; We don't have a minor mode, so use an arbitrary variable to mark
- ;; buffers owned by us instead
- (with-current-buffer buf (setq erc-d-u--process-buffer t))
- (erc-d--m proc "Starting network process: %S %S"
- proc (erc-d-u--format-bind-address proc))
- (if erc-d--in-process
- proc
- (while (process-live-p proc)
- (accept-process-output nil 0.01)))))
-
-(defun erc-d--wrap-func-val (dialog exchange key func)
- "Return a form invoking FUNC when evaluated.
-Arrange for FUNC to be called with the args it expects based on
-the description in `erc-d--render-entries'."
- (let (args)
- ;; Ignore &rest or &optional
- (pcase-let ((`(,n . ,_) (func-arity func)))
- (pcase n
- (0)
- (1 (push (apply-partially #'erc-d-exchange-multi dialog exchange key)
- args))
- (2 (push exchange args)
- (push (apply-partially #'erc-d-exchange-multi dialog exchange key)
- args))
- (_ (error "Incompatible function: %s" func))))
- (lambda () (apply func args))))
-
-(defun erc-d-exchange-reload (dialog exchange)
- "Rebuild all bindings for EXCHANGE from those in DIALOG."
- (cl-loop for (key . val) in (erc-d-dialog-vars dialog)
- unless (keywordp key)
- do (push (erc-d-u--massage-rx-args key val)
- (erc-d-exchange-rx-bindings exchange))
- when (functionp val) do
- (setq val (erc-d--wrap-func-val dialog exchange key val))
- do (push (cons key val) (erc-d-exchange-bindings exchange))))
-
-(defun erc-d-exchange-rebind (dialog exchange key val &optional export)
- "Modify a binding between renders.
-
-Bind symbol KEY to VAL, replacing whatever existed before, which may
-have been a function. A third, optional argument, if present and
-non-nil, results in the DIALOG's bindings for all EXCHANGEs adopting
-this binding. VAL can either be a function of the type described in
-`erc-d--render-entries' or any value acceptable as an argument to the
-function `concat'.
-
-DIALOG and EXCHANGE are the current `erc-d-dialog' and `erc-d-exchange'
-objects for the request context."
- (when export
- (setf (alist-get key (erc-d-dialog-vars dialog)) val))
- (if (functionp val)
- (setf (alist-get key (erc-d-exchange-bindings exchange))
- (erc-d--wrap-func-val dialog exchange key val))
- (setf (alist-get key (erc-d-exchange-rx-bindings exchange)) (list val)
- (alist-get key (erc-d-exchange-bindings exchange)) val))
- val)
-
-(defun erc-d-exchange-match (exchange match-number &optional tag)
- "Return match portion of current or previous request.
-MATCH-NUMBER is the match group number. TAG, if provided, means the
-exchange tag (name) from some previously matched request."
- (if tag
- (pcase-let* ((dialog (erc-d-exchange-dialog exchange))
- (`(,m-d . ,req) (plist-get (erc-d-dialog-history dialog)
- tag)))
- (set-match-data m-d)
- (match-string match-number req))
- (match-string match-number (erc-d-exchange-request exchange))))
-
-(defun erc-d-exchange-multi (dialog exchange key cmd &rest args)
- "Call CMD with ARGS.
-This is a utility passed as the first argument to all template
-functions. DIALOG and EXCHANGE are pre-applied. A few pseudo
-commands, like `:request', are provided for convenience so that
-the caller's definition doesn't have to include this file. The
-rest are access and mutation utilities, such as `:set', which
-assigns KEY a new value, `:get-binding', which looks up KEY in
-`erc-d-exchange-bindings', and `:get-var', which looks up KEY in
-`erc-d-dialog-vars'."
- (pcase cmd
- (:set (apply #'erc-d-exchange-rebind dialog exchange key args))
- (:reload (apply #'erc-d-exchange-reload dialog exchange args))
- (:rebind (apply #'erc-d-exchange-rebind dialog exchange args))
- (:match (apply #'erc-d-exchange-match exchange args))
- (:request (erc-d-exchange-request exchange))
- (:match-data (erc-d-exchange-match-data exchange))
- (:dialog-name (erc-d-dialog-name dialog))
- (:get-binding (cdr (assq (car args) (erc-d-exchange-bindings exchange))))
- (:get-var (alist-get (car args) (erc-d-dialog-vars dialog)))))
-
-(defun erc-d--render-incoming-entry (exchange spec)
- (let ((rx--local-definitions (rx--extend-local-defs
- (erc-d-exchange-rx-bindings exchange))))
- (rx-to-string `(: bos ,@(erc-d-spec-entry spec)) 'no-group)))
-
-(defun erc-d--render-outgoing-entry (exchange entry)
- (let (out this)
- (while (setq this (pop entry))
- (set-match-data (erc-d-exchange-match-data exchange))
- (unless (stringp this)
- (cl-assert (symbolp this))
- (setq this (or (alist-get this (erc-d-exchange-bindings exchange))
- (symbol-value this)))
- ;; Allow reference to overlong var name unbecoming of a template
- (when this
- (when (symbolp this) (setq this (symbol-value this)))
- (when (functionp this) (setq this (save-match-data (funcall this))))
- (unless (stringp this) (error "Unexpected token %S" this))))
- (push this out))
- (apply #'concat (nreverse out))))
-
-(defun erc-d--render-entries (exchange &optional yield-result)
- "Act as an iterator producing rendered strings from EXCHANGE hunks.
-When an entry's CAR is an arbitrary symbol, yield that back first, and
-consider the entry an \"incoming\" entry. Then, regardless of the
-entry's type (incoming or outgoing), yield back the next element, which
-should be a number representing either a timeout (incoming) or a
-delay (outgoing). After that, yield a rendered template (outgoing) or a
-regular expression (incoming); both should be treated as immutable.
-
-When evaluating a template, bind the keys in the alist stored in the
-dialog's `vars' field to its values, but skip any self-quoters, like
-:foo. When an entry is incoming, replace occurrences of a key with its
-value, which can be any valid `rx' form (see Info node `(elisp)
-Extending Rx'). Do the same when an entry is outgoing, but expect a
-value's form to be (anything that evaluates to) something acceptable by
-`concat' or, alternatively, a function that returns a string or nil.
-
-Repeat the last two steps for the remaining entries, all of which are
-assumed to be outgoing. That is, continue yielding a timeout/delay and
-a rendered string for each entry, and yield nil when exhausted.
-
-Once again, for an incoming entry, the yielded string is a regexp to be
-matched against the raw request. For outgoing, it's the final response,
-ready to be sent out (after adding the appropriate line ending).
-
-To help with testing, bindings are not automatically created from
-DIALOG's \"vars\" alist when this function is invoked. But this can be
-forced by sending a non-nil YIELD-RESULT into the generator on the
-second \"next\" invocation of a given iteration. This clobbers any
-temporary bindings that don't exist in the DIALOG's `vars' alist, such
-as those added via `erc-d-exchange-rebind' (unless \"exported\").
-
-As noted earlier, template symbols can be bound to functions. When
-called during rendering, the match data from the current (matched)
-request is accessible by calling the function `match-data'.
-
-A function may ask for up to two required args, which are provided as
-needed. When applicable, the first required arg is a `funcall'-able
-helper that accepts various keyword-based commands, like :rebind, and a
-variable number of args. See `erc-d-exchange-multi' for details. When
-specified, the second required arg is the current `erc-d-exchange'
-object, which has among its members its owning `erc-d-dialog' object.
-This should suffice as a safety valve for any corner-case needs.
-Non-required args are ignored."
- (let ((spec (erc-d-exchange-spec exchange))
- (dialog (erc-d-exchange-dialog exchange))
- (entries (erc-d-exchange-hunk exchange)))
- (unless (erc-d-spec-entry spec)
- (setf (erc-d-spec-entry spec) (erc-d-u--read-exchange entries)))
- (catch 'yield
- (while (erc-d-spec-entry spec)
- (pcase (erc-d-spec-state spec)
- (0 (cl-incf (erc-d-spec-state spec))
- (throw 'yield (setf (erc-d-spec-head spec)
- (pop (erc-d-spec-entry spec)))))
- (1 (cl-incf (erc-d-spec-state spec))
- (when yield-result
- (erc-d-exchange-reload dialog exchange))
- (unless (numberp (erc-d-spec-head spec))
- (setf (erc-d-exchange-inspec exchange) (erc-d-spec-entry spec))
- (throw 'yield
- (prog1 (pop (erc-d-spec-entry spec))
- (setf (erc-d-spec-entry spec)
- (erc-d--render-incoming-entry exchange spec))))))
- (2 (setf (erc-d-spec-state spec) 0)
- (throw 'yield
- (let ((entry (erc-d-spec-entry spec)))
- (setf (erc-d-spec-entry spec) nil)
- (if (stringp entry)
- entry
- (erc-d--render-outgoing-entry exchange entry))))))))))
-
-(defun erc-d--iter (exchange)
- (apply-partially #'erc-d--render-entries exchange))
-
-(defun erc-d-on-match (dialog exchange)
- "Handle matched exchange request.
-Allow the first handler in `erc-d-match-handlers' whose key matches TAG
-to manipulate replies before they're sent to the DIALOG peer."
- (when-let* ((tag (erc-d-exchange-tag exchange))
- (handler (plist-get (erc-d-dialog-match-handlers dialog) tag)))
- (let ((md (erc-d-exchange-match-data exchange)))
- (set-match-data md)
- (funcall handler dialog exchange))))
-
-(defun erc-d--send-outgoing (dialog exchange)
- "Send outgoing lines for EXCHANGE to DIALOG peer.
-Assume the next spec is outgoing. If its delay value is zero, render
-the template and send the resulting message straight away. Do the same
-when DELAY is negative, only arrange for its message to be sent (abs
-DELAY) seconds later, and then keep on processing. If DELAY is
-positive, pause processing and yield DELAY."
- (let ((specs (erc-d--iter exchange))
- (process (erc-d-dialog-process dialog))
- (deferred (erc-d-exchange-deferred exchange))
- delay)
- ;; Could stash/pass thunk instead to ensure specs can't be mutated
- ;; between calls (by temporarily replacing dialog member with a fugazi)
- (when deferred
- (erc-d--send process (funcall specs))
- (setf deferred nil (erc-d-exchange-deferred exchange) deferred))
- (while (and (not deferred) (setq delay (funcall specs)))
- (cond ((zerop delay) (erc-d--send process (funcall specs)))
- ((< delay 0) (push (run-at-time (- delay) nil #'erc-d--send
- process (funcall specs))
- (erc-d-dialog-timers dialog)))
- ((setf deferred t (erc-d-exchange-deferred exchange) deferred))))
- delay))
-
-(defun erc-d--add-dialog-linger (dialog exchange)
- "Add finalizer for EXCHANGE in DIALOG."
- (erc-d--m (erc-d-dialog-process dialog)
- "Lingering for %.2f seconds" (erc-d-exchange-timeout exchange))
- (let ((start (current-time)))
- (setf (erc-d-dialog-finalizer dialog)
- (lambda (&rest _)
- (erc-d--m (erc-d-dialog-process dialog)
- "Lingered for %.2f seconds"
- (float-time (time-subtract (current-time) start)))
- (erc-d--teardown-this-dialog-at-least dialog)))))
-
-(defun erc-d--add-dialog-drop (dialog exchange)
- "Add finalizer for EXCHANGE in DIALOG."
- (erc-d--m (erc-d-dialog-process dialog)
- "Dropping in %.2f seconds" (erc-d-exchange-timeout exchange))
- (setf (erc-d-dialog-finalizer dialog)
- (lambda (&rest _)
- (erc-d--m (erc-d-dialog-process dialog)
- "Dropping %S" (erc-d-dialog-name dialog))
- (erc-d--finalize-dialog dialog))))
-
-(defun erc-d--create-exchange (dialog hunk)
- "Initialize next exchange HUNK for DIALOG."
- (let* ((spec (make-erc-d-spec))
- (exchange (make-erc-d-exchange :dialog dialog :hunk hunk :spec spec))
- (specs (erc-d--iter exchange)))
- (setf (erc-d-exchange-tag exchange) (funcall specs)
- (erc-d-exchange-timeout exchange) (funcall specs t)
- (erc-d-exchange-pattern exchange) (funcall specs))
- (cond ((erc-d--linger-p exchange)
- (erc-d--add-dialog-linger dialog exchange))
- ((erc-d--drop-p exchange)
- (erc-d--add-dialog-drop dialog exchange)))
- (setf (erc-d-exchange-timer exchange)
- (run-at-time (erc-d-exchange-timeout exchange)
- nil #'erc-d--expire dialog exchange))
- exchange))
-
-(defun erc-d--command-consider-prep-fail (dialog line exes)
- (list 'error "Match failed: %S %S" line
- (list :exes (mapcar #'erc-d-exchange-pattern
- (ring-elements exes))
- :dialog (erc-d-dialog-name dialog))))
-
-(defun erc-d--command-consider-prep-success (dialog line exes matched)
- (setf (erc-d-exchange-request matched) line
- (erc-d-exchange-match-data matched) (match-data)
- ;; Also add current to match history, indexed by exchange tag
- (plist-get (erc-d-dialog-history dialog)
- (erc-d-exchange-tag matched))
- (cons (match-data) line)) ; do we need to make a copy of this?
- (cancel-timer (erc-d-exchange-timer matched))
- (ring-remove exes (ring-member exes matched)))
-
-(cl-defun erc-d--command-consider (dialog)
- "Maybe return next matched exchange for DIALOG.
-Upon encountering a mismatch, return an error of the form (ERROR-SYMBOL
-DATA). But when only fuzzies remain in the exchange pool, return nil."
- (let* ((parsed (erc-d-dialog-message dialog))
- (line (erc-d-i-message.unparsed parsed))
- (exes (erc-d-dialog-exchanges dialog))
- ;;
- matched)
- (let ((elts (ring-elements exes)))
- (while (and (setq matched (pop elts))
- (not (string-match (erc-d-exchange-pattern matched) line)))
- (if (and (not elts) (erc-d--fuzzy-p matched))
- ;; Nothing to do, so advance
- (cl-return-from erc-d--command-consider nil)
- (cl-assert (or (not elts) (erc-d--fuzzy-p matched))))))
- (if matched
- (erc-d--command-consider-prep-success dialog line exes matched)
- (erc-d--command-consider-prep-fail dialog line exes))))
-
-(defun erc-d--active-ex-p (ring)
- "Return non-nil when RING has a non-fuzzy exchange.
-That is, return nil when RING is empty or when it only has exchanges
-with leading-tilde tags."
- (let ((i 0)
- (len (ring-length ring))
- ex found)
- (while (and (not found) (< i len))
- (unless (erc-d--fuzzy-p (setq ex (ring-ref ring i)))
- (setq found ex))
- (cl-incf i))
- found))
-
-(defun erc-d--finalize-done (dialog)
- ;; Linger logic for individual dialogs is handled elsewhere
- (if-let ((finalizer (erc-d-dialog-finalizer dialog)))
- (funcall finalizer dialog)
- (let ((d (process-get (erc-d-dialog-process dialog) :dialog-linger-secs)))
- (push (run-at-time d nil #'erc-d--teardown)
- (erc-d-dialog-timers dialog)))))
-
-(defun erc-d--advance-or-die (dialog)
- "Govern the lifetime of DIALOG.
-Replenish exchanges from reader and insert them into the pool of
-expected matches, as produced. Return a symbol indicating session
-status: deferring, matching, depleted, or done."
- (let ((exes (erc-d-dialog-exchanges dialog))
- hunk)
- (cond ((erc-d--active-ex-p exes) 'deferring)
- ((setq hunk (erc-d-u--read-dialog (erc-d-dialog-hunks dialog)))
- (let ((exchange (erc-d--create-exchange dialog hunk)))
- (if (erc-d--fuzzy-p exchange)
- (ring-insert exes exchange)
- (ring-insert-at-beginning exes exchange)))
- 'matching)
- ((not (ring-empty-p exes)) 'depleted)
- (t 'done))))
-
-(defun erc-d--command-meter-replies (dialog exchange &optional cmd)
- "Ignore requests until all replies have been sent.
-Do this for some previously matched EXCHANGE in DIALOG based on CMD, a
-symbol. As a side effect, maybe schedule the resumption of the main
-loop after some delay."
- (let (delay)
- (if (or (not cmd) (eq 'resume cmd))
- (when (setq delay (erc-d--send-outgoing dialog exchange))
- (push (run-at-time delay nil #'erc-d--command-handle-all
- dialog 'resume)
- (erc-d-dialog-timers dialog))
- (erc-d-dialog-state dialog))
- (setf (erc-d-dialog-state dialog) 'sending))))
-
-(defun erc-d--die-unexpected (dialog)
- (erc-d--teardown 'error "Received unexpected input: %S"
- (erc-d-i-message.unparsed (erc-d-dialog-message dialog))))
-
-(defun erc-d--command-refresh (dialog matched)
- (let ((state (erc-d--advance-or-die dialog)))
- (when (eq state 'done)
- (erc-d--finalize-done dialog))
- (unless matched
- (when (eq state 'depleted)
- (erc-d--die-unexpected dialog))
- (cl-assert (memq state '(matching depleted)) t))
- (setf (erc-d-dialog-state dialog) state)))
-
-(defun erc-d--command-handle-all (dialog cmd)
- "Create handler to act as control agent and process DIALOG requests.
-Have it ingest internal control commands (lowercase symbols) and yield
-back others indicating the lifecycle stage of the current dialog."
- (let ((matched (erc-d-dialog-matched dialog)))
- (cond
- (matched
- (or (erc-d--command-meter-replies dialog matched cmd)
- (setf (erc-d-dialog-matched dialog) nil)
- (erc-d--command-refresh dialog t)))
- ((pcase cmd ; FIXME remove command facility or make extensible
- ('resume nil)
- ('eof (erc-d--m (erc-d-dialog-process dialog) "Received an EOF") nil)))
- (t ; matching
- (setq matched nil)
- (catch 'yield
- (while (not matched)
- (when (ring-empty-p (erc-d-dialog-exchanges dialog))
- (erc-d--die-unexpected dialog))
- (when (setq matched (erc-d--command-consider dialog))
- (if (eq (car-safe matched) 'error)
- (apply #'erc-d--teardown matched)
- (erc-d-on-match dialog matched)
- (setf (erc-d-dialog-matched dialog) matched)
- (if-let ((s (erc-d--command-meter-replies dialog matched nil)))
- (throw 'yield s)
- (setf (erc-d-dialog-matched dialog) nil))))
- (erc-d--command-refresh dialog matched)))))))
-
-;;;; Handlers for IRC commands
-
-(cl-defgeneric erc-d-command (dialog cmd)
- "Handle new CMD from client for DIALOG.
-By default, defer to this dialog's `erc-d--command-handle-all' instance,
-which is stored in its `handler' field.")
-
-(cl-defmethod erc-d-command ((dialog erc-d-dialog) cmd)
- (when (eq 'sending (erc-d--command-handle-all dialog cmd))
- (ring-insert-at-beginning (erc-d-dialog-queue dialog)
- (erc-d-dialog-message dialog))))
-
-;; A similar PONG handler would be useless because we know when to
-;; expect them
-
-(cl-defmethod erc-d-command ((dialog erc-d-dialog) (_cmd (eql PING))
- &context (erc-d-auto-pong (eql t)))
- "Respond to PING request from DIALOG peer when ERC-D-AUTO-PONG is t."
- (let* ((parsed (erc-d-dialog-message dialog))
- (process (erc-d-dialog-process dialog))
- (nonce (car (erc-d-i-message.command-args parsed)))
- (fqdn (erc-d-dialog-server-fqdn dialog)))
- (erc-d--send process (format ":%s PONG %s :%s" fqdn fqdn nonce))))
-
-
-;;;; Entry points
-
-(defun erc-d-run (host service &optional server-name &rest dialogs)
- "Start serving DIALOGS on HOST at SERVICE.
-Pass HOST and SERVICE directly to `make-network-process'. When present,
-use string SERVER-NAME for the server-process name as well as that of
-its buffer (w. surrounding asterisks). When absent, do the same with
-`erc-d-server-name'. When running \"in process,\" return the server
-process; otherwise sleep until it dies.
-
-A dialog must be a symbol matching the base name of a dialog file in
-`erc-d-u-canned-dialog-dir'. Global variables `erc-d-server-fqdn',
-`erc-d-linger-secs', and `erc-d-tmpl-vars' determine the process's
-`erc-d-dialog' fields `:server-fqdn', `:linger-secs', and `:vars',
-respectively. The latter may also be populated via keyword pairs
-appearing among DIALOGS."
- (when (and server-name (symbolp server-name))
- (push server-name dialogs)
- (setq server-name nil))
- (let (loaded kwds defaults args)
- (while dialogs
- (if-let* ((dlog (pop dialogs))
- ((keywordp dlog)))
- (progn (push (pop dialogs) kwds) (push dlog kwds))
- (let ((reader (erc-d-u--canned-load-dialog dlog)))
- (when erc-d--slow-mo
- (setq reader (erc-d-u--rewrite-for-slow-mo erc-d--slow-mo reader)))
- (push (cons (erc-d-u--normalize-canned-name dlog) reader) loaded))))
- (setq kwds (erc-d-u--unkeyword kwds)
- defaults `((ending . ,erc-d-line-ending)
- (server-fqdn . ,erc-d-server-fqdn)
- (linger-secs . ,erc-d-linger-secs)
- (vars . ,(or (plist-get kwds 'tmpl-vars) erc-d-tmpl-vars))
- (dialogs . ,(nreverse loaded)))
- args (list :dialog-match-handlers
- (erc-d-u--unkeyword (or (plist-get kwds 'match-handlers)
- erc-d-match-handlers))))
- (pcase-dolist (`(,var . ,def) defaults)
- (push (or (plist-get kwds var) def) args)
- (push (intern (format ":dialog-%s" var)) args))
- (apply #'erc-d--start host service (or server-name erc-d-server-name)
- args)))
-
-(defun erc-d-serve ()
- "Start serving canned dialogs from the command line.
-Although not autoloaded, this function is meant to be summoned via the
-Emacs -f flag while starting a batch session. It prints incoming and
-outgoing messages to standard out.
-
-The main options are --host HOST and --port PORT, which default to
-localhost and auto, respectively. The args are the dialogs to run.
-Unlike with `erc-d-run', dialogs here *must* be files, meaning Lisp-Data
-files adhering to the required format. (These consist of \"specs\"
-detailing timing and template info; see commentary for specifics.)
-
-An optional --add-time N option can also be passed to hike up timeouts
-by some number of seconds N. For example, you might run:
-
- $ emacs -Q -batch -L . \\
- > -l erc-d.el \\
- > -f erc-d-serve \\
- > --host 192.168.124.1 \\
- > --port 16667 \\
- > --add-time 10 \\
- > ./my-dialog.eld
-
-from a Makefile or manually with \\<global-map>\\[compile]. And then in
-another terminal, do:
-
- $ nc -C 192.168.124.1 16667 ; or telnet if your nc doesn't have -C
- > PASS changeme
- ...
-
-Use `erc-d-run' instead to start the server from within Emacs."
- (unless noninteractive
- (error "Command-line func erc-d-serve not run in -batch session"))
- (setq erc-d--in-process nil)
- (let (port host dialogs erc-d--slow-mo)
- (while command-line-args-left
- (pcase (pop command-line-args-left)
- ("--add-time" (setq erc-d--slow-mo
- (string-to-number (pop command-line-args-left))))
- ("--linger" (setq erc-d-linger-secs
- (string-to-number (pop command-line-args-left))))
- ("--host" (setq host (pop command-line-args-left)))
- ("--port" (setq port (string-to-number (pop command-line-args-left))))
- (dialog (push dialog dialogs))))
- (setq dialogs (mapcar #'erc-d-u--massage-canned-name dialogs))
- (when erc-d--slow-mo
- (message "Slow mo is ON"))
- (apply #'erc-d-run (or host "localhost") port nil (nreverse dialogs))))
-
-(provide 'erc-d)
-
-;;; erc-d.el ends here
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-
-((pass 10.0 "PASS " (? ?:) "changeme"))
-((nick 0.2 "NICK tester"))
-
-((user 0.2 "USER user 0 * :tester")
- (0 ":irc.example.org 001 tester :Welcome to the Internet Relay Network tester")
- (0 ":irc.example.org 002 tester :Your host is irc.example.org")
- (0 ":irc.example.org 003 tester :This server was created just now")
- (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
- (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
- ;; Just to mix thing's up (force handler to schedule timer)
- (0.1 ":irc.example.org 252 tester 0 :IRC Operators online")
- (0 ":irc.example.org 253 tester 0 :unregistered connections")
- (0 ":irc.example.org 254 tester 1 :channels formed")
- (0 ":irc.example.org 255 tester :I have 3 clients and 0 servers")
- (0.1 ":irc.example.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.example.org 422 tester :MOTD File is missing"))
-
-((mode-user 5 "MODE tester +i")
- (0 ":irc.example.org 221 tester +Zi")
- (0 ":irc.example.org 306 tester :You have been marked as being away")
- (0 ":tester!~tester@localhost JOIN #chan")
- (0 ":irc.example.org 353 alice = #chan :+alice @bob")
- (0 ":irc.example.org 366 alice #chan :End of NAMES list"))
-
-;; Some comment (to prevent regression)
-((mode-chan 3.2 "MODE #chan")
- (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-
-((pass 10.0 "PASS :changeme"))
-
-((~fake 3.2 "FAKE ")
- (0.1 ":irc.example.org FAKE irc.example.com :ok"))
-
-((nick 0.2 "NICK tester"))
-
-((user 0.2 "USER user 0 * :tester")
- (0 ":irc.example.org 001 tester :Welcome to the Internet tester")
- (0 ":irc.example.org 422 tester :MOTD File is missing"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS " (? ?:) "a")
- (0 "hi"))
-((drop 0.01 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS " (? ?:) "b")
- (0 "hi"))
-((linger 1 LINGER))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-((fake 0 "FAKE noop"))
-
-((nick 1.2 "NICK tester"))
-
-((user 2.2 "USER user 0 * :tester")
- (0. ":irc.barnet.org 001 tester :Welcome to the BAR Network tester")
- (0. ":irc.barnet.org 002 tester :Your host is irc.barnet.org")
- (0. ":irc.barnet.org 003 tester :This server was created just now")
- (0. ":irc.barnet.org 004 tester irc.barnet.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0. ":irc.barnet.org 005 tester MODES NETWORK=BarNet NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
- (0. ":irc.barnet.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
- (0. ":irc.barnet.org 252 tester 0 :IRC Operators online")
- (0. ":irc.barnet.org 253 tester 0 :unregistered connections")
- (0. ":irc.barnet.org 254 tester 1 :channels formed")
- (0. ":irc.barnet.org 255 tester :I have 3 clients and 0 servers")
- (0. ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3")
- (0. ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
- (0. ":irc.barnet.org 422 tester :MOTD File is missing"))
-
-((mode-user 2 "MODE tester +i")
- (0. ":irc.barnet.org 221 tester +Zi")
- (0. ":irc.barnet.org 306 tester :You have been marked as being away")
- (0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan")
- (0 ":irc.barnet.org 353 joe = #chan :+joe @mike")
- (0 ":irc.barnet.org 366 joe #chan :End of NAMES list"))
-
-((mode 3 "MODE #chan")
- (0 ":irc.barnet.org 324 tester #chan +nt")
- (0 ":irc.barnet.org 329 tester #chan 1620805269")
- (0.1 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: Yes, a dozen; and as many to the vantage, as would store the world they played for.")
- (0.05 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: As he regards his aged father's life.")
- (0.05 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonor in doing it."))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-
-((nick 1.2 "NICK tester"))
-
-((user 2.2 "USER user 0 * :tester")
- (0. ":irc.foonet.org 001 tester :Welcome to the FOO Network tester")
- (0. ":irc.foonet.org 002 tester :Your host is irc.foonet.org")
- (0. ":irc.foonet.org 003 tester :This server was created just now")
- (0. ":irc.foonet.org 004 tester irc.foonet.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0. ":irc.foonet.org 005 tester MODES NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
- (0. ":irc.foonet.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
- (0. ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0. ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0. ":irc.foonet.org 254 tester 1 :channels formed")
- (0. ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0. ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0. ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0. ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 4 "MODE tester +i")
- (0. ":irc.foonet.org 221 tester +Zi")
- (0. ":irc.foonet.org 306 tester :You have been marked as being away")
- (0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan")
- (0 ":irc.foonet.org 353 alice = #chan :+alice @bob")
- (0 ":irc.foonet.org 366 alice #chan :End of NAMES list"))
-
-((mode 3 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620805269")
- (0.1 ":alice!~u@awyxgybtkx7uq.irc PRIVMSG #chan :bob: Yes, a dozen; and as many to the vantage, as would store the world they played for.")
- (0.05 ":bob!~u@awyxgybtkx7uq.irc PRIVMSG #chan :alice: As he regards his aged father's life.")
- (0.05 ":alice!~u@awyxgybtkx7uq.irc PRIVMSG #chan :bob: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonor in doing it."))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-((pass 10.0 "PASS " (? ?:) token ":changeme"))
-
-((fake 0 "FAKE"))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-((pass 10.0 "PASS " (? ?:) "changeme"))
-((nick 2.2 "NICK tester"))
-
-((user 2.2 "USER " user " " (ignored digit "*") " :" realname)
- (0.0 ":" dom " 001 " nick " :Welcome to the Internet Relay Network tester")
- (0.0 ":" dom " 002 " nick " :Your host is " dom)
- (0.0 ":" dom " 003 " nick " :This server was created just now")
- (0.0 ":" dom " 004 " nick " " dom " BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0.0 ":" dom " 005 " nick " MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
- (0.0 ":" dom " 251 " nick " :There are 3 users and 0 invisible on 1 server(s)")
- (0.0 ":" dom " 252 " nick " 0 :IRC Operators online")
- (0.0 ":" dom " 253 " nick " 0 :unregistered connections")
- (0.0 ":" dom " 254 " nick " 1 :channels formed")
- (0.0 ":" dom " 255 " nick " :I have 3 clients and 0 servers")
- (0.0 ":" dom " 265 " nick " 3 3 :Current local users 3, max 3")
- (0.0 ":" dom " 266 " nick " 3 3 :Current global users 3, max 3")
- (0.0 ":" dom " 422 " nick " :MOTD File is missing"))
-
-((mode-user 2.2 "MODE tester +i")
- (0.0 ":" dom " 221 " nick " +Zi")
-
- (0.0 ":" dom " 306 " nick " :You have been marked as being away")
- (0.0 ":" nick "!~" nick "@localhost JOIN #chan")
- (0.0 ":" dom " 353 alice = #chan :+alice @bob")
- (0.0 ":" dom " 366 alice #chan :End of NAMES list"))
-
-((mode 2.2 "MODE #chan")
- (0.1 ":bob!~bob@example.org PRIVMSG #chan :" nick ": hey"))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-
-((pass 10.0 "PASS " (? ?:) "changeme"))
-((nick 0.2 "NICK tester"))
-
-((user 0.2 "USER user 0 * :tester")
- (0 ":irc.example.org 001 tester :Welcome to the Internet Relay Network tester")
- (0 ":irc.example.org 002 tester :Your host is irc.example.org")
- (0 ":irc.example.org 003 tester :This server was created just now")
- (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
- (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
- ;; Just to mix thing's up (force handler to schedule timer)
- (0.1 ":irc.example.org 252 tester 0 :IRC Operators online")
- (0 ":irc.example.org 253 tester 0 :unregistered connections")
- (0 ":irc.example.org 254 tester 1 :channels formed")
- (0 ":irc.example.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.example.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.example.org 422 tester :MOTD File is missing"))
-
-((mode-user 1.2 "MODE tester +i")
- (0 ":irc.example.org 221 tester +Zi")
- (0 ":irc.example.org 306 tester :You have been marked as being away")
- (0 ":tester!~tester@localhost JOIN #chan")
- (0 ":irc.example.org 353 alice = #chan :+alice @bob")
- (0 ":irc.example.org 366 alice #chan :End of NAMES list"))
-
-((mode-chan 1.2 "MODE #chan")
- (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))
-
-((eof 1.0 EOF))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-((one 5 "ONE one")
- (0 "echo ONE one"))
-((two 5 "TWO two")
- (0 "echo TWO two"))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-((pass 10.0 "PASS " (? ?:) "changeme"))
-((nick 0.2 "NICK tester"))
-
-((user 0.5 "USER user 0 * :tester")
- (0.0 "@time=" now " :irc.org 001 tester :Welcome to the Internet Relay Network tester")
- (0.0 "@time=" now " :irc.org 002 tester :Your host is irc.org")
- (0.0 "@time=" now " :irc.org 003 tester :This server was created just now")
- (0.0 "@time=" now " :irc.org 004 tester irc.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0.0 "@time=" now " :irc.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
- (0.0 "@time=" now " :irc.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
- (0.0 "@time=" now " :irc.org 252 tester 0 :IRC Operators online")
- (0.0 "@time=" now " :irc.org 253 tester 0 :unregistered connections")
- (0.0 "@time=" now " :irc.org 254 tester 1 :channels formed")
- (0.0 "@time=" now " :irc.org 255 tester :I have 3 clients and 0 servers")
- (0.0 "@time=" now " :irc.org 265 tester 3 3 :Current local users 3, max 3")
- (0.0 "@time=" now " :irc.org 266 tester 3 3 :Current global users 3, max 3")
- (0.0 "@time=" now " :irc.org 422 tester :MOTD File is missing"))
-
-((mode-user 1.2 "MODE tester +i")
- (0.0 "@time=" now " :irc.org 221 tester +Zi")
- (0.0 "@time=" now " :irc.org 306 tester :You have been marked as being away"))
-
-((~join-foo 3.2 "JOIN #foo")
- (0 "@time=" now " :tester!~tester@localhost JOIN #foo")
- (0 "@time=" now " :irc.example.org 353 alice = #foo :+alice @bob")
- (0 "@time=" now " :irc.example.org 366 alice #foo :End of NAMES list"))
-
-((~join-bar 1.2 "JOIN #bar")
- (0 "@time=" now " :tester!~tester@localhost JOIN #bar")
- (0 "@time=" now " :irc.example.org 353 alice = #bar :+alice @bob")
- (0 "@time=" now " :irc.example.org 366 alice #bar :End of NAMES list"))
-
-((~mode-foo 3.2 "MODE #foo")
- (0.0 "@time=" now " :irc.example.org 324 tester #foo +Cint")
- (0.0 "@time=" now " :irc.example.org 329 tester #foo 1519850102")
- (0.1 "@time=" now " :bob!~bob@example.org PRIVMSG #foo :hey"))
-
-((mode-bar 10.2 "MODE #bar")
- (0.0 "@time=" now " :irc.example.org 324 tester #bar +HMfnrt 50:5h :10:5")
- (0.0 "@time=" now " :irc.example.org 329 tester #bar :1602642829")
- (0.1 "@time=" now " :alice!~alice@example.com PRIVMSG #bar :hi"))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-((pass 10.0 "PASS " (? ?:) "changeme"))
-((nick 0.2 "NICK tester"))
-
-((user 0.2 "USER user 0 * :tester")
- (0.0 ":irc.foo.net 001 tester :Welcome to the Internet Relay Network tester")
- (0.0 ":irc.foo.net 002 tester :Your host is irc.foo.net")
- (0.0 ":irc.foo.net 003 tester :This server was created just now")
- (0.0 ":irc.foo.net 004 tester irc.foo.net BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0.0 ":irc.foo.net 005 tester MODES NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
- (0.0 ":irc.foo.net 251 tester :There are 3 users and 0 invisible on 1 server(s)")
- (0.0 ":irc.foo.net 252 tester 0 :IRC Operators online")
- (0.0 ":irc.foo.net 253 tester 0 :unregistered connections")
- (0.0 ":irc.foo.net 254 tester 1 :channels formed")
- (0.0 ":irc.foo.net 255 tester :I have 3 clients and 0 servers")
- (0.0 ":irc.foo.net 265 tester 3 3 :Current local users 3, max 3")
- (0.0 ":irc.foo.net 266 tester 3 3 :Current global users 3, max 3")
- (0.0 ":irc.foo.net 422 tester :MOTD File is missing"))
-
-((mode-user 1.2 "MODE tester +i")
- (0.0 ":irc.foo.net 221 tester +Zi")
- (0.0 ":irc.foo.net 306 tester :You have been marked as being away"))
-
-((join 3 "JOIN #foo")
- (0 ":tester!~tester@localhost JOIN #foo")
- (0 ":irc.foo.net 353 alice = #foo :+alice @bob")
- (0 ":irc.foo.net 366 alice #foo :End of NAMES list"))
-
-((mode 3 "MODE #foo")
- (0.0 ":irc.foo.net 324 tester #foo +Cint")
- (0.0 ":irc.foo.net 329 tester #foo 1519850102")
- (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: But, in defense, by mercy, 'tis most just.")
- (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: Grows, lives, and dies, in single blessedness.")
- (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :Look for me.")
- (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: By this hand, it will not kill a fly. But come, now I will be your Rosalind in a more coming-on disposition; and ask me what you will, I will grant it.")
- (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: That I must love a loathed enemy.")
- (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: As't please your lordship: I'll leave you.")
- (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: Then there is no true lover in the forest; else sighing every minute and groaning every hour would detect the lazy foot of Time as well as a clock.")
- (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: His discretion, I am sure, cannot carry his valour, for the goose carries not the fox. It is well: leave it to his discretion, and let us listen to the moon.")
- (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :Done"))
-
-((hi 10 "PRIVMSG #foo :Hi"))
+++ /dev/null
-;;; -*- mode: lisp-data; -*-
-
-;; https://github.com/DanielOaks/irc-parser-tests
-((mask-match
- (tests
- ((mask . "*@127.0.0.1")
- (matches "coolguy!ab@127.0.0.1" "cooldud3!~bc@127.0.0.1")
- (fails "coolguy!ab@127.0.0.5" "cooldud3!~d@124.0.0.1"))
- ((mask . "cool*@*")
- (matches "coolguy!ab@127.0.0.1" "cooldud3!~bc@127.0.0.1" "cool132!ab@example.com")
- (fails "koolguy!ab@127.0.0.5" "cooodud3!~d@124.0.0.1"))
- ((mask . "cool!*@*")
- (matches "cool!guyab@127.0.0.1" "cool!~dudebc@127.0.0.1" "cool!312ab@example.com")
- (fails "coolguy!ab@127.0.0.1" "cooldud3!~bc@127.0.0.1" "koolguy!ab@127.0.0.5" "cooodud3!~d@124.0.0.1"))
- ((mask . "cool!?username@*")
- (matches "cool!ausername@127.0.0.1" "cool!~username@127.0.0.1")
- (fails "cool!username@127.0.0.1"))
- ((mask . "cool!a?*@*")
- (matches "cool!ab@127.0.0.1" "cool!abc@127.0.0.1")
- (fails "cool!a@127.0.0.1"))
- ((mask . "cool[guy]!*@*")
- (matches "cool[guy]!guy@127.0.0.1" "cool[guy]!a@example.com")
- (fails "coolg!ab@127.0.0.1" "cool[!ac@127.0.1.1"))))
- (msg-join
- (tests
- ((desc . "Simple test with verb and params.")
- (atoms
- (verb . "foo")
- (params "bar" "baz" "asdf"))
- (matches "foo bar baz asdf" "foo bar baz :asdf"))
- ((desc . "Simple test with source and no params.")
- (atoms
- (source . "src")
- (verb . "AWAY"))
- (matches ":src AWAY"))
- ((desc . "Simple test with source and empty trailing param.")
- (atoms
- (source . "src")
- (verb . "AWAY")
- (params ""))
- (matches ":src AWAY :"))
- ((desc . "Simple test with source.")
- (atoms
- (source . "coolguy")
- (verb . "foo")
- (params "bar" "baz" "asdf"))
- (matches ":coolguy foo bar baz asdf" ":coolguy foo bar baz :asdf"))
- ((desc . "Simple test with trailing param.")
- (atoms
- (verb . "foo")
- (params "bar" "baz" "asdf quux"))
- (matches "foo bar baz :asdf quux"))
- ((desc . "Simple test with empty trailing param.")
- (atoms
- (verb . "foo")
- (params "bar" "baz" ""))
- (matches "foo bar baz :"))
- ((desc . "Simple test with trailing param containing colon.")
- (atoms
- (verb . "foo")
- (params "bar" "baz" ":asdf"))
- (matches "foo bar baz ::asdf"))
- ((desc . "Test with source and trailing param.")
- (atoms
- (source . "coolguy")
- (verb . "foo")
- (params "bar" "baz" "asdf quux"))
- (matches ":coolguy foo bar baz :asdf quux"))
- ((desc . "Test with trailing containing beginning+end whitespace.")
- (atoms
- (source . "coolguy")
- (verb . "foo")
- (params "bar" "baz" " asdf quux "))
- (matches ":coolguy foo bar baz : asdf quux "))
- ((desc . "Test with trailing containing what looks like another trailing param.")
- (atoms
- (source . "coolguy")
- (verb . "PRIVMSG")
- (params "bar" "lol :) "))
- (matches ":coolguy PRIVMSG bar :lol :) "))
- ((desc . "Simple test with source and empty trailing.")
- (atoms
- (source . "coolguy")
- (verb . "foo")
- (params "bar" "baz" ""))
- (matches ":coolguy foo bar baz :"))
- ((desc . "Trailing contains only spaces.")
- (atoms
- (source . "coolguy")
- (verb . "foo")
- (params "bar" "baz" " "))
- (matches ":coolguy foo bar baz : "))
- ((desc . "Param containing tab (tab is not considered SPACE for message splitting).")
- (atoms
- (source . "coolguy")
- (verb . "foo")
- (params "b ar" "baz"))
- (matches ":coolguy foo b ar baz" ":coolguy foo b ar :baz"))
- ((desc . "Tag with no value and space-filled trailing.")
- (atoms
- (tags
- (asd . ""))
- (source . "coolguy")
- (verb . "foo")
- (params "bar" "baz" " "))
- (matches "@asd :coolguy foo bar baz : "))
- ((desc . "Tags with escaped values.")
- (atoms
- (verb . "foo")
- (tags
- (a . "b\\and\nk")
- (d . "gh;764")))
- (matches "@a=b\\\\and\\nk;d=gh\\:764 foo" "@d=gh\\:764;a=b\\\\and\\nk foo"))
- ((desc . "Tags with escaped values and params.")
- (atoms
- (verb . "foo")
- (tags
- (a . "b\\and\nk")
- (d . "gh;764"))
- (params "par1" "par2"))
- (matches "@a=b\\\\and\\nk;d=gh\\:764 foo par1 par2" "@a=b\\\\and\\nk;d=gh\\:764 foo par1 :par2" "@d=gh\\:764;a=b\\\\and\\nk foo par1 par2" "@d=gh\\:764;a=b\\\\and\\nk foo par1 :par2"))
- ((desc . "Tag with long, strange values (including LF and newline).")
- (atoms
- (tags
- (foo . "\\\\;\\s \r\n"))
- (verb . "COMMAND"))
- (matches "@foo=\\\\\\\\\\:\\\\s\\s\\r\\n COMMAND"))))
- (msg-split
- (tests
- ((input . "foo bar baz asdf")
- (atoms
- (verb . "foo")
- (params "bar" "baz" "asdf")))
- ((input . ":coolguy foo bar baz asdf")
- (atoms
- (source . "coolguy")
- (verb . "foo")
- (params "bar" "baz" "asdf")))
- ((input . "foo bar baz :asdf quux")
- (atoms
- (verb . "foo")
- (params "bar" "baz" "asdf quux")))
- ((input . "foo bar baz :")
- (atoms
- (verb . "foo")
- (params "bar" "baz" "")))
- ((input . "foo bar baz ::asdf")
- (atoms
- (verb . "foo")
- (params "bar" "baz" ":asdf")))
- ((input . ":coolguy foo bar baz :asdf quux")
- (atoms
- (source . "coolguy")
- (verb . "foo")
- (params "bar" "baz" "asdf quux")))
- ((input . ":coolguy foo bar baz : asdf quux ")
- (atoms
- (source . "coolguy")
- (verb . "foo")
- (params "bar" "baz" " asdf quux ")))
- ((input . ":coolguy PRIVMSG bar :lol :) ")
- (atoms
- (source . "coolguy")
- (verb . "PRIVMSG")
- (params "bar" "lol :) ")))
- ((input . ":coolguy foo bar baz :")
- (atoms
- (source . "coolguy")
- (verb . "foo")
- (params "bar" "baz" "")))
- ((input . ":coolguy foo bar baz : ")
- (atoms
- (source . "coolguy")
- (verb . "foo")
- (params "bar" "baz" " ")))
- ((input . "@a=b;c=32;k;rt=ql7 foo")
- (atoms
- (verb . "foo")
- (tags
- (a . "b")
- (c . "32")
- (k . "")
- (rt . "ql7"))))
- ((input . "@a=b\\\\and\\nk;c=72\\s45;d=gh\\:764 foo")
- (atoms
- (verb . "foo")
- (tags
- (a . "b\\and\nk")
- (c . "72 45")
- (d . "gh;764"))))
- ((input . "@c;h=;a=b :quux ab cd")
- (atoms
- (tags
- (c . "")
- (h . "")
- (a . "b"))
- (source . "quux")
- (verb . "ab")
- (params "cd")))
- ((input . ":src JOIN #chan")
- (atoms
- (source . "src")
- (verb . "JOIN")
- (params "#chan")))
- ((input . ":src JOIN :#chan")
- (atoms
- (source . "src")
- (verb . "JOIN")
- (params "#chan")))
- ((input . ":src AWAY")
- (atoms
- (source . "src")
- (verb . "AWAY")))
- ((input . ":src AWAY ")
- (atoms
- (source . "src")
- (verb . "AWAY")))
- ((input . ":cool guy foo bar baz")
- (atoms
- (source . "cool guy")
- (verb . "foo")
- (params "bar" "baz")))
- ((input . ":coolguy!ag@net\ 35w\ 3ork.admin PRIVMSG foo :bar baz")
- (atoms
- (source . "coolguy!ag@net\ 35w\ 3ork.admin")
- (verb . "PRIVMSG")
- (params "foo" "bar baz")))
- ((input . ":coolguy!~ag@n\ 2et\ 305w\ fork.admin PRIVMSG foo :bar baz")
- (atoms
- (source . "coolguy!~ag@n\ 2et\ 305w\ fork.admin")
- (verb . "PRIVMSG")
- (params "foo" "bar baz")))
- ((input . "@tag1=value1;tag2;vendor1/tag3=value2;vendor2/tag4= :irc.example.com COMMAND param1 param2 :param3 param3")
- (atoms
- (tags
- (tag1 . "value1")
- (tag2 . "")
- (vendor1/tag3 . "value2")
- (vendor2/tag4 . ""))
- (source . "irc.example.com")
- (verb . "COMMAND")
- (params "param1" "param2" "param3 param3")))
- ((input . ":irc.example.com COMMAND param1 param2 :param3 param3")
- (atoms
- (source . "irc.example.com")
- (verb . "COMMAND")
- (params "param1" "param2" "param3 param3")))
- ((input . "@tag1=value1;tag2;vendor1/tag3=value2;vendor2/tag4 COMMAND param1 param2 :param3 param3")
- (atoms
- (tags
- (tag1 . "value1")
- (tag2 . "")
- (vendor1/tag3 . "value2")
- (vendor2/tag4 . ""))
- (verb . "COMMAND")
- (params "param1" "param2" "param3 param3")))
- ((input . "COMMAND")
- (atoms
- (verb . "COMMAND")))
- ((input . "@foo=\\\\\\\\\\:\\\\s\\s\\r\\n COMMAND")
- (atoms
- (tags
- (foo . "\\\\;\\s \r\n"))
- (verb . "COMMAND")))
- ((input . ":gravel.mozilla.org 432 #momo :Erroneous Nickname: Illegal characters")
- (atoms
- (source . "gravel.mozilla.org")
- (verb . "432")
- (params "#momo" "Erroneous Nickname: Illegal characters")))
- ((input . ":gravel.mozilla.org MODE #tckk +n ")
- (atoms
- (source . "gravel.mozilla.org")
- (verb . "MODE")
- (params "#tckk" "+n")))
- ((input . ":services.esper.net MODE #foo-bar +o foobar ")
- (atoms
- (source . "services.esper.net")
- (verb . "MODE")
- (params "#foo-bar" "+o" "foobar")))
- ((input . "@tag1=value\\\\ntest COMMAND")
- (atoms
- (tags
- (tag1 . "value\\ntest"))
- (verb . "COMMAND")))
- ((input . "@tag1=value\\1 COMMAND")
- (atoms
- (tags
- (tag1 . "value1"))
- (verb . "COMMAND")))
- ((input . "@tag1=value1\\ COMMAND")
- (atoms
- (tags
- (tag1 . "value1"))
- (verb . "COMMAND")))
- ((input . "@tag1=1;tag2=3;tag3=4;tag1=5 COMMAND")
- (atoms
- (tags
- (tag1 . "5")
- (tag2 . "3")
- (tag3 . "4"))
- (verb . "COMMAND")))
- ((input . "@tag1=1;tag2=3;tag3=4;tag1=5;vendor/tag2=8 COMMAND")
- (atoms
- (tags
- (tag1 . "5")
- (tag2 . "3")
- (tag3 . "4")
- (vendor/tag2 . "8"))
- (verb . "COMMAND")))
- ((input . ":SomeOp MODE #channel :+i")
- (atoms
- (source . "SomeOp")
- (verb . "MODE")
- (params "#channel" "+i")))
- ((input . ":SomeOp MODE #channel +oo SomeUser :AnotherUser")
- (atoms
- (source . "SomeOp")
- (verb . "MODE")
- (params "#channel" "+oo" "SomeUser" "AnotherUser")))))
- (userhost-split
- (tests
- ((source . "coolguy")
- (atoms
- (nick . "coolguy")))
- ((source . "coolguy!ag@127.0.0.1")
- (atoms
- (nick . "coolguy")
- (user . "ag")
- (host . "127.0.0.1")))
- ((source . "coolguy!~ag@localhost")
- (atoms
- (nick . "coolguy")
- (user . "~ag")
- (host . "localhost")))
- ((source . "coolguy@127.0.0.1")
- (atoms
- (nick . "coolguy")
- (host . "127.0.0.1")))
- ((source . "coolguy!ag")
- (atoms
- (nick . "coolguy")
- (user . "ag")))
- ((source . "coolguy!ag@net\ 35w\ 3ork.admin")
- (atoms
- (nick . "coolguy")
- (user . "ag")
- (host . "net\ 35w\ 3ork.admin")))
- ((source . "coolguy!~ag@n\ 2et\ 305w\ fork.admin")
- (atoms
- (nick . "coolguy")
- (user . "~ag")
- (host . "n\ 2et\ 305w\ fork.admin")))))
- (validate-hostname
- (tests
- ((host . "irc.example.com")
- (valid . t))
- ((host . "i.coolguy.net")
- (valid . t))
- ((host . "irc-srv.net.uk")
- (valid . t))
- ((host . "iRC.CooLguY.NeT")
- (valid . t))
- ((host . "gsf.ds342.co.uk")
- (valid . t))
- ((host . "324.net.uk")
- (valid . t))
- ((host . "xn--bcher-kva.ch")
- (valid . t))
- ((host . "-lol-.net.uk")
- (valid . :false))
- ((host . "-lol.net.uk")
- (valid . :false))
- ((host . "_irc._sctp.lol.net.uk")
- (valid . :false))
- ((host . "irc")
- (valid . :false))
- ((host . "com")
- (valid . :false))
- ((host . "")
- (valid . :false)))))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS " (? ?:) "a"))
-((linger 100 LINGER))
\ No newline at end of file
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS " (? ?:) "b"))
-((linger 1 LINGER))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-
-((pass 10.0 "PASS " (? ?:) "changeme"))
-((nick 0.2 "NICK tester"))
-
-((user 0.2 "USER user 0 * :tester")
- (0 ":irc.example.org 001 tester :Welcome to the Internet Relay Network tester")
- (0 ":irc.example.org 002 tester :Your host is irc.example.org")
- (0 ":irc.example.org 003 tester :This server was created just now")
- (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
- (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
- ;; Just to mix thing's up (force handler to schedule timer)
- (0.1 ":irc.example.org 252 tester 0 :IRC Operators online")
- (0 ":irc.example.org 253 tester 0 :unregistered connections")
- (0 ":irc.example.org 254 tester 1 :channels formed")
- (0 ":irc.example.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.example.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.example.org 422 tester :MOTD File is missing"))
-
-((mode-user 2 "MODE tester +i")
- (0 ":irc.example.org 221 tester +Zi")
- (0 ":irc.example.org 306 tester :You have been marked as being away")
- (0 ":tester!~tester@localhost JOIN #chan")
- (0 ":irc.example.org 353 alice = #chan :+alice @bob")
- (0 ":irc.example.org 366 alice #chan :End of NAMES list"))
-
-((mode-chan 2 "MODE #chan")
- (0 ":bob!~bob@example.org PRIVMSG #chan :hey"))
-
-((linger 1.0 LINGER))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-((pass 10.0 "PASS " (? ?:) "changeme"))
-((nick 0.2 "NICK tester"))
-
-((user 0.2 "USER user 0 * :tester")
- (0.0 ":irc.org 001 tester :Welcome to the Internet Relay Network tester")
- (0.0 ":irc.org 002 tester :Your host is irc.org")
- (0.0 ":irc.org 003 tester :This server was created just now")
- (0.0 ":irc.org 004 tester irc.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0.0 ":irc.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
- (0.0 ":irc.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
- (0.0 ":irc.org 252 tester 0 :IRC Operators online")
- (0.0 ":irc.org 253 tester 0 :unregistered connections")
- (0.0 ":irc.org 254 tester 1 :channels formed")
- (0.0 ":irc.org 255 tester :I have 3 clients and 0 servers")
- (0.0 ":irc.org 265 tester 3 3 :Current local users 3, max 3")
- (0.0 ":irc.org 266 tester 3 3 :Current global users 3, max 3")
- (0.0 ":irc.org 422 tester :MOTD File is missing"))
-
-((mode-user 1.2 "MODE tester +i")
- (0.0 ":irc.org 221 tester +Zi")
- (0.0 ":irc.org 306 tester :You have been marked as being away"))
-
-((join-foo 1.2 "JOIN #foo")
- (0 ":tester!~tester@localhost JOIN #foo")
- (0 ":irc.example.org 353 alice = #foo :+alice @bob")
- (0 ":irc.example.org 366 alice #foo :End of NAMES list"))
-
-;; This would time out if the mode-foo's outgoing blocked (remove minus signs to see)
-((~join-bar 1.5 "JOIN #bar")
- (0 ":tester!~tester@localhost JOIN #bar")
- (0 ":irc.example.org 353 alice = #bar :+alice @bob")
- (0 ":irc.example.org 366 alice #bar :End of NAMES list"))
-
-((mode-foo 1.2 "MODE #foo")
- (0.0 ":irc.example.org 324 tester #foo +Cint")
- (0.0 ":irc.example.org 329 tester #foo 1519850102")
- (-0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: But, in defense, by mercy, 'tis most just.")
- (-0.2 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: Grows, lives, and dies, in single blessedness.")
- (-0.3 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: For these two hours, Rosalind, I will leave thee.")
- (-0.4 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: By this hand, it will not kill a fly. But come, now I will be your Rosalind in a more coming-on disposition; and ask me what you will, I will grant it.")
- (-0.5 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: That I must love a loathed enemy.")
- (-0.6 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: As't please your lordship: I'll leave you.")
- (-0.7 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: Then there is no true lover in the forest; else sighing every minute and groaning every hour would detect the lazy foot of Time as well as a clock.")
- (-0.8 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: His discretion, I am sure, cannot carry his valour, for the goose carries not the fox. It is well: leave it to his discretion, and let us listen to the moon.")
- (-0.9 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: As living here and you no use of him.")
- (-1.0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: If there be truth in sight, you are my Rosalind.")
- (-1.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: That is another's lawful promis'd love.")
- (-1.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :I am heard."))
-
-((mode-bar 1.5 "MODE #bar")
- (0.0 ":irc.example.org 324 tester #bar +HMfnrt 50:5h :10:5")
- (0.0 ":irc.example.org 329 tester #bar :1602642829")
- (0.1 ":alice!~alice@example.com PRIVMSG #bar :hi 123"))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-
-((pass 10.0 "PASS " (? ?:) "changeme"))
-((nick 0.2 "NICK tester"))
-
-((user 0.2 "USER user 0 * :tester")
- (0 ":irc.example.org 001 tester :Welcome to the Internet Relay Network tester")
- (0 ":irc.example.org 002 tester :Your host is irc.example.org")
- (0 ":irc.example.org 003 tester :This server was created just now")
- (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
- (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
- (0 ":irc.example.org 252 tester 0 :IRC Operators online")
- (0 ":irc.example.org 253 tester 0 :unregistered connections")
- (0 ":irc.example.org 254 tester 1 :channels formed")
- (0 ":irc.example.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.example.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.example.org 422 tester :MOTD File is missing"))
-
-((mode-user 1.2 "MODE tester +i")
- (0 ":irc.example.org 221 tester +Zi")
- (0 ":irc.example.org 306 tester :You have been marked as being away"))
-
-((join 1.2 "JOIN #chan")
- (0 ":tester!~tester@localhost JOIN #chan")
- (0 ":irc.example.org 353 alice = #chan :+alice @bob")
- (0 ":irc.example.org 366 alice #chan :End of NAMES list"))
-
-((mode-chan 0.2 "MODE #chan")
- (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-
-((pass 10.0 "PASS " (? ?:) "changeme"))
-((nick 0.2 "NICK tester"))
-
-((~ping 1.2 "PING " nonce)
- (0.1 ":irc.example.org PONG irc.example.com " echo))
-
-((user 0.2 "USER user 0 * :tester")
- (0 ":irc.example.org 001 tester :Welcome to the Internet Relay Network tester")
- (0 ":irc.example.org 002 tester :Your host is irc.example.org")
- (0 ":irc.example.org 003 tester :This server was created just now")
- (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
- " :are supported by this server")
- (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
- (0 ":irc.example.org 252 tester 0 :IRC Operators online")
- (0 ":irc.example.org 253 tester 0 :unregistered connections")
- (0 ":irc.example.org 254 tester 1 :channels formed")
- (0 ":irc.example.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.example.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.example.org 422 tester :MOTD File is missing"))
-
-((mode-user 1.2 "MODE tester +i")
- (0 ":irc.example.org 221 tester +Zi")
- (0 ":irc.example.org 306 tester :You have been marked as being away"))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-((one 1 "ONE one"))
-((two 1 "TWO two"))
-((blank 1 ""))
-((one-space 1 " "))
-((two-spaces 1 " "))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-
-((pass 10.0 "PASS " (? ?:) network ":changeme"))
-((nick 1.2 "NICK tester"))
-
-((user 1.2 "USER user 0 * :tester")
- (0.001 ":" fqdn " 001 tester :Welcome to the BAR Network tester")
- (0.002 ":" fqdn " 002 tester :Your host is " fqdn)
- (0.003 ":" fqdn " 003 tester :This server was created just now")
- (0.004 ":" fqdn " 004 tester " fqdn " BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0.005 ":" fqdn " 005 tester MODES NETWORK=" net " NICKLEN=32 PREFIX=(qaohv)~&@%+"
- " :are supported by this server")
- (0.006 ":" fqdn " 251 tester :There are 3 users and 0 invisible on 1 server(s)")
- (0.007 ":" fqdn " 252 tester 0 :IRC Operators online")
- (0.008 ":" fqdn " 253 tester 0 :unregistered connections")
- (0.009 ":" fqdn " 254 tester 1 :channels formed")
- (0.010 ":" fqdn " 255 tester :I have 3 clients and 0 servers")
- (0.011 ":" fqdn " 265 tester 3 3 :Current local users 3, max 3")
- (0.012 ":" fqdn " 266 tester 3 3 :Current global users 3, max 3")
- (0.013 ":" fqdn " 422 tester :MOTD File is missing"))
-
-((mode-user 1.2 "MODE tester +i")
- (0.014 ":" fqdn " 221 tester +Zi")
- (0.015 ":" fqdn " 306 tester :You have been marked as being away"))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-
-((pass 10.0 "PASS " (? ?:) network ":changeme"))
-((nick 1.2 "NICK tester"))
-
-((user 2.2 "USER user 0 * :tester")
- (0.015 ":" fqdn " 001 tester :Welcome to the FOO Network tester")
- (0.014 ":" fqdn " 002 tester :Your host is " fqdn)
- (0.013 ":" fqdn " 003 tester :This server was created just now")
- (0.012 ":" fqdn " 004 tester " fqdn " BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0.011 ":" fqdn " 005 tester MODES NETWORK=" net " NICKLEN=32 PREFIX=(qaohv)~&@%+"
- " :are supported by this server")
- (0.010 ":" fqdn " 251 tester :There are 3 users and 0 invisible on 1 server(s)")
- (0.009 ":" fqdn " 252 tester 0 :IRC Operators online")
- (0.008 ":" fqdn " 253 tester 0 :unregistered connections")
- (0.007 ":" fqdn " 254 tester 1 :channels formed")
- (0.006 ":" fqdn " 255 tester :I have 3 clients and 0 servers")
- (0.005 ":" fqdn " 265 tester 3 3 :Current local users 3, max 3")
- (0.004 ":" fqdn " 266 tester 3 3 :Current global users 3, max 3")
- (0.003 ":" fqdn " 422 tester :MOTD File is missing"))
-
-((mode-user 1.2 "MODE tester +i")
- (0.002 ":" fqdn " 221 tester +Zi")
- (0.001 ":" fqdn " 306 tester :You have been marked as being away"))
+++ /dev/null
-;;; proxy-subprocess.el --- Example setup file for erc-d -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2020-2025 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:
-
-(defvar erc-d-tmpl-vars)
-
-(setq erc-d-tmpl-vars
-
- (list
- (cons 'fqdn (lambda (helper)
- (let ((name (funcall helper :dialog-name)))
- (funcall helper :set
- (if (eq name 'proxy-foonet)
- "irc.foo.net"
- "irc.bar.net")))))
-
- (cons 'net (lambda (helper)
- (let ((name (funcall helper :dialog-name)))
- (funcall helper :set
- (if (eq name 'proxy-foonet)
- "FooNet"
- "BarNet")))))
-
- (cons 'network '(group (+ alpha)))))
-
-;;; proxy-subprocess.el ends here
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-
-((pass 10.0 "PASS " (? ?:) "changeme"))
-((nick 0.2 "NICK tester"))
-
-((user 0.2 "USER user 0 * :tester")
- (0 ":irc.example.org 001 tester :Welcome to the Internet Relay Network tester")
- (0 ":irc.example.org 002 tester :Your host is irc.example.org")
- (0 ":irc.example.org 003 tester :This server was created just now")
- (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
- " :are supported by this server")
- (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
- (0 ":irc.example.org 252 tester 0 :IRC Operators online")
- (0 ":irc.example.org 253 tester 0 :unregistered connections")
- (0 ":irc.example.org 254 tester 1 :channels formed")
- (0 ":irc.example.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.example.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.example.org 422 tester :MOTD File is missing"))
-
-((mode-user 1.2 "MODE tester +i")
- (0 ":irc.example.org 221 tester +Zi")
- (0 ":irc.example.org 306 tester :You have been marked as being away"))
-
-((mode 0.2 "MODE #chan")
- (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-((t 10.0 "PASS " (? ?:) "changeme"))
-((t 0.2 "NICK tester"))
-
-((t 0.2 "USER user 0 * :tester")
- (0.0 ":irc.example.org 001 tester :Welcome to the Internet Relay Network tester")
- (0.0 ":irc.example.org 002 tester :Your host is irc.example.org")
- (0.0 ":irc.example.org 003 tester :This server was created just now")
- (0.0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0.0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
- (0.0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
- (0.0 ":irc.example.org 252 tester 0 :IRC Operators online")
- (0.0 ":irc.example.org 253 tester 0 :unregistered connections")
- (0.0 ":irc.example.org 254 tester 1 :channels formed")
- (0.0 ":irc.example.org 255 tester :I have 3 clients and 0 servers")
- (0.0 ":irc.example.org 265 tester 3 3 :Current local users 3, max 3")
- (0.0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3")
- (0.0 ":irc.example.org 422 tester :MOTD File is missing"))
-
-((mode-user 1.2 "MODE tester +i")
- (0.0 ":irc.example.org 221 tester +Zi")
-
- (0.0 ":irc.example.org 306 tester :You have been marked as being away")
- (0.0 ":tester!~tester@localhost JOIN #chan")
- (0.0 ":irc.example.org 353 alice = #chan :+alice @bob")
- (0.0 ":irc.example.org 366 alice #chan :End of NAMES list")
- (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))
+++ /dev/null
-;;; erc-scenarios-common.el --- Common helpers for ERC scenarios -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022-2025 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:
-
-;; These are e2e-ish test cases primarily intended to assert core,
-;; fundamental behavior expected of any modern IRC client. Tests may
-;; also simulate specific scenarios drawn from bug reports. Incoming
-;; messages are provided by playback scripts resembling I/O logs. In
-;; place of time stamps, they have time deltas, which are used to
-;; govern the test server in a fashion reminiscent of music rolls (or
-;; the script(1) UNIX program). These scripts can be found in the
-;; other directories under test/lisp/erc/resources.
-;;
-;; Isolation:
-;;
-;; The set of enabled modules is shared among all tests. The function
-;; `erc-update-modules' activates them (as minor modes), but it never
-;; deactivates them. So there's no going back, and let-binding
-;; `erc-modules' is useless. The safest route is therefore to (1)
-;; assume the set of default modules is already activated or will be
-;; over the course of the test session and (2) let-bind relevant user
-;; options as needed. For example, to limit the damage of
-;; `erc-autojoin-channels-alist' to a given test, assume the
-;; `erc-join' library has already been loaded or will be on the next
-;; call to `erc-open'. And then just let-bind
-;; `erc-autojoin-channels-alist' for the duration of the test.
-;;
-;; Playing nice:
-;;
-;; Right now, these tests all rely on an ugly fixture macro named
-;; `erc-scenarios-common-with-cleanup', which is defined just below.
-;; It helps restore (but not really prepare) the environment by
-;; destroying any stray processes or buffers named in the first
-;; argument, a `let*'-style VAR-LIST. Relying on such a macro is
-;; unfortunate because in many ways it actually hampers readability by
-;; favoring magic over verbosity. But without it (or something
-;; similar), any failing test would cause all subsequent tests in a
-;; file to fail like dominoes (making all but the first backtrace
-;; useless).
-;;
-;; Misc:
-;;
-;; Note that in the following examples, nicknames Alice and Bob are
-;; always associated with the fake network FooNet, while nicks Joe and
-;; Mike are always on BarNet. (Networks are sometimes downcased.)
-;;
-;; Environment variables:
-;;
-;; `ERC_TESTS_GRAPHICAL': Internal variable to unskip those few tests
-;; capable of running consecutively while interactive on a graphical
-;; display. This triggers both the tests and the suite to commence
-;; with teardown activities normally skipped to allow for inspection
-;; while interactive. This is also handy when needing to quickly
-;; run `ert-results-rerun-test-at-point-debugging-errors' on a
-;; failing test because you don't have to go around hunting for and
-;; killing associated buffers and processes.
-;;
-;; `ERC_TESTS_GRAPHICAL_ALL': Currently targets a single "meta" test,
-;; `erc-scenarios-internal--run-interactive-all', that runs all
-;; tests tagged `:erc--graphical' in an interactive subprocess.
-;;
-;; `ERC_TESTS_SUBPROCESS': Used internally to detect nested tests.
-;;
-;; `ERC_D_DEBUG': Tells `erc-d' to emit debugging info to stderr.
-;;
-;; XXX This file should *not* contain any test cases.
-
-;;; Code:
-
-(require 'ert-x) ; cl-lib
-(eval-and-compile
- (let* ((d (expand-file-name ".." (ert-resource-directory)))
- (load-path (cons (concat d "/erc-d") load-path)))
- (require 'erc-d-t)
- (require 'erc-d)))
-
-(require 'erc)
-
-(eval-when-compile (require 'erc-join)
- (require 'erc-services)
- (require 'erc-fill))
-
-(declare-function erc-network "erc-networks")
-(defvar erc-network)
-
-(defvar erc-scenarios-common--resources-dir
- (expand-file-name "../" (ert-resource-directory)))
-
-;; Teardown is already inhibited when running interactively, which
-;; prevents subsequent tests from succeeding, so we might as well
-;; treat inspection as the goal.
-(unless noninteractive
- (setq erc-server-auto-reconnect nil))
-
-(defvar erc-scenarios-common-dialog nil)
-(defvar erc-scenarios-common-extra-teardown nil)
-(defvar erc-scenarios-common--graphical-p nil)
-
-(defun erc-scenarios-common--add-silence ()
- (advice-add #'erc-login :around #'erc-d-t-silence-around)
- (advice-add #'erc-handle-login :around #'erc-d-t-silence-around)
- (advice-add #'erc-server-connect :around #'erc-d-t-silence-around))
-
-(defun erc-scenarios-common--remove-silence ()
- (advice-remove #'erc-login #'erc-d-t-silence-around)
- (advice-remove #'erc-handle-login #'erc-d-t-silence-around)
- (advice-remove #'erc-server-connect #'erc-d-t-silence-around))
-
-(defun erc-scenarios-common--print-trace ()
- (when (and (boundp 'trace-buffer) (get-buffer trace-buffer))
- (with-current-buffer trace-buffer
- (message "%S" (buffer-string))
- (kill-buffer))))
-
-(eval-and-compile
- (defun erc-scenarios-common--make-bindings (bindings)
- `((erc-scenarios-common--graphical-p
- (and (or erc-scenarios-common--graphical-p
- (memq :erc--graphical (ert-test-tags (ert-running-test))))
- (not (and noninteractive (ert-skip "Interactive only")))))
- (erc-d-u-canned-dialog-dir (expand-file-name
- (or erc-scenarios-common-dialog
- (cadr (assq 'erc-scenarios-common-dialog
- ',bindings)))
- erc-scenarios-common--resources-dir))
- (erc-d-tmpl-vars `(,@erc-d-tmpl-vars
- (quit . ,(erc-quit/part-reason-default))
- (erc-version . ,erc-version)))
- (erc-modules (copy-sequence erc-modules))
- (debug-on-error t)
- (inhibit-interaction noninteractive)
- (auth-source-do-cache nil)
- (timer-list (copy-sequence timer-list))
- (timer-idle-list (copy-sequence timer-idle-list))
- (erc-auth-source-parameters-join-function nil)
- (erc-fill--wrap-scrolltobottom-exempt-p t)
- (erc-autojoin-channels-alist nil)
- (erc-server-auto-reconnect nil)
- (erc-after-connect nil)
- (erc-last-input-time 0)
- (erc-d-linger-secs 10)
- ,@bindings)))
-
-(defmacro erc-scenarios-common-with-cleanup (bindings &rest body)
- "Provide boilerplate cleanup tasks after calling BODY with BINDINGS.
-
-If an `erc-d' process exists, wait for it to start before running BODY.
-If `erc-autojoin-mode' mode is bound, restore it during cleanup if
-disabled by BODY. Other defaults common to these test cases are added
-below and can be overridden, except when wanting the \"real\" default
-value, which must be looked up or captured outside of the calling form.
-
-When running tests tagged as serially runnable while interactive
-and the flag `erc-scenarios-common--graphical-p' is non-nil, run
-teardown tasks normally inhibited when interactive. That is,
-behave almost as if `noninteractive' were also non-nil, and
-ensure buffers and other resources are destroyed on completion.
-
-Dialog resource directories are located by expanding the variable
-`erc-scenarios-common-dialog' or its value in BINDINGS."
- (declare (indent 1))
-
- (let* ((orig-autojoin-mode (make-symbol "orig-autojoin-mode"))
- (combined `((,orig-autojoin-mode (bound-and-true-p erc-autojoin-mode))
- ,@(erc-scenarios-common--make-bindings bindings))))
-
- `(erc-d-t-with-cleanup (,@combined)
-
- (ert-info ("Restore autojoin, etc., kill ERC buffers")
- (dolist (buf (buffer-list))
- (when-let ((erc-d-u--process-buffer)
- (proc (get-buffer-process buf)))
- (delete-process proc)))
-
- (erc-scenarios-common--remove-silence)
-
- (when erc-scenarios-common-extra-teardown
- (ert-info ("Running extra teardown")
- (funcall erc-scenarios-common-extra-teardown)))
-
- (erc-buffer-do #'erc-scenarios-common--assert-date-stamps)
- (when (and (boundp 'erc-autojoin-mode)
- (not (eq erc-autojoin-mode ,orig-autojoin-mode)))
- (erc-autojoin-mode (if ,orig-autojoin-mode +1 -1)))
-
- (when (or noninteractive erc-scenarios-common--graphical-p)
- (when noninteractive
- (erc-scenarios-common--print-trace))
- (erc-d-t-kill-related-buffers)
- (delete-other-windows)))
-
- (erc-scenarios-common--add-silence)
-
- (ert-info ("Wait for dumb server")
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (when erc-d-u--process-buffer
- (erc-d-t-search-for 3 "Starting")))))
-
- (ert-info ("Activate erc-debug-irc-protocol")
- (unless (and (or noninteractive erc-scenarios-common--graphical-p)
- (not erc-debug-irc-protocol))
- (erc-toggle-debug-irc-protocol)))
-
- ,@body)))
-
-(defvar erc-scenarios-common--term-size '(34 . 80))
-(declare-function term-char-mode "term" nil)
-(declare-function term-line-mode "term" nil)
-
-;; Much of this concerns accommodating test environments outside of
-;; the emacs.git tree, such as CI jobs running ERC's ELPA-package on
-;; older Emacsen. See also `erc-tests--assert-printed-in-subprocess'.
-(defun erc-scenarios-common--run-in-term (&optional debug)
- (require 'term)
- (let* ((default-directory (or (getenv "EMACS_TEST_DIRECTORY")
- (expand-file-name
- ".." erc-scenarios-common--resources-dir)))
- ;; In the emacs.git tree, "HOME" will be "/nonexistent", which
- ;; is fine because we don't need any ELPA packages.
- (process-environment (cons "ERC_TESTS_SUBPROCESS=1"
- process-environment))
- (name (ert-test-name (ert-running-test)))
- (temp-file (make-temp-file "erc-term-test-"))
- (cmd `(let ((stats 1))
- (setq enable-dir-local-variables nil)
- (unwind-protect
- (setq stats (ert-run-tests-batch ',name))
- (unless ',debug
- (let ((buf (with-current-buffer (messages-buffer)
- (buffer-string))))
- (with-temp-file ,temp-file
- (insert buf)))
- (kill-emacs (ert-stats-completed-unexpected stats))))))
- ;; The `ert-test' object in Emacs 29 has a `file-name' field.
- (file-name (symbol-file name 'ert-deftest))
- (default-directory (expand-file-name (file-name-directory file-name)))
- (package (if-let* ((found (getenv "ERC_PACKAGE_NAME"))
- ((string-prefix-p "erc-" found)))
- (intern found)
- 'erc))
- (init (and-let* ((found (getenv "ERC_TESTS_INIT"))
- (files (split-string found ",")))
- (mapcan (lambda (f) (list "-l" f)) files)))
- (setup `(progn
- ,@(and (not init) (featurep 'compat)
- `((require 'package)
- (let ((package-load-list
- '((compat t) (,package t))))
- (package-initialize))))
- (require 'erc)
- (cl-assert (equal erc-version ,erc-version) t)))
- ;; Make subprocess terminal bigger than controlling.
- (buf (cl-letf (((symbol-function 'window-screen-lines)
- (lambda () (car erc-scenarios-common--term-size)))
- ((symbol-function 'window-max-chars-per-line)
- (lambda () (cdr erc-scenarios-common--term-size))))
- (apply #'make-term (symbol-name name)
- (expand-file-name invocation-name invocation-directory)
- nil `(,@(or init '("-Q")) "-nw"
- "-eval" ,(format "%S" setup)
- "-l" ,file-name
- "-eval" ,(format "%S" cmd)))))
- (proc (get-buffer-process buf))
- (err (lambda ()
- (with-temp-buffer
- (insert-file-contents temp-file)
- (message "Subprocess: %s" (buffer-string))
- (delete-file temp-file)))))
- (unless noninteractive
- (set-window-buffer (selected-window) buf)
- (delete-other-windows))
- (with-current-buffer buf
- (set-process-query-on-exit-flag proc nil)
- (unless noninteractive (term-char-mode))
- (erc-d-t-wait-for 30 (process-live-p proc))
- (while (accept-process-output proc))
- (term-line-mode)
- (goto-char (point-min))
- ;; Otherwise gives process exited abnormally with exit-code >0
- (unless (search-forward (format "Process %s finished" name) nil t)
- (funcall err)
- (ert-fail (when (search-forward "exited" nil t)
- (buffer-substring-no-properties (line-beginning-position)
- (line-end-position)))))
- (delete-file temp-file)
- (when noninteractive
- (kill-buffer)))))
-
-(defvar erc-scenarios-common-interactive-debug-term-p nil
- "Non-nil means run test in an inferior Emacs, even if interactive.")
-
-(defmacro erc-scenarios-common-with-noninteractive-in-term (&rest body)
- "Run BODY via `erc-scenarios-common-with-cleanup' in a `term' subprocess.
-Also do so when `erc-scenarios-common-interactive-debug-term-p'
-is non-nil. When debugging, leave the `term-mode' buffer around
-for inspection and name it after the test, bounded by asterisks.
-When debugging, ensure the test always fails, as a reminder to
-disable `erc-scenarios-common-interactive-debug-term-p'.
-
-See Info node `(emacs) Term Mode' for the various commands."
- (declare (indent 1))
- `(if (and (or erc-scenarios-common-interactive-debug-term-p
- noninteractive)
- (not (getenv "ERC_TESTS_SUBPROCESS")))
- (progn
- (when (memq system-type '(windows-nt ms-dos cygwin haiku))
- (ert-skip "System must be UNIX-like"))
- (erc-scenarios-common--run-in-term
- erc-scenarios-common-interactive-debug-term-p))
- (erc-scenarios-common-with-cleanup ,@body)))
-
-(defun erc-scenarios-common--assert-date-stamps ()
- "Ensure all date stamps are accounted for."
- (dolist (stamp erc-stamp--date-stamps)
- (should (eq 'datestamp (get-text-property (erc-stamp--date-marker stamp)
- 'erc--msg)))))
-
-(defun erc-scenarios-common-assert-initial-buf-name (id port)
- ;; Assert no limbo period when explicit ID given
- (should (string= (if id
- (format "%s" id)
- (format "127.0.0.1:%d" port))
- (buffer-name))))
-
-(defun erc-scenarios-common-buflist (prefix)
- "Return list of buffers with names sharing PREFIX."
- (let (case-fold-search)
- (erc-networks--id-sort-buffers
- (delq nil
- (mapcar (lambda (b)
- (when (string-prefix-p prefix (buffer-name b)) b))
- (buffer-list))))))
-
-;; This is more realistic than `erc-send-message' because it runs
-;; `erc-pre-send-functions', etc. Keyboard macros may be preferable,
-;; but they sometimes experience complications when an earlier test
-;; has failed.
-(defun erc-scenarios-common-say (str)
- (let (erc-accidental-paste-threshold-seconds)
- (goto-char erc-input-marker)
- (insert str)
- (erc-send-current-line)))
-
-(defun erc-scenarios-common--at-win-end-p (&optional window)
- (= (window-body-height window)
- (count-screen-lines (window-start window) (point-max) nil window)))
-
-(defun erc-scenarios-common--above-win-end-p (&optional window)
- (> (window-body-height window)
- (count-screen-lines (window-start window) (point-max))))
-
-(defun erc-scenarios-common--prompt-past-win-end-p (&optional window)
- (< (window-body-height window)
- (count-screen-lines (window-start window) (point-max))))
-
-(defun erc-scenarios-common--recenter-top-bottom-around (orig &rest args)
- (let (this-command last-command) (apply orig args)))
-
-(defun erc-scenarios-common--recenter-top-bottom ()
- (advice-add 'recenter-top-bottom
- :around #'erc-scenarios-common--recenter-top-bottom-around)
- (execute-kbd-macro "\C-l")
- (advice-remove 'recenter-top-bottom
- #'erc-scenarios-common--recenter-top-bottom-around))
-
-
-;;;; Fixtures
-
-(defun erc-scenarios-common-scrolltobottom--normal (test)
- (erc-scenarios-common-with-noninteractive-in-term
- ((erc-scenarios-common-dialog "scrolltobottom")
- (dumb-server (erc-d-run "localhost" t 'help))
- (port (process-contact dumb-server :service))
- (erc-modules `(scrolltobottom fill-wrap ,@erc-modules))
- (erc-server-flood-penalty 0.1)
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :full-name "tester"
- :nick "tester")
- (funcall expect 10 "debug mode")))
-
- (with-current-buffer "foonet"
- (should (looking-at " and"))
- (set-window-buffer nil (current-buffer))
- (delete-other-windows)
- (split-window-below 15)
- (recenter 0)
-
- (ert-info ("Moving into prompt in other window triggers scroll")
- (with-selected-window (next-window)
- (should-not (erc-scenarios-common--at-win-end-p))
- (goto-char (1- erc-insert-marker))
- (execute-kbd-macro "\C-n")
- ;; Ensure point is at prompt and aligned to bottom.
- (should (erc-scenarios-common--at-win-end-p))))
-
- (ert-info ("Module `move-to-prompt' still works")
- ;; Prompt is somewhere in the middle of the window.
- (should (erc-scenarios-common--above-win-end-p))
- ;; Hitting a self-insert key triggers `move-to-prompt' as well
- ;; as a scroll (to bottom).
- (execute-kbd-macro "hi")
- ;; Prompt and input appear on last line of window.
- (should (erc-scenarios-common--at-win-end-p)))
-
- (ert-info ("Command `recenter-top-bottom' disallowed at prompt")
- ;; Hitting C-l does not recenter the window.
- (erc-scenarios-common--recenter-top-bottom)
- (should (erc-scenarios-common--at-win-end-p))
- (erc-scenarios-common--recenter-top-bottom)
- (should (erc-scenarios-common--at-win-end-p)))
-
- (ert-info ("Command `beginning-of-buffer' allowed at prompt")
- ;; Hitting C-< goes to beginning of buffer.
- (call-interactively #'beginning-of-buffer)
- (should (= 1 (point)))
- (redisplay)
- (should (zerop (count-screen-lines (window-start) (point))))
- (should (erc-scenarios-common--prompt-past-win-end-p)))
-
- (ert-info ("New message doesn't trigger scroll when away from prompt")
- ;; Arriving insertions don't trigger a scroll when away from the
- ;; prompt. New output not seen.
- (erc-cmd-MSG "NickServ help register")
- (save-excursion (erc-d-t-search-for 10 "End of NickServ"))
- (should (= 1 (point)))
- (redisplay)
- (should (zerop (count-screen-lines (window-start) (window-point))))
- (should (erc-scenarios-common--prompt-past-win-end-p)))
-
- (funcall test)
-
- (ert-info ("New message does trigger a scroll when at prompt")
- ;; Recenter so prompt is above rather than at window's end.
- (funcall expect 10 "If you are currently logged in")
- (recenter 0)
- ;; Prompt is somewhere in the middle of the window.
- (erc-d-t-wait-for 10 (erc-scenarios-common--above-win-end-p))
- (erc-scenarios-common-say "/msg NickServ help identify")
- ;; New arriving messages trigger a snap when inserted.
- (erc-d-t-wait-for 10 (erc-scenarios-common--at-win-end-p))
- (funcall expect 10 "IDENTIFY lets you login"))
-
- (erc-scrolltobottom-mode -1))))
-
-(cl-defun erc-scenarios-common--base-network-id-bouncer
- ((&key autop foo-id bar-id after
- &aux
- (foo-id (and foo-id 'oofnet))
- (bar-id (and bar-id 'rabnet))
- (serv-buf-foo (if foo-id "oofnet" "foonet"))
- (serv-buf-bar (if bar-id "rabnet" "barnet"))
- (chan-buf-foo (if foo-id "#chan@oofnet" "#chan@foonet"))
- (chan-buf-bar (if bar-id "#chan@rabnet" "#chan@barnet")))
- &rest dialogs)
- "Ensure retired option `erc-rename-buffers' is now the default behavior.
-The option `erc-rename-buffers' is now deprecated and on by default, so
-this now just asserts baseline behavior. Originally from scenario
-clash-of-chans/rename-buffers as explained in Bug#48598: 28.0.50;
-buffer-naming collisions involving bouncers in ERC."
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/netid/bouncer")
- (erc-d-t-cleanup-sleep-secs 1)
- (erc-server-flood-penalty 0.1)
- (dumb-server (apply #'erc-d-run "localhost" t dialogs))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- (erc-server-auto-reconnect autop)
- erc-server-buffer-foo erc-server-process-foo
- erc-server-buffer-bar erc-server-process-bar)
-
- (ert-info ("Connect to foonet")
- (with-current-buffer
- (setq erc-server-buffer-foo (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester"
- :id foo-id))
- (setq erc-server-process-foo erc-server-process)
- (erc-scenarios-common-assert-initial-buf-name foo-id port)
- (erc-d-t-wait-for 6 (eq (erc-network) 'foonet))
- (erc-d-t-wait-for 3 (string= (buffer-name) serv-buf-foo))
- (funcall expect 5 "foonet")))
-
- (ert-info ("Join #chan@foonet")
- (with-current-buffer erc-server-buffer-foo (erc-cmd-JOIN "#chan"))
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (funcall expect 5 "<alice>")))
-
- (ert-info ("Connect to barnet")
- (with-current-buffer
- (setq erc-server-buffer-bar (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "barnet:changeme"
- :full-name "tester"
- :id bar-id))
- (setq erc-server-process-bar erc-server-process)
- (erc-scenarios-common-assert-initial-buf-name bar-id port)
- (erc-d-t-wait-for 6 (eq (erc-network) 'barnet))
- (erc-d-t-wait-for 3 (string= (buffer-name) serv-buf-bar))
- (funcall expect 5 "barnet")))
-
- (ert-info ("Server buffers are unique, no names based on IPs")
- (should-not (eq erc-server-buffer-foo erc-server-buffer-bar))
- (should-not (erc-scenarios-common-buflist "127.0.0.1")))
-
- (ert-info ("Join #chan@barnet")
- (with-current-buffer erc-server-buffer-bar (erc-cmd-JOIN "#chan")))
-
- (erc-d-t-wait-for 5 "Exactly 2 #chan-prefixed buffers exist"
- (equal (list (get-buffer chan-buf-bar)
- (get-buffer chan-buf-foo))
- (erc-scenarios-common-buflist "#chan")))
-
- (ert-info ("#chan@<esid> is exclusive to foonet")
- (with-current-buffer chan-buf-foo
- (erc-d-t-search-for 1 "<bob>")
- (erc-d-t-absent-for 0.1 "<joe>")
- (should (eq erc-server-process erc-server-process-foo))
- (erc-d-t-search-for 15 "ape is dead")
- (erc-d-t-wait-for 5 (not (erc-server-process-alive)))))
-
- (ert-info ("#chan@<esid> is exclusive to barnet")
- (with-current-buffer chan-buf-bar
- (erc-d-t-search-for 1 "<joe>")
- (erc-d-t-absent-for 0.1 "<bob>")
- (erc-d-t-wait-for 5 (eq erc-server-process erc-server-process-bar))
- (erc-d-t-search-for 15 "joe: It is a rupture")
- (erc-d-t-wait-for 5 (not (erc-server-process-alive)))))
-
- (when after (funcall after))))
-
-(defun erc-scenarios-common--clash-rename-pass-handler (dialog exchange)
- (when (eq (erc-d-dialog-name dialog) 'stub-again)
- (let* ((match (erc-d-exchange-match exchange 1))
- (sym (if (string= match "foonet") 'foonet-again 'barnet-again)))
- (should (member match (list "foonet" "barnet")))
- (erc-d-load-replacement-dialog dialog sym 1))))
-
-(defun erc-scenarios-common--base-network-id-bouncer--reconnect (foo-id bar-id)
- (let ((erc-d-tmpl-vars '((token . (group (| "barnet" "foonet")))))
- (erc-d-match-handlers
- ;; Auto reconnect is nondeterministic, so let computer decide
- (list :pass #'erc-scenarios-common--clash-rename-pass-handler))
- (after
- (lambda ()
- ;; Simulate disconnection and `erc-server-auto-reconnect'
- (ert-info ("Reconnect to foonet and barnet back-to-back")
- (with-current-buffer (if foo-id "oofnet" "foonet")
- (erc-d-t-wait-for 10 (erc-server-process-alive)))
- (with-current-buffer (if bar-id "rabnet" "barnet")
- (erc-d-t-wait-for 10 (erc-server-process-alive))))
-
- (ert-info ("#chan@foonet is exclusive to foonet")
- (with-current-buffer (if foo-id "#chan@oofnet" "#chan@foonet")
- (erc-d-t-search-for 1 "<alice>")
- (erc-d-t-absent-for 0.1 "<joe>")
- (erc-d-t-search-for 20 "please your lordship")))
-
- (ert-info ("#chan@barnet is exclusive to barnet")
- (with-current-buffer (if bar-id "#chan@rabnet" "#chan@barnet")
- (erc-d-t-search-for 1 "<joe>")
- (erc-d-t-absent-for 0.1 "<bob>")
- (erc-d-t-search-for 20 "much in private")))
-
- ;; XXX this is important (reconnects overlapped, so we'd get
- ;; chan@127.0.0.1:6667)
- (should-not (erc-scenarios-common-buflist "127.0.0.1"))
- ;; Reconnection order doesn't matter here because session objects
- ;; are persisted, meaning original timestamps preserved.
- (should (equal (list (get-buffer (if bar-id "#chan@rabnet"
- "#chan@barnet"))
- (get-buffer (if foo-id "#chan@oofnet"
- "#chan@foonet")))
- (erc-scenarios-common-buflist "#chan"))))))
- (erc-scenarios-common--base-network-id-bouncer
- (list :autop t :foo-id foo-id :bar-id bar-id :after after)
- 'foonet-drop 'barnet-drop
- 'stub-again 'stub-again
- 'foonet-again 'barnet-again)))
-
-(defun erc-scenarios-common--upstream-reconnect (test &rest dialogs)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/upstream-reconnect")
- (erc-d-t-cleanup-sleep-secs 1)
- (erc-server-flood-penalty 0.1)
- (dumb-server (apply #'erc-d-run "localhost" t dialogs))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester@vanilla/foonet"
- :password "changeme"
- :full-name "tester")
- (erc-scenarios-common-assert-initial-buf-name nil port)
- (erc-d-t-wait-for 6 (eq (erc-network) 'foonet))
- (erc-d-t-wait-for 3 (string= (buffer-name) "foonet"))
- (funcall expect 5 "foonet")))
-
- (ert-info ("Join #chan@foonet")
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (funcall expect 5 "<alice>")))
-
- (ert-info ("Connect to barnet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester@vanilla/barnet"
- :password "changeme"
- :full-name "tester")
- (erc-scenarios-common-assert-initial-buf-name nil port)
- (erc-d-t-wait-for 10 (eq (erc-network) 'barnet))
- (erc-d-t-wait-for 3 (string= (buffer-name) "barnet"))
- (funcall expect 5 "barnet")))
-
- (ert-info ("Server buffers are unique, no names based on IPs")
- (should-not (erc-scenarios-common-buflist "127.0.0.1")))
-
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan@foonet"))
- (funcall expect 5 "#chan was created on ")
- (ert-info ("Joined again #chan@foonet")
- (funcall expect 10 "#chan was created on "))
- (funcall expect 10 "My lord, in heart"))
-
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan@barnet"))
- (funcall expect 5 "#chan was created on ")
- (ert-info ("Joined again #chan@barnet")
- (funcall expect 10 "#chan was created on "))
- (funcall expect 10 "Go to; farewell"))
-
- (funcall test)))
-
-;; XXX this is okay, but we also need to check that target buffers are
-;; already associated with a new process *before* a JOIN is sent by a
-;; server's playback burst. This doesn't do that.
-;;
-;; This *does* check that superfluous JOINs sent by the autojoin
-;; module are harmless when they're not acked (superfluous because the
-;; bouncer/server intitates the JOIN).
-
-(defun erc-scenarios-common--join-network-id (foo-reconnector foo-id bar-id)
- "Ensure channels rejoined by erc-join.el DTRT.
-Originally from scenario clash-of-chans/autojoin as described in
-Bug#48598: 28.0.50; buffer-naming collisions involving bouncers in ERC."
- (erc-scenarios-common-with-cleanup
- ((chan-buf-foo (format "#chan@%s" (or foo-id "foonet")))
- (chan-buf-bar (format "#chan@%s" (or bar-id "barnet")))
- (erc-scenarios-common-dialog "join/network-id")
- (erc-d-t-cleanup-sleep-secs 1)
- (erc-server-flood-penalty 0.5)
- (dumb-server (erc-d-run "localhost" t 'foonet 'barnet 'foonet-again))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter))
- erc-server-buffer-foo erc-server-process-foo
- erc-server-buffer-bar erc-server-process-bar)
-
- (should (memq 'autojoin erc-modules))
-
- (ert-info ("Connect to foonet")
- (with-current-buffer
- (setq erc-server-buffer-foo (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester"
- :id foo-id))
- (setq erc-server-process-foo erc-server-process)
- (erc-scenarios-common-assert-initial-buf-name foo-id port)
- (erc-d-t-wait-for 5 (eq (erc-network) 'foonet))
- (funcall expect 5 "foonet")))
-
- (ert-info ("Join #chan, find sentinel, quit")
- (with-current-buffer erc-server-buffer-foo (erc-cmd-JOIN "#chan"))
- (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
- (funcall expect 5 "vile thing")
- (erc-cmd-QUIT "")
-
- (ert-info ("Prompt hidden in channel buffer upon quitting")
- (erc-d-t-wait-for 10 (erc--prompt-hidden-p))
- (should (overlays-in erc-insert-marker erc-input-marker)))))
-
- (with-current-buffer erc-server-buffer-foo
- (ert-info ("Prompt hidden after process dies in server buffer")
- (erc-d-t-wait-for 2 (not (erc-server-process-alive)))
- (erc-d-t-wait-for 10 (erc--prompt-hidden-p))
- (should (overlays-in erc-insert-marker erc-input-marker))))
-
- (should (equal erc-autojoin-channels-alist
- (if foo-id '((oofnet "#chan")) '((foonet "#chan")))))
-
- (ert-info ("Connect to barnet")
- (with-current-buffer
- (setq erc-server-buffer-bar (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "barnet:changeme"
- :full-name "tester"
- :id bar-id))
- (setq erc-server-process-bar erc-server-process)
- (erc-d-t-wait-for 5 (eq erc-network 'barnet))
- (should (string= (buffer-name) (if bar-id "rabnet" "barnet")))))
-
- (ert-info ("Server buffers are unique, no stray IP-based names")
- (should-not (eq erc-server-buffer-foo erc-server-buffer-bar))
- (should-not (erc-scenarios-common-buflist "127.0.0.1")))
-
- (ert-info ("Only one #chan buffer exists")
- (should (equal (list (get-buffer "#chan"))
- (erc-scenarios-common-buflist "#chan"))))
-
- (ert-info ("#chan is not auto-joined")
- (with-current-buffer "#chan"
- (erc-d-t-absent-for 0.1 "<joe>")
- (should-not (process-live-p erc-server-process))
- (erc-d-t-ensure-for 0.1 "server buffer remains foonet"
- (eq erc-server-process erc-server-process-foo))))
-
- (with-current-buffer erc-server-buffer-bar
- (erc-cmd-JOIN "#chan")
- (erc-d-t-wait-for 3 (get-buffer chan-buf-foo))
- (erc-d-t-wait-for 3 (get-buffer chan-buf-bar))
- (with-current-buffer chan-buf-bar
- (erc-d-t-wait-for 3 (eq erc-server-process erc-server-process-bar))
- (funcall expect 5 "marry her instantly")))
-
- (ert-info ("Reconnect to foonet")
- (with-current-buffer (setq erc-server-buffer-foo
- (funcall foo-reconnector))
- (should (member (if foo-id '(oofnet "#chan") '(foonet "#chan"))
- erc-autojoin-channels-alist))
- (erc-d-t-wait-for 3 (erc-server-process-alive))
- (setq erc-server-process-foo erc-server-process)
- (erc-d-t-wait-for 2 (eq erc-network 'foonet))
- (should (string= (buffer-name) (if foo-id "oofnet" "foonet")))
-
- (ert-info ("Prompt unhidden")
- (should-not (erc--prompt-hidden-p))
- (should-not (overlays-in erc-insert-marker erc-input-marker)))
- (funcall expect 5 "foonet")))
-
- (ert-info ("#chan@foonet is clean, no cross-contamination")
- (with-current-buffer chan-buf-foo
- (erc-d-t-wait-for 3 (eq erc-server-process erc-server-process-foo))
- (funcall expect 3 "<bob>")
- (erc-d-t-absent-for 0.1 "<joe>")
- (funcall expect 30 "not given me")
-
- (ert-info ("Prompt unhidden")
- (should-not (erc--prompt-hidden-p))
- (should-not (overlays-in erc-insert-marker erc-input-marker)))))
-
- (ert-info ("All #chan@barnet output received")
- (with-current-buffer chan-buf-bar
- (funcall expect 10 "hath an uncle here")))))
-
-(provide 'erc-scenarios-common)
-
-;;; erc-scenarios-common.el ends here
+++ /dev/null
-;;; erc-tests-common.el --- Common helpers for ERC tests -*- lexical-binding: t -*-
-
-;; Copyright (C) 2023-2025 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:
-
-;; This file must *not* contain any `ert-deftest' definitions. See
-;; top of test/lisp/erc/erc-tests.el for loading example.
-;;
-;; Environment variables:
-;;
-;; `ERC_PACKAGE_NAME': Name of the installed ERC package currently
-;; running. ERC needs this in order to load the same package in
-;; tests that run in a subprocess. Necessary even when the package
-;; name is `erc' and not something like `erc-49860'.
-;;
-;; `ERC_TESTS_INIT': The name of an alternate init file. Mainly for
-;; integrations tests involving starter kits.
-;;
-;; `ERC_TESTS_SNAPSHOT_SAVE': When set, ERC saves the current test's
-;; snapshots to disk.
-;;
-
-;;; Code:
-(require 'ert-x)
-(require 'erc)
-(eval-when-compile (require 'erc-stamp))
-(eval-and-compile
- (let ((load-path (cons (expand-file-name "../erc-d" (ert-resource-directory))
- load-path)))
- (require 'erc-d-i)))
-
-(defmacro erc-tests-common-equal-with-props (a b)
- "Compare strings A and B for equality including text props.
-Use `ert-equal-including-properties' on older Emacsen."
- (list (if (< emacs-major-version 29)
- 'ert-equal-including-properties
- 'equal-including-properties)
- a b))
-
-;; Caller should probably shadow `erc-insert-modify-hook' or populate
-;; user tables for erc-button.
-;; FIXME explain this comment ^ in more detail or delete.
-(defun erc-tests-common-prep-for-insertion ()
- "Initialize current buffer with essentials for message insertion.
-Assume caller intends to use `erc-display-message'."
- (erc-mode)
- (erc--initialize-markers (point) nil)
- (should (= (point) erc-input-marker)))
-
-(defun erc-tests-common-init-server-proc (&rest args)
- "Create a process with `start-process' from ARGS.
-Assign the result to `erc-server-process' in the current buffer."
- (setq erc-server-process
- (apply #'start-process (car args) (current-buffer) args))
- (set-process-query-on-exit-flag erc-server-process nil)
- erc-server-process)
-
-;; After dropping support for Emacs 27, callers can use
-;; `get-buffer-create' with INHIBIT-BUFFER-HOOKS.
-(defun erc-tests-common-kill-buffers (&rest extra-buffers)
- "Kill all ERC buffers and possibly EXTRA-BUFFERS."
- (let (erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
- (dolist (buf (erc-buffer-list))
- (kill-buffer buf))
- (named-let doit ((buffers extra-buffers))
- (dolist (buf buffers)
- (if (consp buf) (doit buf) (kill-buffer buf))))))
-
-(defun erc-tests-common-with-process-input-spy (test-fn)
- "Mock `erc-process-input-line' and call TEST-FN.
-Shadow `erc--input-review-functions' and `erc-pre-send-functions'
-with `erc-add-to-input-ring' removed. Shadow other relevant
-variables as nil, and bind `erc-last-input-time' to 0. Also mock
-`erc-server-buffer' to return the current buffer. Call TEST-FN
-with a utility function that returns the set of arguments most
-recently passed to the mocked `erc-process-input-line'. Make
-`inhibit-message' non-nil unless running interactively."
- (with-current-buffer (get-buffer-create "FakeNet")
- (let* ((erc--input-review-functions
- (remove 'erc-add-to-input-ring erc--input-review-functions))
- (erc-pre-send-functions
- (remove 'erc-add-to-input-ring erc-pre-send-functions)) ; for now
- (inhibit-message noninteractive)
- (erc-server-current-nick "tester")
- (erc-last-input-time 0)
- erc-accidental-paste-threshold-seconds
- erc-send-modify-hook
- ;;
- calls)
- (cl-letf (((symbol-function 'erc-process-input-line)
- (lambda (&rest r) (push r calls)))
- ((symbol-function 'erc-server-buffer)
- (lambda () (current-buffer))))
- (funcall test-fn (lambda () (pop calls)))))
- (when noninteractive (kill-buffer))))
-
-(defun erc-tests-common-make-server-buf (&optional name)
- "Return a server buffer named NAME, creating it if necessary.
-Use NAME for the network and the session server as well."
- (with-current-buffer (if name
- (get-buffer-create name)
- (and (string-search "temp" (buffer-name))
- (setq name "foonet")
- (buffer-name)))
- (erc-tests-common-prep-for-insertion)
- (erc-tests-common-init-server-proc "sleep" "1")
- (setq erc-session-server (concat "irc." name ".org")
- erc-server-announced-name (concat "west." name ".org")
- erc-server-users (make-hash-table :test #'equal)
- erc-server-parameters nil
- erc--isupport-params (make-hash-table)
- erc-session-port 6667
- erc-network (intern name)
- erc-networks--id (erc-networks--id-create name))
- (current-buffer)))
-
-(defun erc-tests-common-string-to-propertized-parts (string)
- "Return a sequence of `propertize' forms for generating STRING.
-Expect maintainers manipulating template catalogs to use this
-with `pp-eval-last-sexp' or similar to convert back and forth
-between literal strings."
- `(concat
- ,@(mapcar
- (pcase-lambda (`(,beg ,end ,plist))
- ;; At the time of writing, `propertize' produces a string
- ;; with the order of the input plist reversed.
- `(propertize ,(substring-no-properties string beg end)
- ,@(let (out)
- (while-let ((plist)
- (k (pop plist))
- (v (pop plist)))
- (push (if (or (consp v) (symbolp v)) `',v v) out)
- (push `',k out))
- out)))
- (object-intervals string))))
-
-(defun erc-tests-common-pp-propertized-parts (arg)
- "Convert literal string before point into a `propertize'd form.
-For simplicity, assume string evaluates to itself."
- (interactive "P")
- (let ((sexp (erc-tests-common-string-to-propertized-parts (pp-last-sexp))))
- (if arg (insert (pp-to-string sexp)) (pp-macroexpand-expression sexp))))
-
-
-(cl-defun erc-tests-common-add-cmem
- (nick &optional (host "fsf.org")
- (user (concat "~" (substring nick 0 (min 10 (length nick)))))
- (full-name (upcase-initials nick)))
- "Create channel user for NICK with test-oriented defaults."
- (erc-update-channel-member (erc-target) nick nick t nil nil nil nil nil
- host user full-name))
-
-(defun erc-tests-common-parse-line (line)
- "Return a single `erc-response' parsed from line."
- (let ((parsed (erc-d-i--parse-message line)))
- (make-erc-response :unparsed (erc-d-i-message.unparsed parsed)
- :sender (erc-d-i-message.sender parsed)
- :command (erc-d-i-message.command parsed)
- :command-args (erc-d-i-message.command-args parsed)
- :contents (erc-d-i-message.contents parsed)
- :tags (erc-d-i-message.tags parsed))))
-
-(defun erc-tests-common-simulate-line (line)
- "Run response handlers for raw IRC protocol LINE."
- (let ((parsed (erc-tests-common-parse-line line))
- (erc--msg-prop-overrides (or erc--msg-prop-overrides
- '((erc--ts . 0)))))
- (erc-call-hooks erc-server-process parsed)))
-
-(defun erc-tests-common-simulate-privmsg (nick msg)
- (erc-tests-common-simulate-line
- (format ":%s PRIVMSG %s :%s"
- (erc-user-spec (erc-get-server-user nick))
- (erc-target)
- msg)))
-
-;; The following utilities are meant to help prepare tests for
-;; `erc--get-inserted-msg-bounds' and friends.
-(defun erc-tests-common-get-inserted-msg-setup ()
- (erc-tests-common-prep-for-insertion)
- (let ((parsed (make-erc-response :unparsed ":bob PRIVMSG #chan :hi"
- :sender "bob"
- :command "PRIVMSG"
- :command-args (list "#chan" "hi")
- :contents "hi"))
- (erc--msg-prop-overrides '((erc--ts . 0))))
- (erc-display-message parsed nil (current-buffer)
- (erc-format-privmessage "bob" "hi" nil t)))
- (goto-char 3)
- (should (looking-at "<bob> hi")))
-
-;; All these bounds-finding functions take an optional POINT argument.
-;; So run each case with and without it at each pos in the message.
-(defun erc-tests-common-assert-get-inserted-msg (from to assert-fn)
- (dolist (pt-arg '(nil t))
- (dolist (i (number-sequence from to))
- (goto-char i)
- (ert-info ((format "At %d (%c) %s param" i (char-after i)
- (if pt-arg "with" "")))
- (funcall assert-fn (and pt-arg i))))))
-
-(defun erc-tests-common-assert-get-inserted-msg/basic (test-fn)
- (erc-tests-common-get-inserted-msg-setup)
- (goto-char 11)
- (should (looking-back "<bob> hi"))
- (erc-tests-common-assert-get-inserted-msg 3 11 test-fn))
-
-(defun erc-tests-common-assert-get-inserted-msg/truncated (test-fn)
- (erc-tests-common-get-inserted-msg-setup)
- (with-silent-modifications (delete-region 1 3))
- (goto-char 9)
- (should (looking-back "<bob> hi"))
- (erc-tests-common-assert-get-inserted-msg 1 9 test-fn))
-
-;; This is a "mixin" and requires a base assertion function, like
-;; `erc-tests-common-assert-get-inserted-msg/basic', to work.
-(defun erc-tests-common-assert-get-inserted-msg-readonly-with
- (assert-fn test-fn)
- (defvar erc-readonly-mode)
- (defvar erc-readonly-mode-hook)
- (let ((erc-readonly-mode nil)
- (erc-readonly-mode-hook nil)
- (erc-send-post-hook erc-send-post-hook)
- (erc-insert-post-hook erc-insert-post-hook))
- (erc-readonly-mode +1)
- (funcall assert-fn test-fn)))
-
-(defun erc-tests--common-display-message (orig &rest args)
- (require 'erc-stamp)
- (defvar erc-stamp--deferred-date-stamp)
- (let (erc-stamp--deferred-date-stamp)
- (prog1 (apply orig args)
- (when-let ((inst erc-stamp--deferred-date-stamp)
- (fn (erc-stamp--date-fn inst)))
- (funcall fn)))))
-
-(defun erc-tests-common-display-message (&rest args)
- (apply #'erc-tests--common-display-message #'erc-display-message args))
-
-(defmacro erc-tests-common-with-date-aware-display-message (&rest body)
- `(progn
- (advice-add 'erc-display-message
- :around #'erc-tests--common-display-message)
- (unwind-protect (progn ,@body)
- (advice-remove 'erc-display-message
- #'erc-tests--common-display-message))))
-
-;;;; Buffer snapshots
-
-;; Use this variable to generate new snapshots after carefully
-;; reviewing the output of *each* snapshot (not just first and last).
-;; Obviously, only run one test at a time.
-(defvar erc-tests-common-snapshot-save-p (getenv "ERC_TESTS_SNAPSHOT_SAVE"))
-
-(defun erc-tests-common-snapshot-compare (name dir trans-fn buf-init-fn)
- "Compare `buffer-string' to snapshot NAME.eld in DIR, if present.
-When non-nil, run TRANS-FN to filter the current buffer string,
-and expect a similar string in return. Call BUF-INIT-FN, when
-non-nil, in the preview buffer after inserting the filtered
-string."
- (let* ((expect-file (file-name-with-extension (expand-file-name name dir)
- "eld"))
- (erc--own-property-names
- (seq-difference `(font-lock-face ,@erc--own-property-names)
- `(field display wrap-prefix line-prefix
- erc--msg erc--cmd erc--spkr erc--ts erc--ctcp
- erc--ephemeral)
- #'eq))
- (print-circle t)
- (print-escape-newlines t)
- (print-escape-nonascii t)
- (got (erc--remove-text-properties
- (buffer-substring (point-min) erc-insert-marker)))
- (repr (funcall (or trans-fn #'identity) (prin1-to-string got)))
- (xstr (read (with-temp-buffer
- (insert-file-contents-literally expect-file)
- (buffer-string)))))
- (with-current-buffer (generate-new-buffer name)
- (with-silent-modifications
- (insert (setq got (read repr))))
- (when buf-init-fn (funcall buf-init-fn))
- (erc-mode))
- (unless noninteractive
- (with-current-buffer (generate-new-buffer (format "%s-xpt" name))
- (insert xstr)
- (erc-mode)))
- ;; LHS is a string, RHS is a symbol.
- (if (string= erc-tests-common-snapshot-save-p
- (ert-test-name (ert-running-test)))
- (let (inhibit-message)
- (with-temp-file expect-file
- (insert repr))
- ;; Limit writing snapshots to one test at a time.
- (message "erc-tests-common-snapshot-compare: wrote %S" expect-file))
- (if (file-exists-p expect-file)
- ;; Ensure string-valued properties, like timestamps, aren't
- ;; recursive (signals `max-lisp-eval-depth' exceeded).
- (named-let assert-equal
- ((latest (read repr))
- (expect xstr))
- (pcase latest
- ((or "" 'nil) t)
- ((pred stringp)
- (should (equal-including-properties latest expect))
- (let ((latest-intervals (object-intervals latest))
- (expect-intervals (object-intervals expect)))
- (while-let ((l-iv (pop latest-intervals))
- (x-iv (pop expect-intervals))
- (l-tab (map-into (nth 2 l-iv) 'hash-table))
- (x-tab (map-into (nth 2 x-iv) 'hash-table)))
- (pcase-dolist (`(,l-k . ,l-v) (map-pairs l-tab))
- (assert-equal l-v (gethash l-k x-tab))
- (remhash l-k x-tab))
- (should (zerop (hash-table-count x-tab))))))
- ((pred sequencep)
- (assert-equal (seq-first latest) (seq-first expect))
- (assert-equal (seq-rest latest) (seq-rest expect)))
- (_ (should (equal latest expect)))))
- (message "Snapshot file missing: %S" expect-file)))))
-
-(defun erc-tests-common-create-subprocess (code switches libs)
- "Return subprocess for running CODE in an inferior Emacs.
-Include SWITCHES, like \"-batch\", as well as libs, after
-interspersing \"-l\" between members."
- (let* ((package (if-let ((found (getenv "ERC_PACKAGE_NAME"))
- ((string-prefix-p "erc-" found)))
- (intern found)
- 'erc))
- ;; For integrations testing with managed configs that use a
- ;; different package manager.
- (init (and-let* ((found (getenv "ERC_TESTS_INIT"))
- (files (split-string found ",")))
- (mapcan (lambda (f) (list "-l" f)) files)))
- (prog
- `(progn
- ,@(and (not init) (featurep 'compat)
- `((require 'package)
- (let ((package-load-list '((compat t) (,package t))))
- (package-initialize))))
- (require 'erc)
- (cl-assert (equal erc-version ,erc-version) t)
- ,code))
- (proc (make-process
- :name (symbol-name (ert-test-name (ert-running-test)))
- :buffer (current-buffer)
- :command `(,(concat invocation-directory invocation-name)
- ,@(or init '("-Q"))
- ,@switches
- ,@(mapcan (lambda (f) (list "-l" f)) libs)
- "-eval" ,(format "%S" prog))
- :connection-type 'pipe
- :stderr (messages-buffer)
- :noquery t)))
- proc))
-
-(declare-function erc-track--setup "erc-track" ())
-
-(defun erc-tests-common-track-modified-channels (test)
- (erc-tests-common-prep-for-insertion)
- (setq erc--target (erc--target-from-string "#chan"))
- (erc-tests-common-track-modified-channels-sans-setup test))
-
-(defun erc-tests-common-track-modified-channels-sans-setup (test)
- "Provide a fixture for testing `erc-track-modified-channels'.
-Call function TEST with another function that sets the mocked return
-value of `erc-track--collect-faces-in' to the given argument, a list of
-faces in the reverse order they appear in an inserted message."
- (defvar erc-modified-channels-alist)
- (defvar erc-modified-channels-object)
- (defvar erc-track--attn-faces)
- (defvar erc-track--normal-faces)
- (defvar erc-track--priority-faces)
- (defvar erc-track-faces-normal-list)
- (defvar erc-track-faces-priority-list)
- (defvar erc-track-mode)
-
- (cl-letf* ((erc-track-mode t)
- (erc-modified-channels-alist nil)
- (erc-modified-channels-object erc-modified-channels-object)
- (faces ())
- ((symbol-function 'force-mode-line-update) #'ignore)
- ((symbol-function 'erc-faces-in) (lambda (_) faces))
- ((symbol-function 'erc-track--collect-faces-in)
- (lambda ()
- (cons (map-into (mapcar (lambda (f) (cons f t)) faces)
- '(hash-table :test equal))
- faces))))
- (erc-track--setup)
-
- ;; Faces from `erc-track--attn-faces' prepended.
- (should (= (+ (length erc-track--attn-faces)
- (length erc-track-faces-priority-list))
- (hash-table-count erc-track--priority-faces)))
- (should (= (length erc-track-faces-normal-list)
- (hash-table-count erc-track--normal-faces)))
-
- (funcall test (lambda (arg) (setq faces arg)))))
-
-;; To use this function, add something like
-;;
-;; ("lisp/erc"
-;; (emacs-lisp-mode (eval erc-tests-common-add-imenu-expressions)))
-;;
-;; to your ~/emacs/master/.dir-locals-2.el. Optionally, add the sexp
-;;
-;; (erc-tests-common-add-imenu-expressions)
-;;
-;; to the user option `safe-local-eval-forms', and load this file before
-;; hacking, possibly by autoloading this function in your init.el.
-(defun erc-tests-common-add-imenu-expressions (&optional removep)
- "Tell `imenu' about ERC-defined macros. With REMOVEP, do the opposite."
- (interactive "P")
- ;; This currently produces results like "ERC response FOO BAR", but it
- ;; would be preferable to end up with "erc-response-FOO" and
- ;; "erc-response-BAR" instead, possibly as separate items. Likewise
- ;; for modules: "erc-foo-mode" instead of "ERC module foo".
- (dolist (item `(("ERC response"
- ,(rx bol (* (syntax whitespace))
- "(define-erc-response-handler (" (group (+ nonl)) ")")
- 1)
- ("ERC module"
- ,(rx bol (* (syntax whitespace))
- ;; No `lisp-mode-symbol' in < Emacs 29.
- "(define-erc-module " (group (+ (| (syntax word)
- (syntax symbol)
- (: "\\" nonl)))))
- 1)))
- ;; This should only run in `emacs-lisp-mode' buffers, which have
- ;; this variable set locally.
- (cl-assert (local-variable-p 'imenu-generic-expression))
- (if removep
- (setq imenu-generic-expression
- (remove item imenu-generic-expression))
- (cl-pushnew item imenu-generic-expression :test #'equal))))
-
-(provide 'erc-tests-common)
+++ /dev/null
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero. [07:00]\n<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #5#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 (8)))) 477 482 (wrap-prefix #1# line-prefix #8#) 482 488 (wrap-prefix #1# line-prefix #8#) 489 490 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #9=(space :width (- 27 0)) erc-fill--wrap-merge #7="" display #7#) 490 495 (wrap-prefix #1# line-prefix #9# erc-fill--wrap-merge #7# display #7#) 495 497 (wrap-prefix #1# line-prefix #9# erc-fill--wrap-merge #7# display #7#) 497 501 (wrap-prefix #1# line-prefix #9#) 502 503 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) erc-fill--wrap-merge #7# display #7#) 516 519 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #7# display #7#) 519 521 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #7# display #7#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) erc-fill--wrap-merge #7# display #7#) 542 547 (wrap-prefix #1# line-prefix #13# erc-fill--wrap-merge #7# display #7#) 547 549 (wrap-prefix #1# line-prefix #13# erc-fill--wrap-merge #7# display #7#) 549 553 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
+++ /dev/null
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero. [07:00]\n<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18))) field erc-timestamp) 21 22 (wrap-prefix #1# line-prefix #2=(space :width (- 29 (4))) erc--msg notice erc--ts 0) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (wrap-prefix #1# line-prefix #2# field erc-timestamp) 184 191 (wrap-prefix #1# line-prefix #2# field erc-timestamp display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (wrap-prefix #1# line-prefix #3=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix (space :width (- 29 (8)))) 350 351 (wrap-prefix #1# line-prefix #4=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (wrap-prefix #1# line-prefix (space :width (- 29 (18))) field erc-timestamp) 456 457 (wrap-prefix #1# line-prefix #5=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (wrap-prefix #1# line-prefix #5# field erc-timestamp) 468 475 (wrap-prefix #1# line-prefix #5# field erc-timestamp display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (wrap-prefix #1# line-prefix #8=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG) 477 482 (wrap-prefix #1# line-prefix #8#) 482 488 (wrap-prefix #1# line-prefix #8#) 489 490 (wrap-prefix #1# line-prefix #9=(space :width (- 29 0)) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG erc-fill--wrap-merge #7="" display #7#) 490 495 (wrap-prefix #1# line-prefix #9# erc-fill--wrap-merge #7# display #7#) 495 497 (wrap-prefix #1# line-prefix #9# erc-fill--wrap-merge #7# display #7#) 497 501 (wrap-prefix #1# line-prefix #9#) 502 503 (wrap-prefix #1# line-prefix #10=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc-fill--wrap-merge #7# display #7#) 516 519 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #7# display #7#) 519 521 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #7# display #7#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (wrap-prefix #1# line-prefix #12=(space :width (- 29 (8))) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG erc-fill--wrap-merge #7# display #7#) 542 547 (wrap-prefix #1# line-prefix #13# erc-fill--wrap-merge #7# display #7#) 547 549 (wrap-prefix #1# line-prefix #13# erc-fill--wrap-merge #7# display #7#) 549 553 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
+++ /dev/null
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero. [07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) erc-fill--wrap-merge #8="" display #8#) 477 480 (wrap-prefix #1# line-prefix #7# erc-fill--wrap-merge #8# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# erc-fill--wrap-merge #8# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #10#) 501 507 (wrap-prefix #1# line-prefix #10#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) erc-fill--wrap-merge #8# display #8#) 509 512 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #8# display #8#) 512 514 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #8# display #8#) 514 517 (wrap-prefix #1# line-prefix #11#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #12#) 520 523 (wrap-prefix #1# line-prefix #12#) 523 529 (wrap-prefix #1# line-prefix #12#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #13#) 534 541 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
+++ /dev/null
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero. [07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) erc-fill--wrap-merge t display #8=#("> " 0 1 (font-lock-face shadow))) 477 480 (wrap-prefix #1# line-prefix #7# erc-fill--wrap-merge t display #8#) 480 482 (wrap-prefix #1# line-prefix #7# erc-fill--wrap-merge t display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #11#) 501 507 (wrap-prefix #1# line-prefix #11#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) erc-fill--wrap-merge t display #8#) 509 512 (wrap-prefix #1# line-prefix #12# erc-fill--wrap-merge t display #8#) 512 514 (wrap-prefix #1# line-prefix #12# erc-fill--wrap-merge t display #8#) 514 517 (wrap-prefix #1# line-prefix #12#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #13#) 520 523 (wrap-prefix #1# line-prefix #13#) 523 529 (wrap-prefix #1# line-prefix #13#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #14#) 534 541 (wrap-prefix #1# line-prefix #14#))
\ No newline at end of file
+++ /dev/null
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#))
\ No newline at end of file
+++ /dev/null
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 29 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 29 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#))
\ No newline at end of file
+++ /dev/null
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 25 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 25 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#))
\ No newline at end of file
+++ /dev/null
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#))
\ No newline at end of file
+++ /dev/null
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n<bob> This buffer is for text.\n*** one two three\n*** four five six\n<bob> Somebody stop me\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (line-spacing 0.5) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 349 350 (line-spacing 0.5) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 436 437 (line-spacing 0.5) 437 438 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) erc-fill--wrap-merge #6="" display #6#) 438 441 (wrap-prefix #1# line-prefix #5# erc-fill--wrap-merge #6# display #6#) 441 443 (wrap-prefix #1# line-prefix #5# erc-fill--wrap-merge #6# display #6#) 443 467 (wrap-prefix #1# line-prefix #5#) 467 468 (line-spacing 0.5) 468 469 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 469 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 487 503 (wrap-prefix #1# line-prefix #8#) 503 504 (line-spacing 0.5) 504 505 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 505 508 (wrap-prefix #1# line-prefix #9#) 508 526 (wrap-prefix #1# line-prefix #9#))
\ No newline at end of file
+++ /dev/null
-#("\n\n[00:00]*** 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.\n[00:00]<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg notice erc--ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#))
\ No newline at end of file
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER tester 0 * :tester")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 26 May 2024 09:32:55 UTC")
- (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=25 :are supported by this server")
- (0.02 ":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.03 ":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")
- (0.00 ":irc.foonet.org 221 tester +Zi")
- (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."))
-
-((mode-user 10 "MODE tester +i")
- (0.00 ":irc.foonet.org 221 tester +Zi"))
-
-((join 10 "JOIN #chan")
- (0.02 ":tester!~u@psu3bp52z9f34.irc JOIN #chan")
- (0.06 ":irc.foonet.org 353 tester = #chan :bob dummy tester @fsbot alice")
- (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-
-((join 10 "JOIN #control")
- (0.02 ":tester!~u@psu3bp52z9f34.irc JOIN #control")
- (0.06 ":irc.foonet.org 353 tester = #control :@tester")
- (0.01 ":irc.foonet.org 366 tester #control :End of NAMES list"))
-
-((mode-chan 10 "MODE #chan")
- (0.02 ":irc.foonet.org 324 tester #chan +Cnt")
- (0.01 ":irc.foonet.org 329 tester #chan 1716715981")
- (0.00 ":alice!~u@zmmipd3xfii2w.irc PRIVMSG #chan :tester, welcome!")
- (0.00 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :tester, welcome!"))
-
-((mode-chan 10 "MODE #control")
- (0.02 ":irc.foonet.org 324 tester #control +Cnt")
- (0.01 ":irc.foonet.org 329 tester #control 1716715981")
-
- (0.02 ":dummy!~u@psu3bp52z9f34.irc PRIVMSG tester :hi")
- (0.03 ":dummy!~u@psu3bp52z9f34.irc PRIVMSG tester :there"))
-
-;; Date changes here.
-((privmsg-chan-a 10 "PRIVMSG #control :1")
- (0.07 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :one"))
-
-((privmsg-chan-a 10 "PRIVMSG #control :2")
- (0.00 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :two")
- (0.02 ":dummy!~u@psu3bp52z9f34.irc PRIVMSG tester :again")
- (0.04 ":alice!~u@zmmipd3xfii2w.irc PRIVMSG #chan :bob: He was famous, sir, in his profession, and it was his great right to be so: Gerard de Narbon."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK dummy"))
-((user 1 "USER user 0 * :dummy")
- (0.00 ":irc.foonet.org 001 dummy :Welcome to the foonet IRC Network dummy")
- (0.01 ":irc.foonet.org 002 dummy :Your host is irc.foonet.org, running version ergo-v2.8.0")
- (0.00 ":irc.foonet.org 003 dummy :This server was created Tue, 24 May 2022 05:28:42 UTC")
- (0.00 ":irc.foonet.org 004 dummy irc.foonet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.foonet.org 005 dummy 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 dummy 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 dummy draft/CHATHISTORY=100 :are supported by this server")
- (0.00 ":irc.foonet.org 251 dummy :There are 0 users and 4 invisible on 1 server(s)")
- (0.00 ":irc.foonet.org 252 dummy 0 :IRC Operators online")
- (0.00 ":irc.foonet.org 253 dummy 0 :unregistered connections")
- (0.00 ":irc.foonet.org 254 dummy 2 :channels formed")
- (0.00 ":irc.foonet.org 255 dummy :I have 4 clients and 0 servers")
- (0.00 ":irc.foonet.org 265 dummy 4 4 :Current local users 4, max 4")
- (0.00 ":irc.foonet.org 266 dummy 4 4 :Current global users 4, max 4")
- (0.00 ":irc.foonet.org 422 dummy :MOTD File is missing"))
-
-((mode 6 "MODE dummy +i")
- (0.00 ":irc.foonet.org 221 dummy +i")
- (0.00 ":irc.foonet.org NOTICE dummy :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 dummy +i"))
-
-((join 6.47 "JOIN #spam secret")
- (0.03 ":dummy!~u@w9rfqveugz722.irc JOIN #spam"))
-
-((mode-spam 10 "MODE #spam")
- (0.01 ":irc.foonet.org 353 dummy = #spam :~tester dummy")
- (0.00 ":irc.foonet.org 366 dummy #spam :End of NAMES list")
- (0.01 ":irc.foonet.org 324 dummy #spam +knt secret")
- (0.03 ":irc.foonet.org 329 dummy #spam 1653370308"))
+++ /dev/null
-;; -*- 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)"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((join 6 "JOIN #chan")
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-
-((mode 5 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620104779")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: But, as it seems, did violence on herself.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Well, this is the forest of Arden.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: And will you, being a man of your breeding, be married under a bush, like a beggar ? Get you to church, and have a good priest that can tell you what marriage is: this fellow will but join you together as they join wainscot; then one of you will prove a shrunk panel, and like green timber, warp, warp.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Live, and be prosperous; and farewell, good fellow."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :barnet:changeme"))
-((nick 2 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
- (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.barnet.org 003 tester :This server was created Mon, 10 May 2021 00:58:22 UTC")
- (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.barnet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.barnet.org 254 tester 1 :channels formed")
- (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-
-((mode-user 12 "MODE tester +i"))
-;; No mode answer
-
-((join 2 "JOIN #chan")
- (0 ":tester!~u@6yximxrnkg65a.irc JOIN #chan")
- (0 ":irc.barnet.org 353 tester = #chan :@joe mike tester")
- (0 ":irc.barnet.org 366 tester #chan :End of NAMES list")
- (0.1 ":joe!~u@6yximxrnkg65a.irc PRIVMSG #chan :tester, welcome!")
- (0 ":mike!~u@6yximxrnkg65a.irc PRIVMSG #chan :tester, welcome!"))
-
-((mode 1 "MODE #chan")
- (0 ":irc.barnet.org 324 tester #chan +nt")
- (0 ":irc.barnet.org 329 tester #chan 1620608304")
- ;; Wait for foonet's buffer playback
- (0.1 ":mike!~u@6yximxrnkg65a.irc PRIVMSG #chan :joe: Go take her hence, and marry her instantly.")
- (0.1 ":joe!~u@6yximxrnkg65a.irc PRIVMSG #chan :mike: Of all the four, or the three, or the two, or one of the four.")
- (0.1 ":mike!~u@6yximxrnkg65a.irc PRIVMSG #chan :joe: And gives the crutch the cradle's infancy.")
- (0.1 ":joe!~u@6yximxrnkg65a.irc PRIVMSG #chan :mike: Such is the simplicity of man to hearken after the flesh.")
- (0.05 ":mike!~u@6yximxrnkg65a.irc PRIVMSG #chan :joe: The leaf to read them. Let us toward the king.")
- (0.05 ":joe!~u@6yximxrnkg65a.irc PRIVMSG #chan :mike: Many can brook the weather that love not the wind.")
- (0.05 ":mike!~u@6yximxrnkg65a.irc PRIVMSG #chan :joe: And now, dear maid, be you as free to us.")
- (0.00 ":joe!~u@6yximxrnkg65a.irc PRIVMSG #chan :mike: He hath an uncle here in Messina will be very much glad of it."))
-
-((linger 30 LINGER))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass-redux 10 "PASS :foonet:changeme"))
-((nick-redux 1 "NICK tester"))
-
-((user-redux 1 "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 Mon, 10 May 2021 00:58:22 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10.2 "MODE tester +i")
- ;; No mode answer ^
-
- ;; History
- (0 ":tester!~u@q6ddatxcq6txy.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :@alice bob tester")
- (0 ":irc.foonet.org 366 tester #chan :End of /NAMES list.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...")
- (0 ":bob!~u@q6ddatxcq6txy.irc PRIVMSG #chan :[02:43:23] alice: And soar with them above a common bound.")
- (0 ":alice!~u@q6ddatxcq6txy.irc PRIVMSG #chan :[02:43:27] bob: And be aveng'd on cursed Tamora.")
- (0 ":bob!~u@q6ddatxcq6txy.irc PRIVMSG #chan :[02:43:29] alice: He did love her, sir, as a gentleman loves a woman.")
- (0 ":***!znc@znc.in PRIVMSG #chan :Playback Complete."))
-
-;; As a server, we ignore useless join sent by autojoin module
-((~join 10 "JOIN #chan"))
-
-((mode-redux 10 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620608304")
- (0.1 ":alice!~u@q6ddatxcq6txy.irc PRIVMSG #chan :bob: Ay, madam, with the swiftest wing of speed.")
- (0.1 ":bob!~u@q6ddatxcq6txy.irc PRIVMSG #chan :alice: Five times in that ere once in our five wits.")
- (0.1 ":alice!~u@q6ddatxcq6txy.irc PRIVMSG #chan :bob: And bid him come to take his last farewell.")
- (0.1 ":bob!~u@q6ddatxcq6txy.irc PRIVMSG #chan :alice: But we are spirits of another sort.")
- (0.1 ":alice!~u@q6ddatxcq6txy.irc PRIVMSG #chan :bob: It was not given me, nor I did not buy it."))
-
-((linger 30 LINGER))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((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 Mon, 10 May 2021 00:58:22 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10.2 "MODE tester +i"))
-;; No mode answer ^
-
-((join 3 "JOIN #chan")
- (0 ":tester!~u@q6ddatxcq6txy.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :@alice bob tester")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.1 ":bob!~u@q6ddatxcq6txy.irc PRIVMSG #chan :tester, welcome!")
- (0 ":alice!~u@q6ddatxcq6txy.irc PRIVMSG #chan :tester, welcome!"))
-
-((mode 3 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620608304")
- (0.1 ":bob!~u@q6ddatxcq6txy.irc PRIVMSG #chan :alice: Pray you, sir, deliver me this paper.")
- (0.1 ":alice!~u@q6ddatxcq6txy.irc PRIVMSG #chan :bob: Wake when some vile thing is near."))
-
-((quit 3 "QUIT :\2ERC\2"))
-
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 3.2 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is still in debug mode."))
-
-((~join-chan 12 "JOIN #chan")
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-
-((~join-spam 12 "JOIN #spam")
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #spam")
- (0 ":irc.foonet.org 353 tester = #spam :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #spam :End of NAMES list"))
-
-((~mode-chan 4 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620104779")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: But, as it seems, did violence on herself.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Well, this is the forest of Arden."))
-
-((mode-spam 4 "MODE #spam")
- (0 ":irc.foonet.org 324 tester #spam +nt")
- (0 ":irc.foonet.org 329 tester #spam 1620104779")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #spam :alice: Signior Iachimo will not from it. Pray, let us follow 'em.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #spam :bob: Our queen and all her elves come here anon."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 3.2 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode.")
-
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list")
-
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #spam")
- (0 ":irc.foonet.org 353 tester = #spam :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #spam :End of NAMES list"))
-
-((mode-chan 4 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620104779")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!"))
-
-((mode-spam 4 "MODE #spam")
- (0 ":irc.foonet.org 324 tester #spam +nt")
- (0 ":irc.foonet.org 329 tester #spam 1620104779")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #spam :tester, welcome!")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #spam :tester, welcome!"))
-
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER tester 0 * :tester")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.01 ":irc.foonet.org 003 tester :This server was created Tue, 26 Dec 2023 08:36:35 UTC")
- (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
- (0.01 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)")
- (0.01 ":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.03 ":irc.foonet.org 422 tester :MOTD File is missing")
- (0.01 ":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."))
-
-((mode 10 "MODE tester +i"))
-
-((join 10 "JOIN #chan")
- (0.01 ":irc.foonet.org 221 tester +i")
- (0.01 ":tester!~u@p64eqfwvvbxrk.irc JOIN #chan")
- (0.03 ":irc.foonet.org 353 tester = #chan :@fsbot bob alice tester")
- (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.00 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :tester, welcome!")
- (0.01 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :tester, welcome!"))
-
-((join 10 "JOIN #spam")
- (0.00 ":tester!~u@p64eqfwvvbxrk.irc JOIN #spam")
- (0.06 ":irc.foonet.org 353 tester = #spam :@fsbot bob alice tester")
- (0.01 ":irc.foonet.org 366 tester #spam :End of NAMES list")
- (0.03 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #spam :tester, welcome!")
- (0.01 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #spam :tester, welcome!"))
-
-((mode 10 "MODE #chan")
- (0.00 ":irc.foonet.org 324 tester #chan +Cnt")
- (0.02 ":irc.foonet.org 329 tester #chan 1703579802")
- (0.02 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :bob: Madam, my lord is gone, for ever gone.")
- (0.10 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :The kinder we, to give them thanks for nothing."))
-
-((mode 10 "MODE #spam")
- (0.00 ":irc.foonet.org 324 tester #spam +Cnt")
- (0.02 ":irc.foonet.org 329 tester #spam 1703579805")
- (0.02 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :Most manifest, and not denied by himself.")
- (0.02 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :alice: To bed, to bed: there's knocking at the gate. Come, come, come, come, give me your hand. What's done cannot be undone.")
- (0.02 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :bob: And what I spake, I spake it to my face.")
- (0.08 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :alice: Since you can cog, I'll play no more with you.")
- (0.06 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :bob: The little casket bring me hither.")
- (0.01 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :alice: Not to-night, good Iago: I have very poor and unhappy brains for drinking: I could well wish courtesy would invent some other custom of entertainment.")
- (0.02 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :Yes, faith will I, Fridays and Saturdays and all."))
-
-((privmsg 10 "PRIVMSG #spam :one")
- (0.03 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :bob: This is the first truth that e'er thine own tongue was guilty of.")
- (0.02 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :alice: Drown the lamenting fool in sea-salt tears.")
-
- ;; Insert some lines ^ before rendezvous, so #chan can update scrolltobottom.
- (0.01 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #spam :Ay, the heads of the maids, or their maidenheads; take it in what sense thou wilt.")
-
- (0.05 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :alice: And work confusion on his enemies.")
- (0.06 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :bob: Truly, she must be given, or the marriage is not lawful."))
-
-((privmsg 10 "PRIVMSG #spam :two")
- (0.02 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :To be whipped; and yet a better love than my master.")
- (0.06 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :And duty in his service perishing.")
-
- ;; Second check point.
- (0.01 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #spam :Cause they take vengeance of such kind of men.")
-
- (0.03 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :alice: No egma, no riddle, no l'envoy; no salve in the mail, sir. O! sir, plantain, a plain plantain: no l'envoy, no l'envoy: no salve, sir, but a plantain.")
- (0.03 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :Signior Iachimo will not from it. Pray, let us follow 'em."))
-
-((privmsg 10 "PRIVMSG #spam :three")
- ;; Third check point.
- (0.01 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #spam :Moved.")
- (0.01 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :Ready."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((pass 10 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
- (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((join 6 "JOIN #chan")
- (0 ":tester!~u@9g6b728983yd2.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
- (0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-
-((mode 5 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620104779")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
- (0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :None better than to let him fetch off his drum, which you hear him so confidently undertake to do.")
- (0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Still we went coupled and inseparable.")
- (0 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Give me your hand. This hand is moist, my lady."))
-
-((privmsg 5 "PRIVMSG #chan :hey")
- (0 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :You have paid the heavens your function, and the prisoner the very debt of your calling. I have laboured for the poor gentleman to the extremest shore of my modesty; but my brother justice have I found so severe, that he hath forced me to tell him he is indeed Justice.")
- (0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: In the sick air: let not thy sword skip one.")
- (0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :The web of our life is of a mingled yarn, good and ill together: our virtues would be proud if our faults whipped them not; and our crimes would despair if they were not cherished by our virtues."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0 ":irc.foonet.org 001 tester :Welcome to the FooNet Internet Relay Chat Network tester")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :unknown")
- (0.00 ":irc.example.net NOTICE * :*** Looking up your hostname...")
- (0.01 ":irc.example.net NOTICE tester :*** Could not resolve your hostname: Domain not found; using your IP address (10.0.2.100) instead.")
- (0.10 ":irc.example.net 001 tester :Welcome to the FooNet IRC Network tester!user@10.0.2.100")
- (0.02 ":irc.example.net 002 tester :Your host is irc.example.net, running version InspIRCd-3")
- (0.02 ":irc.example.net 003 tester :This server was created 05:58:57 Jan 04 2023")
- (0.01 ":irc.example.net 004 tester irc.example.net InspIRCd-3 BIRcgikorsw ACHIKMORTXabcefghijklmnopqrstvz :HIXabefghjkloqv")
- (0.00 ":irc.example.net 005 tester ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=ascii CHANLIMIT=#:20 CHANMODES=IXbeg,k,Hfjl,ACKMORTcimnprstz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server")
- (0.02 ":irc.example.net 005 tester EXTBAN=,ACORTUacjrwz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=FooNet :are supported by this server")
- (0.01 ":irc.example.net 005 tester NICKLEN=30 PREFIX=(qaohv)~&@%+ SAFELIST SILENCE=32 STATUSMSG=~&@%+ TOPICLEN=307 UHNAMES USERIP USERLEN=10 USERMODES=,,s,BIRcgikorw WHOX :are supported by this server")
- (0.01 ":irc.example.net 251 tester :There are 2 users and 0 invisible on 2 servers")
- (0.01 ":irc.example.net 253 tester 1 :unknown connections")
- (0.01 ":irc.example.net 254 tester 1 :channels formed")
- (0.00 ":irc.example.net 255 tester :I have 2 clients and 1 servers")
- (0.00 ":irc.example.net 265 tester :Current local users: 2 Max: 3")
- (0.00 ":irc.example.net 266 tester :Current global users: 2 Max: 3")
- (0.00 ":irc.example.net 375 tester :irc.example.net message of the day")
- (0.00 ":irc.example.net 372 tester : Have fun with the image!")
- (0.00 ":irc.example.net 376 tester :End of message of the day."))
-
-((mode 10 "MODE tester +i")
- (0.00 ":irc.example.net 501 tester x :is not a recognized user mode.")
- (0.00 ":NickServ!NickServ@services.int NOTICE tester :Welcome to FooNet, tester! Here on FooNet, we provide services to enable the registration of nicknames and channels! For details, type \2/msg NickServ help\2 and \2/msg ChanServ help\2.")
- (0.02 ":tester!user@10.0.2.100 MODE tester :+i"))
-
-((join 10 "JOIN #chan")
- (0.01 ":tester!user@10.0.2.100 JOIN :#chan"))
-
-((mode 10 "MODE #chan")
- (0.01 ":irc.example.net 353 tester = #chan :@alice bob tester")
- (0.01 ":irc.example.net 366 tester #chan :End of /NAMES list.")
- (0.00 ":alice!alice@0::1 PRIVMSG #chan :tester, welcome!")
- (0.02 ":bob!bob@0::1 PRIVMSG #chan :tester, welcome!")
- (0.02 ":irc.example.net 324 tester #chan :+nt")
- (0.01 ":irc.example.net 329 tester #chan :1672811954")
- (0.07 ":alice!alice@0::1 PRIVMSG #chan :bob: This afternoon, sir ? well, she shall be there.")
- (0.05 ":bob!bob@0::1 PRIVMSG #chan :alice: The hour that fools should ask."))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.04 "ERROR :Closing link: (user@10.0.2.100) [Quit: \2ERC\2]"))
-
-((drop 1 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 1 "USER tester 0 * :tester")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.00 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.8.0")
- (0.00 ":irc.foonet.org 003 tester :This server was created Mon, 12 Dec 2022 01:25:38 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.00 ":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 1 :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.01 ":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 10 "MODE tester +i")
- (0.00 ":irc.foonet.org 221 tester +i")
- (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((join 10 "JOIN #chan")
- (0.03 ":tester!~u@z5d6jyn8pwxge.irc JOIN #chan"))
-
-((~nick 10 "NICK dummy")
- (0.01 ":tester!~u@z5d6jyn8pwxge.irc NICK dummy"))
-
-((mode-1 10 "MODE #chan")
- (0.01 ":irc.foonet.org 353 tester = #chan :@alice bob foonet tester")
- (0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list")
- (0.03 ":irc.foonet.org 324 tester #chan +nt")
- (0.00 ":irc.foonet.org 329 tester #chan 1670808354")
- (0.00 ":bob!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :tester, welcome!")
- (0.00 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :tester, welcome!")
- (0.03 ":bob!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :alice: Forbear it therefore; give your cause to heaven.")
- (0.01 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :bob: Even at thy teat thou hadst thy tyranny."))
-
-((privmsg 10 "PRIVMSG alice :hi")
- (0.00 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG dummy :bye"))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.03 ":dummy!~u@z5d6jyn8pwxge.irc QUIT :Quit: \2ERC\2"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((cap-req 10 "CAP REQ :sasl"))
-((nick 1 "NICK tester"))
-((user 1 "USER tester 0 * :tester"))
-
-((auth-req 3.2 "AUTHENTICATE EXTERNAL")
- (0.0 ":irc.example.org CAP * ACK :sasl")
- (0.0 "AUTHENTICATE +"))
-
-((auth-noop 3.2 "AUTHENTICATE +")
- (0.0 ":irc.example.org 900 * * tester :You are now logged in as tester")
- (0.0 ":irc.example.org 903 * :Authentication successful"))
-
-((cap-end 3.2 "CAP END")
- (0.0 ":irc.example.org 001 tester :Welcome to the ExampleOrg IRC Network tester")
- (0.01 ":irc.example.org 002 tester :Your host is irc.example.org, running version oragono-2.6.1")
- (0.01 ":irc.example.org 003 tester :This server was created Sat, 17 Jul 2021 09:06:42 UTC")
- (0.01 ":irc.example.org 004 tester irc.example.org oragono-2.6.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.0 ":irc.example.org 005 tester AWAYLEN=200 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0.01 ":irc.example.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY :are supported by this server")
- (0.01 ":irc.example.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0.0 ":irc.example.org 251 tester :There are 1 users and 0 invisible on 1 server(s)")
- (0.0 ":irc.example.org 252 tester 0 :IRC Operators online")
- (0.0 ":irc.example.org 253 tester 0 :unregistered connections")
- (0.0 ":irc.example.org 254 tester 0 :channels formed")
- (0.0 ":irc.example.org 255 tester :I have 1 clients and 0 servers")
- (0.0 ":irc.example.org 265 tester 1 1 :Current local users 1, max 1")
- (0.21 ":irc.example.org 266 tester 1 1 :Current global users 1, max 1")
- (0.0 ":irc.example.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0.0 ":irc.example.org 221 tester +Zi")
- (0.0 ":irc.example.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."))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((cap-req 10 "CAP REQ :sasl"))
-((nick 10 "NICK tester"))
-((user 10 "USER tester 0 * :tester")
- (0.0 ":irc.foonet.org NOTICE * :*** Looking up your hostname...")
- (0.0 ":irc.foonet.org NOTICE * :*** Found your hostname")
- (0.0 ":irc.foonet.org CAP * ACK :cap-notify sasl"))
-
-((authenticate-plain 10 "AUTHENTICATE PLAIN")
- (0.0 ":irc.foonet.org AUTHENTICATE +"))
-
-((authenticate-gimme 10 "AUTHENTICATE AHRlc3RlcgB3cm9uZw==")
- (0.0 ":irc.foonet.org 900 * * tester :You are now logged in as tester")
- (0.0 ":irc.foonet.org 904 * :SASL authentication failed: Invalid account credentials"))
-
-((eof 10 EOF))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((cap-req 10 "CAP REQ :sasl"))
-((nick 10 "NICK emersion"))
-((user 10 "USER emersion 0 * :emersion")
- (0.0 ":irc.example.org NOTICE * :*** Looking up your hostname...")
- (0.0 ":irc.example.org NOTICE * :*** Found your hostname")
- (0.0 ":irc.example.org CAP * ACK :sasl"))
-
-((authenticate-plain 10 "AUTHENTICATE PLAIN")
- (0.0 ":irc.example.org AUTHENTICATE +"))
-((authenticate-gimme-1 10 "AUTHENTICATE AGVtZXJzaW9uAEVzdCB1dCBiZWF0YWUgb21uaXMgaXBzYW0uIFF1aXMgZnVnaWF0IGRlbGVuaXRpIHRvdGFtIHF1aS4gSXBzdW0gcXVhbSBhIGRvbG9ydW0gdGVtcG9yYSB2ZWxpdCBsYWJvcnVtIG9kaXQuIEV0IHNhZXBlIHZvbHVwdGF0ZSBzZWQgY3VtcXVlIHZlbC4gVm9sdXB0YXMgc2ludCBhYiBwYXJpYXR1ciBsaWJlcm8gdmVyaXRhdGlzIGNvcnJ1cHRpLiBWZXJvIGl1cmUgb21uaXMgdWxsYW0uIFZlcm8gYmVhdGFlIGRvbG9yZXMgZmFjZXJlIGZ1Z2lhdCBpcHNhbS4gRWEgZXN0IHBhcmlhdHVyIG1pbmltYSBub2Jpcw=="))
-((authenticate-gimme-2 10 "AUTHENTICATE +")
- (0.0 ":irc.example.org 900 * * emersion :You are now logged in as emersion")
- (0.0 ":irc.example.org 903 * :Authentication successful"))
-
-((cap-end 10 "CAP END")
- (0.0 ":irc.example.org 001 emersion :Welcome to the ExampleOrg IRC Network emersion")
- (0.0 ":irc.example.org 002 emersion :Your host is irc.example.org, running version oragono-2.6.1")
- (0.0 ":irc.example.org 003 emersion :This server was created Sat, 17 Jul 2021 09:06:42 UTC")
- (0.0 ":irc.example.org 004 emersion irc.example.org oragono-2.6.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.0 ":irc.example.org 005 emersion AWAYLEN=200 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0.0 ":irc.example.org 005 emersion MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY :are supported by this server")
- (0.0 ":irc.example.org 005 emersion draft/CHATHISTORY=100 :are supported by this server")
- (0.0 ":irc.example.org 251 emersion :There are 1 users and 0 invisible on 1 server(s)")
- (0.0 ":irc.example.org 252 emersion 0 :IRC Operators online")
- (0.0 ":irc.example.org 253 emersion 0 :unregistered connections")
- (0.0 ":irc.example.org 254 emersion 0 :channels formed")
- (0.0 ":irc.example.org 255 emersion :I have 1 clients and 0 servers")
- (0.0 ":irc.example.org 265 emersion 1 1 :Current local users 1, max 1")
- (0.0 ":irc.example.org 266 emersion 1 1 :Current global users 1, max 1")
- (0.0 ":irc.example.org 422 emersion :MOTD File is missing"))
-
-((mode-user 10 "MODE emersion +i")
- (0.0 ":irc.example.org 221 emersion +Zi")
- (0.0 ":irc.example.org NOTICE emersion :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((quit 5 "QUIT :\2ERC\2")
- (0 ":emersion!~u@yuvqisyu7m7qs.irc QUIT :Quit"))
-((drop 1 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((cap-req 10 "CAP REQ :sasl"))
-((nick 10 "NICK emersion"))
-((user 10 "USER emersion 0 * :emersion")
- (0.0 ":irc.example.org NOTICE * :*** Looking up your hostname...")
- (0.0 ":irc.example.org NOTICE * :*** Found your hostname")
- (0.0 ":irc.example.org CAP * ACK :sasl"))
-
-((authenticate-plain 10 "AUTHENTICATE PLAIN")
- (0.0 ":irc.example.org AUTHENTICATE +"))
-((authenticate-gimme-1 10 "AUTHENTICATE AGVtZXJzaW9uAEVzdCB1dCBiZWF0YWUgb21uaXMgaXBzYW0uIFF1aXMgZnVnaWF0IGRlbGVuaXRpIHRvdGFtIHF1aS4gSXBzdW0gcXVhbSBhIGRvbG9ydW0gdGVtcG9yYSB2ZWxpdCBsYWJvcnVtIG9kaXQuIEV0IHNhZXBlIHZvbHVwdGF0ZSBzZWQgY3VtcXVlIHZlbC4gVm9sdXB0YXMgc2ludCBhYiBwYXJpYXR1ciBsaWJlcm8gdmVyaXRhdGlzIGNvcnJ1cHRpLiBWZXJvIGl1cmUgb21uaXMgdWxsYW0uIFZlcm8gYmVhdGFlIGRvbG9yZXMgZmFjZXJlIGZ1Z2lhdCBpcHNhbS4gRWEgZXN0IHBhcmlhdHVyIG1pbmltYSBub2JpcyBz"))
-((authenticate-gimme-2 10 "AUTHENTICATE dW50IGF1dCB1dC4gRG9sb3JlcyB1dCBsYXVkYW50aXVtIG1haW9yZXMgdGVtcG9yaWJ1cyB2b2x1cHRhdGVzLiBSZWljaWVuZGlzIGltcGVkaXQgb21uaXMgZXQgdW5kZSBkZWxlY3R1cyBxdWFzIGFiLiBRdWFlIGVsaWdlbmRpIG5lY2Vzc2l0YXRpYnVzIGRvbG9yaWJ1cyBtb2xlc3RpYXMgdGVtcG9yYSBtYWduYW0gYXNzdW1lbmRhLg==")
- (0.0 ":irc.example.org 900 * * emersion :You are now logged in as emersion")
- (0.0 ":irc.example.org 903 * :Authentication successful"))
-
-((cap-end 10 "CAP END")
- (0.0 ":irc.example.org 001 emersion :Welcome to the ExampleOrg IRC Network emersion")
- (0.0 ":irc.example.org 002 emersion :Your host is irc.example.org, running version oragono-2.6.1")
- (0.0 ":irc.example.org 003 emersion :This server was created Sat, 17 Jul 2021 09:06:42 UTC")
- (0.0 ":irc.example.org 004 emersion irc.example.org oragono-2.6.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.0 ":irc.example.org 005 emersion AWAYLEN=200 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0.0 ":irc.example.org 005 emersion MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY :are supported by this server")
- (0.0 ":irc.example.org 005 emersion draft/CHATHISTORY=100 :are supported by this server")
- (0.0 ":irc.example.org 251 emersion :There are 1 users and 0 invisible on 1 server(s)")
- (0.0 ":irc.example.org 252 emersion 0 :IRC Operators online")
- (0.0 ":irc.example.org 253 emersion 0 :unregistered connections")
- (0.0 ":irc.example.org 254 emersion 0 :channels formed")
- (0.0 ":irc.example.org 255 emersion :I have 1 clients and 0 servers")
- (0.0 ":irc.example.org 265 emersion 1 1 :Current local users 1, max 1")
- (0.0 ":irc.example.org 266 emersion 1 1 :Current global users 1, max 1")
- (0.0 ":irc.example.org 422 emersion :MOTD File is missing"))
-
-((mode-user 10 "MODE emersion +i")
- (0.0 ":irc.example.org 221 emersion +Zi")
- (0.0 ":irc.example.org NOTICE emersion :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
-
-((quit 5 "QUIT :\2ERC\2")
- (0 ":emersion!~u@yuvqisyu7m7qs.irc QUIT :Quit"))
-((drop 1 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((cap-req 10 "CAP REQ :sasl"))
-((nick 1 "NICK tester"))
-((user 1 "USER tester 0 * :tester")
- (0.0 ":irc.example.org NOTICE * :*** Looking up your hostname...")
- (0.0 ":irc.example.org NOTICE * :*** Found your hostname")
- (0.0 ":irc.example.org CAP * ACK :sasl"))
-
-((authenticate-plain 3.2 "AUTHENTICATE PLAIN")
- (0.0 ":irc.example.org AUTHENTICATE +"))
-
-((authenticate-gimme 3.2 "AUTHENTICATE AHRlc3RlcgBwYXNzd29yZDEyMw==")
- (0.0 ":irc.example.org 900 * * tester :You are now logged in as tester")
- (0.0 ":irc.example.org 903 * :Authentication successful"))
-
-((cap-end 3.2 "CAP END")
- (0.0 ":irc.example.org 001 tester :Welcome to the ExampleOrg IRC Network tester")
- (0.01 ":irc.example.org 002 tester :Your host is irc.example.org, running version oragono-2.6.1")
- (0.01 ":irc.example.org 003 tester :This server was created Sat, 17 Jul 2021 09:06:42 UTC")
- (0.01 ":irc.example.org 004 tester irc.example.org oragono-2.6.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.0 ":irc.example.org 005 tester AWAYLEN=200 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0.01 ":irc.example.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY :are supported by this server")
- (0.01 ":irc.example.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0.0 ":irc.example.org 251 tester :There are 1 users and 0 invisible on 1 server(s)")
- (0.0 ":irc.example.org 252 tester 0 :IRC Operators online")
- (0.0 ":irc.example.org 253 tester 0 :unregistered connections")
- (0.0 ":irc.example.org 254 tester 0 :channels formed")
- (0.0 ":irc.example.org 255 tester :I have 1 clients and 0 servers")
- (0.0 ":irc.example.org 265 tester 1 1 :Current local users 1, max 1")
- (0.21 ":irc.example.org 266 tester 1 1 :Current global users 1, max 1")
- (0.0 ":irc.example.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0.0 ":irc.example.org 221 tester +Zi")
- (0.0 ":irc.example.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."))
-
-((quit 5 "QUIT :\2ERC\2")
- (0 ":tester!~u@yuvqisyu7m7qs.irc QUIT :Quit"))
-((drop 1 DROP))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-((cap-req 5.2 "CAP REQ :sasl"))
-((nick 10 "NICK jilles"))
-((user 10 "USER user 0 * :jilles")
- (0 "NOTICE AUTH :*** Processing connection to jaguar.test")
- (0 "NOTICE AUTH :*** Looking up your hostname...")
- (0 "NOTICE AUTH :*** Checking Ident")
- (0 "NOTICE AUTH :*** No Ident response")
- (0 "NOTICE AUTH :*** Found your hostname")
- (0 ":jaguar.test CAP jilles ACK :sasl"))
-
-((auth-init 10 "AUTHENTICATE SCRAM-SHA-1")
- (0 "AUTHENTICATE +"))
-
-((auth-challenge 10 "AUTHENTICATE bixhPWppbGxlcyxuPWppbGxlcyxyPWM1UnFMQ1p5MEw0ZkdrS0FaMGh1akZCcw==")
- (0 "AUTHENTICATE cj1jNVJxTENaeTBMNGZHa0tBWjBodWpGQnNYUW9LY2l2cUN3OWlEWlBTcGIscz01bUpPNmQ0cmpDbnNCVTFYLGk9NDA5Ng=="))
-
-((auth-final 10 "AUTHENTICATE Yz1iaXhoUFdwcGJHeGxjeXc9LHI9YzVScUxDWnkwTDRmR2tLQVowaHVqRkJzWFFvS2NpdnFDdzlpRFpQU3BiLHA9T1ZVaGdQdTh3RW0yY0RvVkxmYUh6VlVZUFdVPQ==")
- (0 "AUTHENTICATE dj1aV1IyM2M5TUppcjBaZ2ZHZjVqRXRMT242Tmc9"))
-
-((auth-done 10 "AUTHENTICATE +")
- (0 ":jaguar.test 900 jilles jilles!jilles@localhost.stack.nl jilles :You are now logged in as jilles")
- (0 ":jaguar.test 903 jilles :SASL authentication successful"))
-
-((cap-end 10.2 "CAP END")
- (0 ":jaguar.test 001 jilles :Welcome to the jaguar IRC Network jilles!~jilles@127.0.0.1")
- (0 ":jaguar.test 002 jilles :Your host is jaguar.test, running version InspIRCd-3")
- (0 ":jaguar.test 003 jilles :This server was created 09:44:05 Dec 24 2020")
- (0 ":jaguar.test 004 jilles jaguar.test InspIRCd-3 BILRSWcghiorswz ABEFHIJLMNOQRSTXYabcefghijklmnopqrstuvz :BEFHIJLXYabefghjkloqv")
- (0 ":jaguar.test 005 jilles ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=rfc1459 CHANLIMIT=#:120 CHANMODES=IXbeg,k,BEFHJLfjl,AMNOQRSTcimnprstuz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server")
- (0 ":jaguar.test 005 jilles EXTBAN=,ANOQRSTUacmnprz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=jaguar :are supported by this server")
- (0 ":jaguar.test 005 jilles NICKLEN=31 PREFIX=(Yqaohv)!~&@%+ REMOVE SAFELIST SECURELIST=60 SILENCE=32 STATUSMSG=!~&@%+ TOPICLEN=307 UHNAMES USERIP USERLEN=11 USERMODES=,,s,BILRSWcghiorwz WATCH=30 :are supported by this server")
- (0 ":jaguar.test 005 jilles :are supported by this server")
- (0 ":jaguar.test 251 jilles :There are 740 users and 108 invisible on 11 servers")
- (0 ":jaguar.test 252 jilles 10 :operator(s) online")
- (0 ":jaguar.test 254 jilles 373 :channels formed")
- (0 ":jaguar.test 255 jilles :I have 28 clients and 1 servers")
- (0 ":jaguar.test 265 jilles :Current local users: 28 Max: 29")
- (0 ":jaguar.test 266 jilles :Current global users: 848 Max: 879")
- (0 ":jaguar.test 375 jilles :jaguar.test message of the day")
- (0 ":jaguar.test 372 jilles : ~~ some message of the day ~~")
- (0 ":jaguar.test 372 jilles : ~~ or rkpryyrag gb rnpu bgure ~~")
- (0 ":jaguar.test 376 jilles :End of message of the day."))
-
-((mode-user 10 "MODE jilles +i")
- (0 ":jilles!~jilles@127.0.0.1 MODE jilles :+ri")
- (0 ":jaguar.test 306 jilles :You have been marked as being away"))
+++ /dev/null
-;;; -*- mode: lisp-data -*-
-((cap-req 5.2 "CAP REQ :sasl"))
-((nick 10 "NICK jilles"))
-((user 10 "USER user 0 * :jilles")
- (0 "NOTICE AUTH :*** Processing connection to jaguar.test")
- (0 "NOTICE AUTH :*** Looking up your hostname...")
- (0 "NOTICE AUTH :*** Checking Ident")
- (0 "NOTICE AUTH :*** No Ident response")
- (0 "NOTICE AUTH :*** Found your hostname")
- (0 ":jaguar.test CAP jilles ACK :sasl"))
-
-((auth-init 10 "AUTHENTICATE SCRAM-SHA-256")
- (0 "AUTHENTICATE +"))
-
-((auth-challenge 10 "AUTHENTICATE biwsbj1qaWxsZXMscj1jNVJxTENaeTBMNGZHa0tBWjBodWpGQnM=")
- (0 "AUTHENTICATE cj1jNVJxTENaeTBMNGZHa0tBWjBodWpGQnNkNDA2N2YwYWZkYjU0YzNkYmQ0ZmU2NDViODRjYWUzNyxzPVpUZzFNbUUxWW1GaFpHSTFORGN5TWprM056WXdabVJqWkRNM1kySTFPVE09LGk9NDA5Ng=="))
-
-((auth-final 10 "AUTHENTICATE Yz1iaXdzLHI9YzVScUxDWnkwTDRmR2tLQVowaHVqRkJzZDQwNjdmMGFmZGI1NGMzZGJkNGZlNjQ1Yjg0Y2FlMzcscD1MUDRzakpyakpLcDVxVHNBUnlaQ3BwWHBLTHU0Rk1NMjg0aE5FU1B2R2hJPQ==")
- (0 "AUTHENTICATE dj04NDdXWGZubVJlR3lFMXFscTFBbmQ2UjRiUEJOUk9UWjdFTVMvUXJKdFVNPQ=="))
-
-((auth-done 10 "AUTHENTICATE +")
- (0 ":jaguar.test 900 jilles jilles!jilles@localhost.stack.nl jilles :You are now logged in as jilles")
- (0 ":jaguar.test 903 jilles :SASL authentication successful"))
-
-((cap-end 10.2 "CAP END")
- (0 ":jaguar.test 001 jilles :Welcome to the jaguar IRC Network jilles!~jilles@127.0.0.1")
- (0 ":jaguar.test 002 jilles :Your host is jaguar.test, running version InspIRCd-3")
- (0 ":jaguar.test 003 jilles :This server was created 09:44:05 Dec 24 2020")
- (0 ":jaguar.test 004 jilles jaguar.test InspIRCd-3 BILRSWcghiorswz ABEFHIJLMNOQRSTXYabcefghijklmnopqrstuvz :BEFHIJLXYabefghjkloqv")
- (0 ":jaguar.test 005 jilles ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=rfc1459 CHANLIMIT=#:120 CHANMODES=IXbeg,k,BEFHJLfjl,AMNOQRSTcimnprstuz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server")
- (0 ":jaguar.test 005 jilles EXTBAN=,ANOQRSTUacmnprz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=jaguar :are supported by this server")
- (0 ":jaguar.test 005 jilles NICKLEN=31 PREFIX=(Yqaohv)!~&@%+ REMOVE SAFELIST SECURELIST=60 SILENCE=32 STATUSMSG=!~&@%+ TOPICLEN=307 UHNAMES USERIP USERLEN=11 USERMODES=,,s,BILRSWcghiorwz WATCH=30 :are supported by this server")
- (0 ":jaguar.test 005 jilles :are supported by this server")
- (0 ":jaguar.test 251 jilles :There are 740 users and 108 invisible on 11 servers")
- (0 ":jaguar.test 252 jilles 10 :operator(s) online")
- (0 ":jaguar.test 254 jilles 373 :channels formed")
- (0 ":jaguar.test 255 jilles :I have 28 clients and 1 servers")
- (0 ":jaguar.test 265 jilles :Current local users: 28 Max: 29")
- (0 ":jaguar.test 266 jilles :Current global users: 848 Max: 879")
- (0 ":jaguar.test 375 jilles :jaguar.test message of the day")
- (0 ":jaguar.test 372 jilles : ~~ some message of the day ~~")
- (0 ":jaguar.test 372 jilles : ~~ or rkpryyrag gb rnpu bgure ~~")
- (0 ":jaguar.test 376 jilles :End of message of the day."))
-
-((mode-user 10 "MODE jilles +i")
- (0 ":jilles!~jilles@127.0.0.1 MODE jilles :+ri")
- (0 ":jaguar.test 306 jilles :You have been marked as being away"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 10 "USER user 0 * :tester")
- (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
- (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
- (0.01 ":irc.foonet.org 003 tester :This server was created Mon, 21 Aug 2023 06:18:36 UTC")
- (0.02 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
- (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
- (0.01 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)")
- (0.01 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0.01 ":irc.foonet.org 253 tester 0 :unregistered connections")
- (0.01 ":irc.foonet.org 254 tester 2 :channels formed")
- (0.01 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers")
- (0.01 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4")
- (0.01 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
- (0.01 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode 10 "MODE tester +i")
- (0.00 ":irc.foonet.org 221 tester +i")
- (0.01 ":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"))
-
-((privmsg-help-register 10 "PRIVMSG NickServ :help register")
- (0.05 ":NickServ!NickServ@localhost NOTICE tester :*** \2NickServ HELP\2 ***")
- (0.02 ":NickServ!NickServ@localhost NOTICE tester :Syntax: \2REGISTER <password> [email]\2")
- (0.02 ":NickServ!NickServ@localhost NOTICE tester :")
- (0.01 ":NickServ!NickServ@localhost NOTICE tester :REGISTER lets you register your current nickname as a user account. If the")
- (0.01 ":NickServ!NickServ@localhost NOTICE tester :server allows anonymous registration, you can omit the e-mail address.")
- (0.01 ":NickServ!NickServ@localhost NOTICE tester :")
- (0.01 ":NickServ!NickServ@localhost NOTICE tester :If you are currently logged in with a TLS client certificate and wish to use")
- (0.02 ":NickServ!NickServ@localhost NOTICE tester :it instead of a password to log in, send * as the password.")
- (0.02 ":NickServ!NickServ@localhost NOTICE tester :*** \2End of NickServ HELP\2 ***"))
-
-((privmsg-help-identify 20 "PRIVMSG NickServ :help identify")
- (0.06 ":NickServ!NickServ@localhost NOTICE tester :*** \2NickServ HELP\2 ***")
- (0.02 ":NickServ!NickServ@localhost NOTICE tester :Syntax: \2IDENTIFY <username> [password]\2")
- (0.02 ":NickServ!NickServ@localhost NOTICE tester :")
- (0.02 ":NickServ!NickServ@localhost NOTICE tester :IDENTIFY lets you login to the given username using either password auth, or")
- (0.02 ":NickServ!NickServ@localhost NOTICE tester :certfp (your client certificate) if a password is not given.")
- (0.02 ":NickServ!NickServ@localhost NOTICE tester :*** \2End of NickServ HELP\2 ***"))
-
-((quit 10 "QUIT :\2ERC\2 ")
- (0.07 ":tester!~u@26axz8nh8zaag.irc QUIT :Quit: \2ERC\2")
- (0.02 "ERROR :Quit: \2ERC\2"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 5 "USER user 0 * :tester")
- (0.26 ":zirconium.libera.chat NOTICE * :*** Checking Ident")
- (0.01 ":zirconium.libera.chat NOTICE * :*** Looking up your hostname...")
- (0.01 ":zirconium.libera.chat NOTICE * :*** No Ident response")
- (0.02 ":zirconium.libera.chat NOTICE * :*** Found your hostname: static-198-54-131-100.cust.tzulo.com")
- (0.02 ":zirconium.libera.chat 001 tester :Welcome to the Libera.Chat Internet Relay Chat Network tester")
- (0.01 ":zirconium.libera.chat 002 tester :Your host is zirconium.libera.chat[46.16.175.175/6697], running version solanum-1.0-dev")
- (0.03 ":zirconium.libera.chat 003 tester :This server was created Wed Jun 9 2021 at 01:38:28 UTC")
- (0.02 ":zirconium.libera.chat 004 tester zirconium.libera.chat solanum-1.0-dev DGQRSZaghilopsuwz CFILMPQSbcefgijklmnopqrstuvz bkloveqjfI")
- (0.00 ":zirconium.libera.chat 005 tester ETRACE WHOX FNC MONITOR=100 SAFELIST ELIST=CTU CALLERID=g KNOCK CHANTYPES=# EXCEPTS INVEX CHANMODES=eIbq,k,flj,CFLMPQScgimnprstuz :are supported by this server")
- (0.03 ":zirconium.libera.chat 005 tester CHANLIMIT=#:250 PREFIX=(ov)@+ MAXLIST=bqeI:100 MODES=4 NETWORK=Libera.Chat STATUSMSG=@+ CASEMAPPING=rfc1459 NICKLEN=16 MAXNICKLEN=16 CHANNELLEN=50 TOPICLEN=390 DEAF=D :are supported by this server")
- (0.02 ":zirconium.libera.chat 005 tester TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,MONITOR: EXTBAN=$,ajrxz CLIENTVER=3.0 :are supported by this server")
- (0.02 ":zirconium.libera.chat 251 tester :There are 68 users and 37640 invisible on 25 servers")
- (0.00 ":zirconium.libera.chat 252 tester 36 :IRC Operators online")
- (0.01 ":zirconium.libera.chat 253 tester 5 :unknown connection(s)")
- (0.00 ":zirconium.libera.chat 254 tester 19341 :channels formed")
- (0.01 ":zirconium.libera.chat 255 tester :I have 3321 clients and 1 servers")
- (0.01 ":zirconium.libera.chat 265 tester 3321 4289 :Current local users 3321, max 4289")
- (0.00 ":zirconium.libera.chat 266 tester 37708 38929 :Current global users 37708, max 38929")
- (0.01 ":zirconium.libera.chat 250 tester :Highest connection count: 4290 (4289 clients) (38580 connections received)")
- (0.21 ":zirconium.libera.chat 375 tester :- zirconium.libera.chat Message of the Day - ")
- (0.00 ":zirconium.libera.chat 372 tester :- This server provided by Seeweb <https://www.seeweb.it/>")
- (0.01 ":zirconium.libera.chat 372 tester :- Welcome to Libera Chat, the IRC network for")
- (0.01 ":zirconium.libera.chat 372 tester :- free & open-source software and peer directed projects.")
- (0.00 ":zirconium.libera.chat 372 tester :- ")
- (0.00 ":zirconium.libera.chat 372 tester :- Use of Libera Chat is governed by our network policies.")
- (0.00 ":zirconium.libera.chat 372 tester :- ")
- (0.01 ":zirconium.libera.chat 372 tester :- Please visit us in #libera for questions and support.")
- (0.01 ":zirconium.libera.chat 372 tester :- ")
- (0.01 ":zirconium.libera.chat 372 tester :- Website and documentation: https://libera.chat")
- (0.01 ":zirconium.libera.chat 372 tester :- Webchat: https://web.libera.chat")
- (0.01 ":zirconium.libera.chat 372 tester :- Network policies: https://libera.chat/policies")
- (0.01 ":zirconium.libera.chat 372 tester :- Email: support@libera.chat")
- (0.00 ":zirconium.libera.chat 376 tester :End of /MOTD command."))
-
-((mode-user 10 "MODE tester +i")
- (0.02 ":tester MODE tester :+Zi")
- (0.02 ":NickServ!NickServ@services.libera.chat NOTICE tester :This nickname is registered. Please choose a different nickname, or identify via \2/msg NickServ IDENTIFY tester <password>\2"))
-
-((privmsg 10 "PRIVMSG NickServ :IDENTIFY changeme")
- (0.96 ":NickServ!NickServ@services.libera.chat NOTICE tester :You are now identified for \2tester\2.")
- (0.25 ":NickServ!NickServ@services.libera.chat NOTICE tester :Last login from: \2~tester@school.edu/tester\2 on Jun 18 01:15:56 2021 +0000."))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.19 ":tester!~user@static-198-54-131-100.cust.tzulo.com QUIT :Client Quit"))
-
-((linger 1 LINGER))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK tester"))
-((user 5 "USER tester 0 * :tester")
- (0.00 ":irc.foonet.net NOTICE * :*** Looking up your hostname...")
- (0.04 ":irc.foonet.net NOTICE tester :*** Could not resolve your hostname: Domain not found; using your IP address (10.0.2.100) instead.")
- (0.06 ":irc.foonet.net 001 tester :Welcome to the FooNet IRC Network tester!tester@10.0.2.100")
- (0.01 ":irc.foonet.net 002 tester :Your host is irc.foonet.net, running version InspIRCd-3")
- (0.01 ":irc.foonet.net 003 tester :This server was created 08:32:24 Dec 05 2022")
- (0.01 ":irc.foonet.net 004 tester irc.foonet.net InspIRCd-3 BIRcgikorsw ACHIKMORTXabcefghijklmnopqrstvz :HIXabefghjkloqv")
- (0.01 ":irc.foonet.net 005 tester ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=ascii CHANLIMIT=#:20 CHANMODES=IXbeg,k,Hfjl,ACKMORTcimnprstz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server")
- (0.01 ":irc.foonet.net 005 tester EXTBAN=,ACORTUacjrwz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=FooNet :are supported by this server")
- (0.01 ":irc.foonet.net 005 tester NICKLEN=30 PREFIX=(qaohv)~&@%+ SAFELIST SILENCE=32 STATUSMSG=~&@%+ TOPICLEN=307 UHNAMES USERIP USERLEN=10 USERMODES=,,s,BIRcgikorw WHOX :are supported by this server")
- (0.01 ":irc.foonet.net 251 tester :There are 2 users and 0 invisible on 2 servers")
- (0.00 ":irc.foonet.net 253 tester 1 :unknown connections")
- (0.00 ":irc.foonet.net 254 tester 1 :channels formed")
- (0.00 ":irc.foonet.net 255 tester :I have 2 clients and 1 servers")
- (0.00 ":irc.foonet.net 265 tester :Current local users: 2 Max: 3")
- (0.00 ":irc.foonet.net 266 tester :Current global users: 2 Max: 3")
- (0.00 ":irc.foonet.net 375 tester :irc.foonet.net message of the day")
- (0.00 ":irc.foonet.net 372 tester :Have fun!")
- (0.00 ":irc.foonet.net 376 tester :End of message of the day."))
-
-((mode-a 10 "MODE tester +i")
- (0.00 ":irc.foonet.net 501 tester x :is not a recognized user mode.")
- (0.04 ":tester!tester@10.0.2.100 MODE tester :+i")
- (0.00 ":NickServ!NickServ@services.int NOTICE tester :This nickname is registered. Please choose a different nickname, or identify via \2/msg NickServ identify <password>\2."))
-
-((~privmsg 10 "PRIVMSG NickServ :IDENTIFY changeme")
- (0.00 ":NickServ!NickServ@services.int NOTICE tester :You are now identified for \2tester\2.")
- (0.01 ":irc.foonet.net 900 tester tester!tester@10.0.2.100 tester :You are now logged in as tester"))
-
-((~join 10 "JOIN #chan")
- (0.00 ":tester!tester@10.0.2.100 JOIN :#chan")
- (0.04 ":irc.foonet.net 353 tester = #chan :@alice bob tester")
- (0.00 ":irc.foonet.net 366 tester #chan :End of /NAMES list."))
-
-((mode-b 10 "MODE #chan")
- (0.03 ":irc.foonet.net 324 tester #chan :+nt")
- (0.01 ":irc.foonet.net 329 tester #chan :1670229160")
- (0.00 ":alice!alice@0::1 PRIVMSG #chan :tester, welcome!")
- (0.00 ":bob!bob@0::1 PRIVMSG #chan :tester, welcome!")
- (0.05 ":alice!alice@0::1 PRIVMSG #chan :bob: Thou art the cap of all the fools alive.")
- (0.06 ":bob!bob@0::1 PRIVMSG #chan :alice: What, man! 'tis a night of revels; the gallants desire it."))
-
-((quit 10 "QUIT :\2ERC\2")
- (0.1 ":tester!tester@10.0.2.100 QUIT :Client Quit"))
-
-((drop 1 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
- (0.26 ":zirconium.libera.chat NOTICE * :*** Checking Ident")
- (0.01 ":zirconium.libera.chat NOTICE * :*** Looking up your hostname...")
- (0.01 ":zirconium.libera.chat NOTICE * :*** No Ident response")
- (0.02 ":zirconium.libera.chat NOTICE * :*** Found your hostname: static-198-54-131-100.cust.tzulo.com")
- (0.02 ":zirconium.libera.chat 001 tester :Welcome to the Libera.Chat Internet Relay Chat Network tester")
- (0.01 ":zirconium.libera.chat 002 tester :Your host is zirconium.libera.chat[46.16.175.175/6697], running version solanum-1.0-dev")
- (0.03 ":zirconium.libera.chat 003 tester :This server was created Wed Jun 9 2021 at 01:38:28 UTC")
- (0.02 ":zirconium.libera.chat 004 tester zirconium.libera.chat solanum-1.0-dev DGQRSZaghilopsuwz CFILMPQSbcefgijklmnopqrstuvz bkloveqjfI")
- (0.00 ":zirconium.libera.chat 005 tester ETRACE WHOX FNC MONITOR=100 SAFELIST ELIST=CTU CALLERID=g KNOCK CHANTYPES=# EXCEPTS INVEX CHANMODES=eIbq,k,flj,CFLMPQScgimnprstuz :are supported by this server")
- (0.03 ":zirconium.libera.chat 005 tester CHANLIMIT=#:250 PREFIX=(ov)@+ MAXLIST=bqeI:100 MODES=4 NETWORK=Libera.Chat STATUSMSG=@+ CASEMAPPING=rfc1459 NICKLEN=16 MAXNICKLEN=16 CHANNELLEN=50 TOPICLEN=390 DEAF=D :are supported by this server")
- (0.02 ":zirconium.libera.chat 005 tester TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,MONITOR: EXTBAN=$,ajrxz CLIENTVER=3.0 :are supported by this server")
- (0.02 ":zirconium.libera.chat 251 tester :There are 68 users and 37640 invisible on 25 servers")
- (0.00 ":zirconium.libera.chat 252 tester 36 :IRC Operators online")
- (0.01 ":zirconium.libera.chat 253 tester 5 :unknown connection(s)")
- (0.00 ":zirconium.libera.chat 254 tester 19341 :channels formed")
- (0.01 ":zirconium.libera.chat 255 tester :I have 3321 clients and 1 servers")
- (0.01 ":zirconium.libera.chat 265 tester 3321 4289 :Current local users 3321, max 4289")
- (0.00 ":zirconium.libera.chat 266 tester 37708 38929 :Current global users 37708, max 38929")
- (0.01 ":zirconium.libera.chat 250 tester :Highest connection count: 4290 (4289 clients) (38580 connections received)")
- (0.21 ":zirconium.libera.chat 375 tester :- zirconium.libera.chat Message of the Day - ")
- (0.00 ":zirconium.libera.chat 372 tester :- This server provided by Seeweb <https://www.seeweb.it/>")
- (0.01 ":zirconium.libera.chat 372 tester :- Welcome to Libera Chat, the IRC network for")
- (0.01 ":zirconium.libera.chat 372 tester :- free & open-source software and peer directed projects.")
- (0.00 ":zirconium.libera.chat 372 tester :- ")
- (0.00 ":zirconium.libera.chat 372 tester :- Use of Libera Chat is governed by our network policies.")
- (0.00 ":zirconium.libera.chat 372 tester :- ")
- (0.01 ":zirconium.libera.chat 372 tester :- Please visit us in #libera for questions and support.")
- (0.01 ":zirconium.libera.chat 372 tester :- ")
- (0.01 ":zirconium.libera.chat 372 tester :- Website and documentation: https://libera.chat")
- (0.01 ":zirconium.libera.chat 372 tester :- Webchat: https://web.libera.chat")
- (0.01 ":zirconium.libera.chat 372 tester :- Network policies: https://libera.chat/policies")
- (0.01 ":zirconium.libera.chat 372 tester :- Email: support@libera.chat")
- (0.00 ":zirconium.libera.chat 376 tester :End of /MOTD command."))
-
-((mode-user 1.2 "MODE tester +i")
- (0.02 ":tester MODE tester :+Zi")
- (0.02 ":NickServ!NickServ@services.libera.chat NOTICE tester :This nickname is registered. Please choose a different nickname, or identify via \2/msg NickServ IDENTIFY tester <password>\2"))
-
-((privmsg 2 "PRIVMSG NickServ :IDENTIFY changeme")
- (0.96 ":NickServ!NickServ@services.libera.chat NOTICE tester :You are now identified for \2tester\2.")
- (0.25 ":NickServ!NickServ@services.libera.chat NOTICE tester :Last login from: \2~tester@school.edu/tester\2 on Jun 18 01:15:56 2021 +0000."))
-
-((quit 5 "QUIT :\2ERC\2")
- (0.19 ":tester!~user@static-198-54-131-100.cust.tzulo.com QUIT :Client Quit"))
-
-((linger 1 LINGER))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((cap 10 "CAP REQ :sasl"))
-((nick 10 "NICK tester"))
-((user 10 "USER tester 0 * :tester"))
-
-((authenticate 10 "AUTHENTICATE PLAIN")
- (0.04 ":tantalum.libera.chat NOTICE * :*** Checking Ident")
- (0.01 ":tantalum.libera.chat NOTICE * :*** Looking up your hostname...")
- (0.01 ":tantalum.libera.chat NOTICE * :*** Couldn't look up your hostname")
- (0.06 ":tantalum.libera.chat NOTICE * :*** No Ident response")
- (0.02 ":tantalum.libera.chat CAP * ACK :sasl")
- (0.03 ":tantalum.libera.chat 433 * tester :Nickname is already in use."))
-
-((nick 10 "NICK tester`")
- (0.03 "AUTHENTICATE +"))
-
-((authenticate 10 "AUTHENTICATE AHRlc3RlcgBjaGFuZ2VtZQ==")
- (0.06 ":tantalum.libera.chat 900 tester` tester`!tester@127.0.0.1 tester :You are now logged in as tester")
- (0.02 ":tantalum.libera.chat 903 tester` :SASL authentication successful"))
-
-((cap 10 "CAP END")
- (0.02 ":tantalum.libera.chat 001 tester` :Welcome to the Libera.Chat Internet Relay Chat Network tester`")
- (0.02 ":tantalum.libera.chat 002 tester` :Your host is tantalum.libera.chat[93.158.237.2/6697], running version solanum-1.0-dev")
- (0.02 ":tantalum.libera.chat 003 tester` :This server was created Mon Feb 13 2023 at 12:05:04 UTC")
- (0.01 ":tantalum.libera.chat 004 tester` tantalum.libera.chat solanum-1.0-dev DGMQRSZaghilopsuwz CFILMPQRSTbcefgijklmnopqrstuvz bkloveqjfI")
- (0.01 ":tantalum.libera.chat 005 tester` WHOX MONITOR=100 SAFELIST ELIST=CMNTU ETRACE FNC CALLERID=g KNOCK CHANTYPES=# EXCEPTS INVEX CHANMODES=eIbq,k,flj,CFLMPQRSTcgimnprstuz :are supported by this server")
- (0.01 ":tantalum.libera.chat 005 tester` CHANLIMIT=#:250 PREFIX=(ov)@+ MAXLIST=bqeI:100 MODES=4 NETWORK=Libera.Chat STATUSMSG=@+ CASEMAPPING=rfc1459 NICKLEN=16 MAXNICKLEN=16 CHANNELLEN=50 TOPICLEN=390 DEAF=D :are supported by this server")
- (0.03 ":tantalum.libera.chat 005 tester` TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,MONITOR: EXTBAN=$,ajrxz :are supported by this server")
- (0.01 ":tantalum.libera.chat 251 tester` :There are 70 users and 42977 invisible on 28 servers")
- (0.00 ":tantalum.libera.chat 252 tester` 38 :IRC Operators online")
- (0.00 ":tantalum.libera.chat 253 tester` 87 :unknown connection(s)")
- (0.00 ":tantalum.libera.chat 254 tester` 22908 :channels formed")
- (0.00 ":tantalum.libera.chat 255 tester` :I have 2507 clients and 1 servers")
- (0.00 ":tantalum.libera.chat 265 tester` 2507 3232 :Current local users 2507, max 3232")
- (0.00 ":tantalum.libera.chat 266 tester` 43047 51777 :Current global users 43047, max 51777")
- (0.00 ":tantalum.libera.chat 250 tester` :Highest connection count: 3233 (3232 clients) (284887 connections received)")
- (0.03 ":tantalum.libera.chat 375 tester` :- tantalum.libera.chat Message of the Day - ")
- (0.00 ":tantalum.libera.chat 372 tester` :- This server provided by Hyperfilter (https://hyperfilter.com)")
- (0.00 ":tantalum.libera.chat 372 tester` :- Email: support@libera.chat")
- (0.02 ":tantalum.libera.chat 376 tester` :End of /MOTD command."))
-
-((mode 10 "MODE tester` +i")
- (0.01 ":tester` MODE tester` :+Ziw")
- (0.02 ":SaslServ!SaslServ@services.libera.chat NOTICE tester` :Last login from: \2~tester@127.0.0.1\2 on Apr 07 01:36:25 2023 +0000."))
-
-((nick 10 "NICK tester")
- (0.02 ":tester`!~tester@127.0.0.1 NICK :tester"))
-
-((join 10 "JOIN #test")
- (0.02 ":tester!~tester@127.0.0.1 JOIN #test")
- (0.02 ":tantalum.libera.chat 353 tester = #test :tester zbyqbepbqre7 pusevgfpu Thrfg2187 zngbeb qnexNssvavgl wrebzr- rqpentt Ilehf grfg2 AvtugZbaxrl pevfgvvbna xrivap_ fnvybePng shohxv gxan arrqyr avpx16 NeanhqW_kzcc jvyyr wrnaogeq Wnarg cnefavc0 Xbentt RcvpArb flfqrs wfgbxre hafcrag__ Lbevpx_")
- (0.02 ":tantalum.libera.chat 366 tester #test :End of /NAMES list."))
-
-((mode 10 "MODE #test")
- (0.02 ":tantalum.libera.chat 324 tester #test +nt")
- (0.02 ":tantalum.libera.chat 329 tester #test 1621432263"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((cap 10 "CAP REQ :sasl"))
-((nick 10 "NICK tester"))
-((user 10 "USER tester 0 * :tester"))
-
-((authenticate 10 "AUTHENTICATE PLAIN")
- (0.02 ":cadmium.libera.chat NOTICE * :*** Checking Ident")
- (0.01 ":cadmium.libera.chat NOTICE * :*** Looking up your hostname...")
- (0.01 ":cadmium.libera.chat NOTICE * :*** Couldn't look up your hostname")
- (0.06 ":cadmium.libera.chat NOTICE * :*** No Ident response")
- (0.09 ":cadmium.libera.chat CAP * ACK :sasl")
- (0.01 "AUTHENTICATE +"))
-
-((authenticate 10 "AUTHENTICATE AHRlc3RlcgBjaGFuZ2VtZQ==")
- (0.03 ":cadmium.libera.chat 900 tester tester!tester@127.0.0.1 tester :You are now logged in as tester")
- (0.01 ":cadmium.libera.chat 903 tester :SASL authentication successful"))
-
-((cap 10 "CAP END")
- (0.03 ":cadmium.libera.chat 001 tester :Welcome to the Libera.Chat Internet Relay Chat Network tester")
- (0.02 ":cadmium.libera.chat 002 tester :Your host is cadmium.libera.chat[103.196.37.95/6697], running version solanum-1.0-dev")
- (0.01 ":cadmium.libera.chat 003 tester :This server was created Wed Jan 25 2023 at 10:22:45 UTC")
- (0.01 ":cadmium.libera.chat 004 tester cadmium.libera.chat solanum-1.0-dev DGMQRSZaghilopsuwz CFILMPQRSTbcefgijklmnopqrstuvz bkloveqjfI")
- (0.00 ":cadmium.libera.chat 005 tester CALLERID=g WHOX ETRACE FNC SAFELIST ELIST=CMNTU KNOCK MONITOR=100 CHANTYPES=# EXCEPTS INVEX CHANMODES=eIbq,k,flj,CFLMPQRSTcgimnprstuz :are supported by this server")
- (0.01 ":cadmium.libera.chat 005 tester CHANLIMIT=#:250 PREFIX=(ov)@+ MAXLIST=bqeI:100 MODES=4 NETWORK=Libera.Chat STATUSMSG=@+ CASEMAPPING=rfc1459 NICKLEN=16 MAXNICKLEN=16 CHANNELLEN=50 TOPICLEN=390 DEAF=D :are supported by this server")
- (0.01 ":cadmium.libera.chat 005 tester TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,MONITOR: EXTBAN=$,ajrxz :are supported by this server")
- (0.01 ":cadmium.libera.chat 251 tester :There are 70 users and 42996 invisible on 28 servers")
- (0.02 ":cadmium.libera.chat 252 tester 38 :IRC Operators online")
- (0.01 ":cadmium.libera.chat 253 tester 57 :unknown connection(s)")
- (0.01 ":cadmium.libera.chat 254 tester 22912 :channels formed")
- (0.01 ":cadmium.libera.chat 255 tester :I have 2499 clients and 1 servers")
- (0.01 ":cadmium.libera.chat 265 tester 2499 4187 :Current local users 2499, max 4187")
- (0.01 ":cadmium.libera.chat 266 tester 43066 51827 :Current global users 43066, max 51827")
- (0.01 ":cadmium.libera.chat 250 tester :Highest connection count: 4188 (4187 clients) (319420 connections received)")
- (0.01 ":cadmium.libera.chat 375 tester :- cadmium.libera.chat Message of the Day - ")
- (0.01 ":cadmium.libera.chat 372 tester :- This server kindly provided by Mach Dilemma (www.m-d.net)")
- (0.01 ":cadmium.libera.chat 372 tester :- Welcome to Libera Chat, the IRC network for")
- (0.00 ":cadmium.libera.chat 372 tester :- Email: support@libera.chat")
- (0.00 ":cadmium.libera.chat 376 tester :End of /MOTD command.")
- (0.00 ":tester MODE tester :+Ziw")
- (0.02 ":SaslServ!SaslServ@services.libera.chat NOTICE tester :Last login from: \2~tester@127.0.0.1\2 on Apr 07 01:02:11 2023 +0000."))
-
-((mode 10 "MODE tester +i"))
-
-((join 10 "JOIN #test")
- (0.09 ":tester!~tester@127.0.0.1 JOIN #test"))
-
-((mode 10 "MODE #test")
- (0.03 ":cadmium.libera.chat 353 tester = #test :tester zbyqbepbqre7 pusevgfpu Thrfg2187 zngbeb qnexNssvavgl wrebzr- rqpentt Ilehf grfg2 AvtugZbaxrl pevfgvvbna xrivap_ fnvybePng shohxv gxan arrqyr avpx16 NeanhqW_kzcc Lbevpx_ hafcrag__ wfgbxre flfqrs RcvpArb Xbentt jvyyr cnefavc0 Wnarg wrnaogeq")
- (0.02 ":cadmium.libera.chat 366 tester #test :End of /NAMES list.")
- (0.00 ":cadmium.libera.chat 324 tester #test +nt")
- (0.01 ":cadmium.libera.chat 329 tester #test 1621432263"))
-
-((drop 0 DROP))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((cap 10 "CAP REQ :sasl")
- (0.00 ":irc.example.net NOTICE * :*** Looking up your hostname...")
- (0.01 ":irc.example.net NOTICE * :*** Could not resolve your hostname: Domain not found; using your IP address (10.0.2.100) instead."))
-((nick 10 "NICK dummy"))
-((user 10 "USER dummy 0 * :tester"))
-((authenticate 10 "AUTHENTICATE PLAIN")
- (0.00 ":irc.example.net CAP * ACK :sasl")
- (0.03 ":irc.example.net 433 * dummy :Nickname is already in use.")
- (0.04 "AUTHENTICATE :+"))
-((nick 10 "NICK dummy`")
- (0.00 "PING :orrMOjk^|V"))
-((~pong 10 "PONG :orrMOjk^|V"))
-((authenticate 10 "AUTHENTICATE AHRlc3RlcgBjaGFuZ2VtZQ==")
- (0.01 ":irc.example.net 900 dummy` dummy`!dummy@10.0.2.100 tester :You are now logged in as tester")
- (0.01 ":irc.example.net 903 dummy` :SASL authentication successful"))
-((cap 10 "CAP END")
- (0.00 ":irc.example.net 001 dummy` :Welcome to the FooNet IRC Network dummy`!dummy@10.0.2.100")
- (0.03 ":irc.example.net 002 dummy` :Your host is irc.example.net, running version InspIRCd-3")
- (0.01 ":irc.example.net 003 dummy` :This server was created 13:01:55 Jun 08 2023")
- (0.01 ":irc.example.net 004 dummy` irc.example.net InspIRCd-3 BIRcgikorsw ACHIKMORTXabcefghijklmnopqrstvz :HIXabefghjkloqv")
- (0.00 ":irc.example.net 005 dummy` ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=ascii CHANLIMIT=#:20 CHANMODES=IXbeg,k,Hfjl,ACKMORTcimnprstz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server")
- (0.01 ":irc.example.net 005 dummy` EXTBAN=,ACORTUacjrwz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=FooNet :are supported by this server")
- (0.01 ":irc.example.net 005 dummy` NICKLEN=30 PREFIX=(qaohv)~&@%+ SAFELIST SILENCE=32 STATUSMSG=~&@%+ TOPICLEN=307 UHNAMES USERIP USERLEN=10 USERMODES=,,s,BIRcgikorw WHOX :are supported by this server")
- (0.01 ":irc.example.net 251 dummy` :There are 2 users and 1 invisible on 2 servers")
- (0.01 ":irc.example.net 253 dummy` 1 :unknown connections")
- (0.00 ":irc.example.net 254 dummy` 1 :channels formed")
- (0.00 ":irc.example.net 255 dummy` :I have 3 clients and 1 servers")
- (0.00 ":irc.example.net 265 dummy` :Current local users: 3 Max: 4")
- (0.00 ":irc.example.net 266 dummy` :Current global users: 3 Max: 4")
- (0.00 ":irc.example.net 375 dummy` :irc.example.net message of the day")
- (0.00 ":irc.example.net 372 dummy` : Have fun with the image!")
- (0.00 ":irc.example.net 376 dummy` :End of message of the day."))
-
-((mode 10 "MODE dummy` +i"))
-((privmsg 10 "PRIVMSG NickServ :GHOST dummy")
- (0.00 ":irc.example.net 501 dummy` x :is not a recognised user mode.")
- (0.00 ":irc.example.net NOTICE dummy` :*** You are connected to irc.example.net using TLS (SSL) cipher 'TLS1.3-ECDHE-RSA-AES-256-GCM-AEAD'")
- (0.03 ":dummy`!dummy@10.0.2.100 MODE dummy` :+i")
- (0.02 ":NickServ!NickServ@services.int NOTICE dummy` :\2dummy\2 has been ghosted."))
-((nick 10 "NICK dummy")
- (0.02 ":dummy`!dummy@10.0.2.100 NICK :dummy"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 10 "NICK dummy"))
-((user 10 "USER tester 0 * :tester")
- (0.09 ":reflection.oftc.net NOTICE AUTH :*** Looking up your hostname...")
- (0.03 ":reflection.oftc.net NOTICE AUTH :*** Checking Ident")
- (0.02 ":reflection.oftc.net NOTICE AUTH :*** Found your hostname")
- (0.01 ":reflection.oftc.net NOTICE AUTH :*** No Ident response")
- (0.01 ":reflection.oftc.net 433 * dummy :Nickname is already in use."))
-((nick 10 "NICK dummy`")
- (0.09 ":reflection.oftc.net NOTICE dummy` :*** Connected securely via TLSv1.3 TLS_AES_256_GCM_SHA384-256")
- (0.03 ":reflection.oftc.net NOTICE dummy` :*** Your client certificate fingerprint is 4F6DDB61A5CFFA42719D39E3819B45DC58E4E307")
- (0.01 ":reflection.oftc.net 001 dummy` :Welcome to the OFTC Internet Relay Chat Network dummy`")
- (0.01 ":reflection.oftc.net 002 dummy` :Your host is reflection.oftc.net[64.86.243.183/6697], running version hybrid-7.2.2+oftc1.7.3")
- (0.01 ":reflection.oftc.net 003 dummy` :This server was created Nov 1 2023 at 10:10:46")
- (0.00 ":reflection.oftc.net 004 dummy` reflection.oftc.net hybrid-7.2.2+oftc1.7.3 CDGPRSabcdfgijklnorsuwxyz bciklmnopstvzeIMRS bkloveI")
- (0.01 ":reflection.oftc.net 005 dummy` CALLERID CASEMAPPING=rfc1459 DEAF=D KICKLEN=160 MODES=4 NICKLEN=30 PREFIX=(ov)@+ STATUSMSG=@+ TOPICLEN=391 NETWORK=OFTC MAXLIST=beI:100 MAXTARGETS=1 CHANTYPES=# :are supported by this server")
- (0.03 ":reflection.oftc.net 005 dummy` CHANLIMIT=#:250 CHANNELLEN=50 CHANMODES=eIqb,k,l,cimnpstzMRS AWAYLEN=160 KNOCK ELIST=CMNTU SAFELIST EXCEPTS=e INVEX=I :are supported by this server")
- (0.01 ":reflection.oftc.net 042 dummy` 8L3AAEM45 :your unique ID")
- (0.00 ":reflection.oftc.net 251 dummy` :There are 31 users and 16297 invisible on 19 servers")
- (0.00 ":reflection.oftc.net 252 dummy` 20 :IRC Operators online")
- (0.00 ":reflection.oftc.net 253 dummy` 25 :unknown connection(s)")
- (0.00 ":reflection.oftc.net 254 dummy` 4118 :channels formed")
- (0.00 ":reflection.oftc.net 255 dummy` :I have 1245 clients and 1 servers")
- (0.00 ":reflection.oftc.net 265 dummy` :Current local users: 1245 Max: 1782")
- (0.00 ":reflection.oftc.net 266 dummy` :Current global users: 16328 Max: 19479")
- (0.00 ":reflection.oftc.net 250 dummy` :Highest connection count: 1783 (1782 clients) (203288 connections received)")
- (0.03 ":reflection.oftc.net 375 dummy` :- reflection.oftc.net Message of the Day - ")
- (0.00 ":reflection.oftc.net 372 dummy` :- O")
- (0.00 ":reflection.oftc.net 372 dummy` :- Thanks and enjoy your stay! The OFTC team.")
- (0.00 ":reflection.oftc.net 376 dummy` :End of /MOTD command.")
- (0.03 ":dummy`!~tester@static-198-54-134-141.cust.tzulo.com MODE dummy` :+i"))
-((mode 10 "MODE dummy` +i")
- (0.00 ":CTCPServ!services@services.oftc.net PRIVMSG dummy` :\1VERSION\1"))
-((~notice 10 "NOTICE CTCPServ :\1VERSION \2ERC\2"))
-((privmsg 10 "PRIVMSG NickServ :REGAIN dummy")
- (0.01 ":NickServ!services@services.oftc.net NOTICE dummy` :REGAIN succeed on nickname \2dummy\2. You have been changed to your nickname.")
- (0.05 ":dummy`!~tester@static-198-54-134-141.cust.tzulo.com NICK :dummy")
- (0.01 ":dummy MODE dummy :+R")
- (0.04 ":dummy MODE dummy :-R")
- (0.01 ":dummy MODE dummy :+R"))
-((quit 10 "QUIT :\2ERC\2 5")
- (0.08 "ERROR :Closing Link: static-198-54-134-141.cust.tzulo.com ()"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((cap 10 "CAP REQ :sasl")
- (0.00 ":irc.example.net NOTICE * :*** Looking up your hostname...")
- (0.01 ":irc.example.net NOTICE * :*** Could not resolve your hostname: Domain not found; using your IP address (10.0.2.100) instead."))
-((nick 10 "NICK dummy"))
-((user 10 "USER dummy 0 * :tester"))
-;; This also happens to a test late ACK (see ghost variant for server-sent PING)
-((authenticate 10 "AUTHENTICATE PLAIN")
- (0.00 ":irc.example.net CAP * ACK :sasl")
- (0.09 ":irc.example.net 433 * dummy :Nickname is already in use.")
- (0.04 "AUTHENTICATE :+"))
-((nick 10 "NICK dummy`"))
-((authenticate 10 "AUTHENTICATE AHRlc3RlcgBjaGFuZ2VtZQ==")
- (0.00 ":irc.example.net 900 dummy` dummy`!dummy@10.0.2.100 tester :You are now logged in as tester")
- (0.01 ":irc.example.net 903 dummy` :SASL authentication successful"))
-
-((cap 10 "CAP END")
- (0.00 ":irc.example.net 001 dummy` :Welcome to the FooNet IRC Network dummy`!dummy@10.0.2.100")
- (0.02 ":irc.example.net 002 dummy` :Your host is irc.example.net, running version InspIRCd-3")
- (0.02 ":irc.example.net 003 dummy` :This server was created 08:16:52 Jun 08 2023")
- (0.01 ":irc.example.net 004 dummy` irc.example.net InspIRCd-3 BIRcgikorsw ACHIKMORTXabcefghijklmnopqrstvz :HIXabefghjkloqv")
- (0.00 ":irc.example.net 005 dummy` ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=ascii CHANLIMIT=#:20 CHANMODES=IXbeg,k,Hfjl,ACKMORTcimnprstz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server")
- (0.01 ":irc.example.net 005 dummy` EXTBAN=,ACORTUacjrwz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=FooNet :are supported by this server")
- (0.01 ":irc.example.net 005 dummy` NICKLEN=30 PREFIX=(qaohv)~&@%+ SAFELIST SILENCE=32 STATUSMSG=~&@%+ TOPICLEN=307 UHNAMES USERIP USERLEN=10 USERMODES=,,s,BIRcgikorw WHOX :are supported by this server")
- (0.01 ":irc.example.net 251 dummy` :There are 2 users and 1 invisible on 2 servers")
- (0.01 ":irc.example.net 253 dummy` 1 :unknown connections")
- (0.00 ":irc.example.net 254 dummy` 1 :channels formed")
- (0.02 ":irc.example.net 255 dummy` :I have 3 clients and 1 servers")
- (0.00 ":irc.example.net 265 dummy` :Current local users: 3 Max: 4")
- (0.00 ":irc.example.net 266 dummy` :Current global users: 3 Max: 4")
- (0.00 ":irc.example.net 375 dummy` :irc.example.net message of the day")
- (0.00 ":irc.example.net 372 dummy` : Have fun with the image!")
- (0.00 ":irc.example.net 376 dummy` :End of message of the day.")
- (0.00 ":irc.example.net 501 dummy` x :is not a recognised user mode.")
- (0.00 ":irc.example.net NOTICE dummy` :*** You are connected to irc.example.net using TLS (SSL) cipher 'TLS1.3-ECDHE-RSA-AES-256-GCM-AEAD'"))
-
-((mode 10 "MODE dummy` +i"))
-
-((privmsg 10 "PRIVMSG NickServ :REGAIN dummy")
- (0.00 ":dummy`!dummy@10.0.2.100 MODE dummy` :+i")
- (0.02 ":NickServ!NickServ@services.int NOTICE dummy` :\2dummy\2 has been regained.")
- (0.02 ":dummy`!dummy@10.0.2.100 NICK :dummy"))
+++ /dev/null
-;; -*- mode: lisp-data; -*-
-((nick 1 "NICK tester"))
-((user 1 "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 Wed, 05 May 2021 09:05:34 UTC")
- (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
- (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
- (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
- (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
- (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
- (0 ":irc.foonet.org 254 tester 1 :channels formed")
- (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
- (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
- (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
- (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-
-((mode-user 10 "MODE tester +i")
- (0 ":irc.foonet.org 221 tester +i")
- (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")
- (0 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-
-((join 10 "JOIN #chan")
- (0 ":tester!~u@247eaxkrufj44.irc JOIN #chan")
- (0 ":irc.foonet.org 353 tester = #chan :alice fsbot @bob tester")
- (0 ":irc.foonet.org 366 tester #chan :End of /NAMES list."))
-
-((mode-chan 10 "MODE #chan")
- (0 ":irc.foonet.org 324 tester #chan +nt")
- (0 ":irc.foonet.org 329 tester #chan 1620205534")
- (0 ":alice!~u@yppdd5tt4admc.irc PRIVMSG #chan :tester, welcome!")
- (0 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :tester, welcome!")
- (0 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :alice: Nor I no strength to climb without thy help.")
- (0 ":alice!~u@yppdd5tt4admc.irc PRIVMSG #chan :bob: Nothing, but let him have thanks."))
+++ /dev/null
-itree-tests
+++ /dev/null
-### @configure_input@
-
-# Copyright (C) 2017-2025 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/>.
-
-PROGRAM = itree-tests
-PACKAGES = check
-top_srcdir = @top_srcdir@
-top_builddir = @top_builddir@
-CPPFLAGS += -I $(top_srcdir)/src
-CFLAGS += -O0 -g3 $(shell pkg-config --cflags $(PACKAGES))
-LDLIBS += $(shell pkg-config --libs $(PACKAGES)) -lm
-OBJECTS = itree-tests.o
-CC = gcc
-EMACS ?= $(top_builddir)/src/emacs
-
-.PHONY: all check clean distclean perf
-
-all: check
-
-check: $(PROGRAM)
- ./check-sanitize.sh ./$(PROGRAM)
-
-itree-tests.o: emacs-compat.h $(top_srcdir)/src/itree.c $(top_srcdir)/src/itree.h
-
-perf:
- -$(EMACS) -Q -l ./overlay-perf.el -f perf-run-batch
-
-clean:
- rm -f -- $(OBJECTS) $(PROGRAM)
-
-distclean: clean
- rm -f -- Makefile
+++ /dev/null
-#!/usr/bin/env bash
-### check-sanitize.sh - strip confusing parts of Check error output
-
-## Copyright (C) 2017-2025 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/>.
-
-set -o pipefail
-
-prog=$1
-shift
-
-[ -z "$prog" ] && {
- echo "usage:$(basename $0) CHECK_PROGRAM";
- exit 1;
-}
-
-# FIXME: This would be unnecessary if
-# compilation-error-regexp-alist-alist understood libcheck OOTB.
-"$prog" "$@" | sed -e 's/^\([^:]\+\):\([0-9]\+\):\([PFE]\):\([^:]*\):\([^:]*\):[^:]*:\(.*\)/\1:\2:\3:\4:\5:\6/'
+++ /dev/null
-/* Mock necessary parts of lisp.h.
-
-Copyright (C) 2017-2025 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/>. */
-
-#ifndef TEST_COMPAT_H
-#define TEST_COMPAT_H
-
-#include <limits.h>
-#include <stdio.h>
-#include <stdlib.h>
-
-typedef int Lisp_Object;
-
-void *
-xmalloc (size_t size)
-{
- return malloc (size);
-}
-
-void
-xfree (void *ptr)
-{
- free (ptr);
-}
-
-void *
-xrealloc (void *block, size_t size)
-{
- return realloc (block, size);
-}
-
-void
-emacs_abort ()
-{
- fprintf (stderr, "Aborting...\n");
- exit (EXIT_FAILURE);
-}
-
-#ifndef eassert
-#define eassert(cond) \
- do { \
- if (! (cond)) { \
- fprintf (stderr, "%s:%d:eassert condition failed: %s\n", \
- __FILE__, __LINE__ , # cond); \
- exit (EXIT_FAILURE); \
- } \
- } while (0)
-#endif
-
-#ifndef eassume
-#define eassume eassert
-#endif
-
-#ifndef max
-#define max(x,y) ((x) >= (y) ? (x) : (y))
-#endif
-#ifndef min
-#define min(x,y) ((x) <= (y) ? (x) : (y))
-#endif
-
-#endif /* TEST_COMPAT_H */
+++ /dev/null
-/* Test the interval data-structure in itree.c.
-
-Copyright (c) 2017-2025 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/>. */
-
-#include <config.h>
-
-#include <stdarg.h>
-#include <stdlib.h>
-
-#include <check.h>
-#include "emacs-compat.h"
-
-#define EMACS_LISP_H /* lisp.h inclusion guard */
-#define ITREE_TESTING
-#include "itree.c"
-
-/* Globals. */
-
-static struct itree_tree tree;
-static struct itree_node A, B, C, D, E;
-static struct itree_node N_05, N_10, N_15, N_20, N_30, N_40;
-static struct itree_node N_50, N_70, N_80, N_90, N_85, N_95;
-
-/* Basic tests of the itree_tree data-structure. */
-
-/* +===================================================================================+
- * | Insert
- * +===================================================================================+ */
-
-/* The graphs below display the trees after each insertion (as they
- should be). See the source code for the different cases
- applied. */
-
-static void
-test_insert1_setup (void)
-{
- enum { N = 6 };
- const int values[N] = {50, 30, 20, 10, 15, 5};
- struct itree_node *nodes[N] = {&N_50, &N_30, &N_20, &N_10, &N_15, &N_05};
- itree_init (&tree);
- for (int i = 0; i < N; ++i)
- {
- nodes[i]->begin = nodes[i]->end = values[i];
- nodes[i]->otick = tree.otick;
- }
-}
-
-START_TEST (test_insert_1)
-{
- /*
- * [50]
- */
-
- itree_insert_node (&tree, &N_50);
- ck_assert (! N_50.red);
- ck_assert_ptr_eq (&N_50, tree.root);
-}
-END_TEST
-
-START_TEST (test_insert_2)
-{
- /*
- * [50]
- * /
- * (30)
- */
-
- itree_insert_node (&tree, &N_50);
- itree_insert_node (&tree, &N_30);
- ck_assert (! N_50.red);
- ck_assert (N_30.red);
- ck_assert_ptr_eq (&N_50, tree.root);
- ck_assert_ptr_eq (N_30.parent, &N_50);
- ck_assert_ptr_eq (N_50.left, &N_30);
- ck_assert_ptr_null (N_50.right);
- ck_assert_ptr_null (N_30.left);
- ck_assert_ptr_null (N_30.right);
-}
-END_TEST
-
-START_TEST (test_insert_3)
-{
- /* case 3.a
- * [30]
- * / \
- * (20) (50)
- */
-
- itree_insert_node (&tree, &N_50);
- itree_insert_node (&tree, &N_30);
- itree_insert_node (&tree, &N_20);
- ck_assert (N_50.red);
- ck_assert (! N_30.red);
- ck_assert (N_20.red);
- ck_assert_ptr_eq (&N_30, tree.root);
- ck_assert_ptr_eq (N_50.parent, &N_30);
- ck_assert_ptr_eq (N_30.right, &N_50);
- ck_assert_ptr_eq (N_30.left, &N_20);
- ck_assert_ptr_null (N_20.left);
- ck_assert_ptr_null (N_20.right);
- ck_assert_ptr_eq (N_20.parent, &N_30);
-}
-END_TEST
-
-START_TEST (test_insert_4)
-{
- /* 1.a
- * [30]
- * / \
- * [20] [50]
- * /
- * (10)
- */
-
- itree_insert_node (&tree, &N_50);
- itree_insert_node (&tree, &N_30);
- itree_insert_node (&tree, &N_20);
- itree_insert_node (&tree, &N_10);
- ck_assert (! N_50.red);
- ck_assert (! N_30.red);
- ck_assert (! N_20.red);
- ck_assert (N_10.red);
- ck_assert_ptr_eq (&N_30, tree.root);
- ck_assert_ptr_eq (N_50.parent, &N_30);
- ck_assert_ptr_eq (N_30.right, &N_50);
- ck_assert_ptr_eq (N_30.left, &N_20);
- ck_assert_ptr_eq (N_20.left, &N_10);
- ck_assert_ptr_null (N_20.right);
- ck_assert_ptr_eq (N_20.parent, &N_30);
- ck_assert_ptr_eq (N_10.parent, &N_20);
- ck_assert_ptr_eq (N_20.left, &N_10);
- ck_assert_ptr_null (N_10.right);
-}
-END_TEST
-
-START_TEST (test_insert_5)
-{
- /* 2.a
- * [30]
- * / \
- * [15] [50]
- * / \
- * (10) (20)
- */
-
- itree_insert_node (&tree, &N_50);
- itree_insert_node (&tree, &N_30);
- itree_insert_node (&tree, &N_20);
- itree_insert_node (&tree, &N_10);
- itree_insert_node (&tree, &N_15);
- ck_assert (! N_50.red);
- ck_assert (! N_30.red);
- ck_assert (N_20.red);
- ck_assert (N_10.red);
- ck_assert (! N_15.red);
- ck_assert_ptr_eq (&N_30, tree.root);
- ck_assert_ptr_eq (N_50.parent, &N_30);
- ck_assert_ptr_eq (N_30.right, &N_50);
- ck_assert_ptr_eq (N_30.left, &N_15);
- ck_assert_ptr_null (N_20.left);
- ck_assert_ptr_null (N_20.right);
- ck_assert_ptr_eq (N_20.parent, &N_15);
- ck_assert_ptr_eq (N_10.parent, &N_15);
- ck_assert_ptr_null (N_20.left);
- ck_assert_ptr_null (N_10.right);
- ck_assert_ptr_eq (N_15.right, &N_20);
- ck_assert_ptr_eq (N_15.left, &N_10);
- ck_assert_ptr_eq (N_15.parent, &N_30);
-}
-END_TEST
-
-START_TEST (test_insert_6)
-{
- /* 1.a
- * [30]
- * / \
- * (15) [50]
- * / \
- * [10] [20]
- * /
- * (5)
- */
-
- itree_insert_node (&tree, &N_50);
- itree_insert_node (&tree, &N_30);
- itree_insert_node (&tree, &N_20);
- itree_insert_node (&tree, &N_10);
- itree_insert_node (&tree, &N_15);
- itree_insert_node (&tree, &N_05);
- ck_assert (! N_50.red);
- ck_assert (! N_30.red);
- ck_assert (! N_20.red);
- ck_assert (! N_10.red);
- ck_assert (N_15.red);
- ck_assert (N_05.red);
- ck_assert_ptr_eq (&N_30, tree.root);
- ck_assert_ptr_eq (N_50.parent, &N_30);
- ck_assert_ptr_eq (N_30.right, &N_50);
- ck_assert_ptr_eq (N_30.left, &N_15);
- ck_assert_ptr_null (N_20.left);
- ck_assert_ptr_null (N_20.right);
- ck_assert_ptr_eq (N_20.parent, &N_15);
- ck_assert_ptr_eq (N_10.parent, &N_15);
- ck_assert_ptr_null (N_20.left);
- ck_assert_ptr_null (N_10.right);
- ck_assert_ptr_eq (N_15.right, &N_20);
- ck_assert_ptr_eq (N_15.left, &N_10);
- ck_assert_ptr_eq (N_15.parent, &N_30);
- ck_assert_ptr_eq (N_05.parent, &N_10);
- ck_assert_ptr_eq (N_10.left, &N_05);
- ck_assert_ptr_null (N_05.right);
-}
-END_TEST
-
-\f
-
-/* These are the mirror cases to the above ones. */
-
-static void
-test_insert2_setup (void)
-{
- enum { N = 6 };
- const int values[] = {50, 70, 80, 90, 85, 95};
- struct itree_node *nodes[N] = {&N_50, &N_70, &N_80, &N_90, &N_85, &N_95};
- itree_init (&tree);
- for (int i = 0; i < N; ++i)
- {
- nodes[i]->begin = nodes[i]->end = values[i];
- nodes[i]->otick = tree.otick;
- }
-}
-
-START_TEST (test_insert_7)
-{
- /*
- * [50]
- */
-
- itree_insert_node (&tree, &N_50);
- ck_assert (! N_50.red);
- ck_assert_ptr_eq (&N_50, tree.root);
-}
-END_TEST
-
-START_TEST (test_insert_8)
-{
- /*
- * [50]
- * \
- * (70)
- */
-
- itree_insert_node (&tree, &N_50);
- itree_insert_node (&tree, &N_70);
- ck_assert (! N_50.red);
- ck_assert (N_70.red);
- ck_assert_ptr_eq (&N_50, tree.root);
- ck_assert_ptr_eq (N_70.parent, &N_50);
- ck_assert_ptr_eq (N_50.right, &N_70);
- ck_assert_ptr_null (N_50.left);
- ck_assert_ptr_null (N_70.right);
- ck_assert_ptr_null (N_70.left);
-}
-END_TEST
-
-START_TEST (test_insert_9)
-{
- /* 3.a
- * [70]
- * / \
- * (50) (80)
- */
-
- itree_insert_node (&tree, &N_50);
- itree_insert_node (&tree, &N_70);
- itree_insert_node (&tree, &N_80);
- ck_assert (N_50.red);
- ck_assert (! N_70.red);
- ck_assert (N_80.red);
- ck_assert_ptr_eq (&N_70, tree.root);
- ck_assert_ptr_eq (N_50.parent, &N_70);
- ck_assert_ptr_eq (N_70.right, &N_80);
- ck_assert_ptr_eq (N_70.left, &N_50);
- ck_assert_ptr_null (N_80.right);
- ck_assert_ptr_null (N_80.left);
- ck_assert_ptr_eq (N_80.parent, &N_70);
-}
-END_TEST
-
-START_TEST (test_insert_10)
-{
- /* 1.b
- * [70]
- * / \
- * [50] [80]
- * \
- * (90)
- */
-
- itree_insert_node (&tree, &N_50);
- itree_insert_node (&tree, &N_70);
- itree_insert_node (&tree, &N_80);
- itree_insert_node (&tree, &N_90);
- ck_assert (! N_50.red);
- ck_assert (! N_70.red);
- ck_assert (! N_80.red);
- ck_assert (N_90.red);
- ck_assert_ptr_eq (&N_70, tree.root);
- ck_assert_ptr_eq (N_50.parent, &N_70);
- ck_assert_ptr_eq (N_70.right, &N_80);
- ck_assert_ptr_eq (N_70.left, &N_50);
- ck_assert_ptr_eq (N_80.right, &N_90);
- ck_assert_ptr_null (N_80.left);
- ck_assert_ptr_eq (N_80.parent, &N_70);
- ck_assert_ptr_eq (N_90.parent, &N_80);
- ck_assert_ptr_eq (N_80.right, &N_90);
- ck_assert_ptr_null (N_90.left);
-}
-END_TEST
-
-START_TEST (test_insert_11)
-{
- /* 2.b
- * [70]
- * / \
- * [50] [85]
- * / \
- * (80) (90)
- */
-
- itree_insert_node (&tree, &N_50);
- itree_insert_node (&tree, &N_70);
- itree_insert_node (&tree, &N_80);
- itree_insert_node (&tree, &N_90);
- itree_insert_node (&tree, &N_85);
- ck_assert (! N_50.red);
- ck_assert (! N_70.red);
- ck_assert (N_80.red);
- ck_assert (N_90.red);
- ck_assert (! N_85.red);
- ck_assert_ptr_eq (&N_70, tree.root);
- ck_assert_ptr_eq (N_50.parent, &N_70);
- ck_assert_ptr_eq (N_70.right, &N_85);
- ck_assert_ptr_eq (N_70.left, &N_50);
- ck_assert_ptr_null (N_80.right);
- ck_assert_ptr_null (N_80.left);
- ck_assert_ptr_eq (N_80.parent, &N_85);
- ck_assert_ptr_eq (N_90.parent, &N_85);
- ck_assert_ptr_null (N_80.right);
- ck_assert_ptr_null (N_90.left);
- ck_assert_ptr_eq (N_85.right, &N_90);
- ck_assert_ptr_eq (N_85.left, &N_80);
- ck_assert_ptr_eq (N_85.parent, &N_70);
-
-}
-END_TEST
-
-START_TEST (test_insert_12)
-{
- /* 1.b
- * [70]
- * / \
- * [50] (85)
- * / \
- * [80] [90]
- * \
- * (95)
- */
-
- itree_insert_node (&tree, &N_50);
- itree_insert_node (&tree, &N_70);
- itree_insert_node (&tree, &N_80);
- itree_insert_node (&tree, &N_90);
- itree_insert_node (&tree, &N_85);
- itree_insert_node (&tree, &N_95);
- ck_assert (! N_50.red);
- ck_assert (! N_70.red);
- ck_assert (! N_80.red);
- ck_assert (! N_90.red);
- ck_assert (N_85.red);
- ck_assert (N_95.red);
- ck_assert_ptr_eq (&N_70, tree.root);
- ck_assert_ptr_eq (N_50.parent, &N_70);
- ck_assert_ptr_eq (N_70.right, &N_85);
- ck_assert_ptr_eq (N_70.left, &N_50);
- ck_assert_ptr_null (N_80.right);
- ck_assert_ptr_null (N_80.left);
- ck_assert_ptr_eq (N_80.parent, &N_85);
- ck_assert_ptr_eq (N_90.parent, &N_85);
- ck_assert_ptr_null (N_80.right);
- ck_assert_ptr_null (N_90.left);
- ck_assert_ptr_eq (N_85.right, &N_90);
- ck_assert_ptr_eq (N_85.left, &N_80);
- ck_assert_ptr_eq (N_85.parent, &N_70);
- ck_assert_ptr_eq (N_95.parent, &N_90);
- ck_assert_ptr_eq (N_90.right, &N_95);
- ck_assert_ptr_null (N_95.left);
-}
-END_TEST
-
-START_TEST (test_insert_13)
-{
- enum { N = 4 };
- const int values[N] = {10, 20, 30, 40};
- struct itree_node *nodes[N] = {&N_10, &N_20, &N_30, &N_40};
- itree_init (&tree);
- for (int i = 0; i < N; ++i)
- itree_insert (&tree, nodes[i], values[i], values[i]);
-
- ck_assert_ptr_eq (tree.root, &N_20);
- ck_assert_ptr_eq (N_20.left, &N_10);
- ck_assert_ptr_eq (N_20.right, &N_30);
- ck_assert_ptr_eq (N_30.right, &N_40);
- ck_assert (! N_10.red);
- ck_assert (! N_20.red);
- ck_assert (! N_30.red);
- ck_assert (N_40.red);
-}
-END_TEST
-
-START_TEST (test_insert_14)
-{
- enum { N = 3 };
- struct itree_node nodes[N] = {0};
- itree_init (&tree);
-
- for (int i = 0; i < N; ++i)
- itree_insert (&tree, &nodes[i], 10, 10);
- for (int i = 0; i < N; ++i)
- ck_assert (itree_contains (&tree, &nodes[i]));
-}
-END_TEST
-
-\f
-/* +===================================================================================+
- * | Remove
- * +===================================================================================+ */
-
-/* Creating proper test trees for the formal tests via insertions is
- way too tedious, so we just fake it and only test the
- fix-routine. */
-static void
-test_remove1_setup (void)
-{
- itree_init (&tree);
- tree.root = &B;
- A.parent = &B; B.parent = NULL; C.parent = &D; D.parent = &B; E.parent = &D;
- A.left = A.right = C.left = C.right = E.left = E.right = NULL;
- B.left = &A; B.right = &D;
- D.left = &C; D.right = &E;
- A.offset = B.offset = C.offset = D.offset = E.offset = 0;
- A.otick = B.otick = C.otick = D.otick = E.otick = tree.otick;
-}
-
-/* 1.a -> 2.a
- * [B]
- * / \
- * [A] (D)
- * / \
- * [C] [E]
- */
-
-START_TEST (test_remove_1)
-{
- B.red = A.red = C.red = E.red = false;
- D.red = true;
- itree_remove_fix (&tree, &A, &B);
-
- ck_assert (! A.red);
- ck_assert (! B.red);
- ck_assert (C.red);
- ck_assert (! D.red);
- ck_assert (! E.red);
- ck_assert_ptr_eq (A.parent, &B);
- ck_assert_ptr_eq (B.left, &A);
- ck_assert_ptr_eq (B.right, &C);
- ck_assert_ptr_eq (C.parent, &B);
- ck_assert_ptr_eq (E.parent, &D);
- ck_assert_ptr_eq (D.right, &E);
- ck_assert_ptr_eq (D.left, &B);
- ck_assert_ptr_eq (tree.root, &D);
-}
-END_TEST
-
-/* 2.a */
-START_TEST (test_remove_2)
-{
- B.red = D.red = A.red = C.red = E.red = false;
- itree_remove_fix (&tree, &A, &B);
-
- ck_assert (! A.red);
- ck_assert (! B.red);
- ck_assert (! C.red);
- ck_assert (D.red);
- ck_assert (! E.red);
- ck_assert_ptr_eq (A.parent, &B);
- ck_assert_ptr_eq (B.left, &A);
- ck_assert_ptr_eq (B.right, &D);
- ck_assert_ptr_eq (C.parent, &D);
- ck_assert_ptr_eq (E.parent, &D);
- ck_assert_ptr_eq (tree.root, &B);
-}
-END_TEST
-
-/* 3.a -> 4.a */
-START_TEST (test_remove_3)
-{
- D.red = A.red = E.red = false;
- B.red = C.red = true;
- itree_remove_fix (&tree, &A, &B);
-
- ck_assert (! A.red);
- ck_assert (! B.red);
- ck_assert (! C.red);
- ck_assert (! D.red);
- ck_assert (! E.red);
- ck_assert_ptr_eq (A.parent, &B);
- ck_assert_ptr_eq (B.left, &A);
- ck_assert_ptr_null (B.right);
- ck_assert_ptr_eq (&C, tree.root);
- ck_assert_ptr_eq (C.left, &B);
- ck_assert_ptr_eq (C.right, &D);
- ck_assert_ptr_eq (E.parent, &D);
- ck_assert_ptr_null (D.left);
-}
-END_TEST
-
-/* 4.a */
-START_TEST (test_remove_4)
-{
- B.red = C.red = E.red = true;
- A.red = D.red = false;
- itree_remove_fix (&tree, &A, &B);
-
- ck_assert (! A.red);
- ck_assert (! B.red);
- ck_assert (C.red);
- ck_assert (! D.red);
- ck_assert (! E.red);
- ck_assert_ptr_eq (A.parent, &B);
- ck_assert_ptr_eq (B.left, &A);
- ck_assert_ptr_eq (B.right, &C);
- ck_assert_ptr_eq (C.parent, &B);
- ck_assert_ptr_eq (E.parent, &D);
- ck_assert_ptr_eq (tree.root, &D);
-}
-END_TEST
-
-\f
-
-/* These are the mirrored cases. */
-
-static void
-test_remove2_setup (void)
-{
- itree_init (&tree);
- tree.root = &B;
- A.parent = &B; B.parent = NULL; C.parent = &D; D.parent = &B; E.parent = &D;
- A.right = A.left = C.right = C.left = E.right = E.left = NULL;
- B.right = &A; B.left = &D;
- D.right = &C; D.left = &E;
-}
-
-/* 1.b -> 2.b
- * [B]
- * / \
- * [A] (D)
- * / \
- * [C] [E]
- */
-
-START_TEST (test_remove_5)
-{
- B.red = A.red = C.red = E.red = false;
- D.red = true;
- itree_remove_fix (&tree, &A, &B);
-
- ck_assert (! A.red);
- ck_assert (! B.red);
- ck_assert (C.red);
- ck_assert (! D.red);
- ck_assert (! E.red);
- ck_assert_ptr_eq (A.parent, &B);
- ck_assert_ptr_eq (B.right, &A);
- ck_assert_ptr_eq (B.left, &C);
- ck_assert_ptr_eq (C.parent, &B);
- ck_assert_ptr_eq (E.parent, &D);
- ck_assert_ptr_eq (D.left, &E);
- ck_assert_ptr_eq (D.right, &B);
- ck_assert_ptr_eq (tree.root, &D);
-}
-END_TEST
-
-/* 2.b */
-START_TEST (test_remove_6)
-{
- B.red = D.red = A.red = C.red = E.red = false;
- itree_remove_fix (&tree, &A, &B);
-
- ck_assert (! A.red);
- ck_assert (! B.red);
- ck_assert (! C.red);
- ck_assert (D.red);
- ck_assert (! E.red);
- ck_assert_ptr_eq (A.parent, &B);
- ck_assert_ptr_eq (B.right, &A);
- ck_assert_ptr_eq (B.left, &D);
- ck_assert_ptr_eq (C.parent, &D);
- ck_assert_ptr_eq (E.parent, &D);
- ck_assert_ptr_eq (tree.root, &B);
-}
-END_TEST
-
-/* 3.b -> 4.b */
-START_TEST (test_remove_7)
-{
- D.red = A.red = E.red = false;
- B.red = C.red = true;
- itree_remove_fix (&tree, &A, &B);
-
- ck_assert (! A.red);
- ck_assert (! B.red);
- ck_assert (! C.red);
- ck_assert (! D.red);
- ck_assert (! E.red);
- ck_assert_ptr_eq (A.parent, &B);
- ck_assert_ptr_eq (B.right, &A);
- ck_assert_ptr_null (B.left);
- ck_assert_ptr_eq (&C, tree.root);
- ck_assert_ptr_eq (C.right, &B);
- ck_assert_ptr_eq (C.left, &D);
- ck_assert_ptr_eq (E.parent, &D);
- ck_assert_ptr_null (D.right);
-}
-END_TEST
-
-/* 4.b */
-START_TEST (test_remove_8)
-{
- B.red = C.red = E.red = true;
- A.red = D.red = false;
- itree_remove_fix (&tree, &A, &B);
-
- ck_assert (! A.red);
- ck_assert (! B.red);
- ck_assert (C.red);
- ck_assert (! D.red);
- ck_assert (! E.red);
- ck_assert_ptr_eq (A.parent, &B);
- ck_assert_ptr_eq (B.right, &A);
- ck_assert_ptr_eq (B.left, &C);
- ck_assert_ptr_eq (C.parent, &B);
- ck_assert_ptr_eq (E.parent, &D);
- ck_assert_ptr_eq (tree.root, &D);
-}
-END_TEST
-
-START_TEST (test_remove_9)
-{
- enum { N = 4 };
- const int values[N] = {10, 20, 30, 40};
- struct itree_node *nodes[N] = {&N_10, &N_20, &N_30, &N_40};
- itree_init (&tree);
- for (int i = 0; i < N; ++i)
- itree_insert (&tree, nodes[i], values[i], values[i]);
-
- ck_assert (tree.root == &N_20);
- ck_assert (N_20.left == &N_10);
- ck_assert (N_20.right == &N_30);
- ck_assert (N_30.right == &N_40);
- ck_assert (! N_20.red);
- ck_assert (! N_10.red);
- ck_assert (! N_30.red);
- ck_assert (N_40.red);
-
- itree_remove (&tree, &N_10);
-
- ck_assert_ptr_eq (tree.root, &N_30);
- ck_assert_ptr_null (N_30.parent);
- ck_assert_ptr_eq (N_30.left, &N_20);
- ck_assert_ptr_eq (N_30.right, &N_40);
- ck_assert (! N_20.red);
- ck_assert (! N_30.red);
- ck_assert (! N_40.red);
-}
-END_TEST
-
-static void
-shuffle (int *index, int n)
-{
- for (int i = n - 1; i >= 0; --i)
- {
- int j = random () % (i + 1);
- int h = index[j];
- index[j] = index[i];
- index[i] = h;
- }
-}
-
-START_TEST (test_remove_10)
-{
- enum { N = 3 };
- int index[N];
- for (int i = 0; i < N; ++i)
- index[i] = i;
- srand (42);
- shuffle (index, N);
-
- itree_init (&tree);
- struct itree_node nodes[N] = {0};
- for (int i = 0; i < N; ++i)
- {
- ptrdiff_t pos = (i + 1) * 10;
- itree_insert (&tree, &nodes[index[i]], pos, pos + 1);
- }
-
- shuffle (index, N);
- for (int i = 0; i < N; ++i)
- {
- ck_assert (itree_contains (&tree, &nodes[index[i]]));
- itree_remove (&tree, &nodes[index[i]]);
- }
- ck_assert (itree_empty_p (&tree));
- ck_assert_int_eq (tree.size, 0);
-}
-END_TEST
-
-\f
-/* +===================================================================================+
- * | Generator
- * +===================================================================================+ */
-
-START_TEST (test_generator_1)
-{
- struct itree_node node = {0}, *n;
- struct itree_iterator it, *g;
- itree_init (&tree);
-
- itree_insert (&tree, &node, 10, 20);
- g = itree_iterator_start (&it, &tree, 0, 30, ITREE_ASCENDING);
- n = itree_iterator_next (g);
- ck_assert_ptr_eq (n, &node);
- ck_assert_int_eq (n->begin, 10);
- ck_assert_int_eq (n->end, 20);
- ck_assert_ptr_null (itree_iterator_next (g));
- ck_assert_ptr_null (itree_iterator_next (g));
- ck_assert_ptr_null (itree_iterator_next (g));
-
- g = itree_iterator_start (&it, &tree, 30, 50, ITREE_ASCENDING);
- ck_assert_ptr_null (itree_iterator_next (g));
- ck_assert_ptr_null (itree_iterator_next (g));
- ck_assert_ptr_null (itree_iterator_next (g));
-}
-END_TEST
-
-static void
-test_check_generator (struct itree_tree *tree,
- ptrdiff_t begin, ptrdiff_t end,
- int n, ...)
-{
- va_list ap;
- struct itree_iterator it, *g =
- itree_iterator_start (&it, tree, begin, end, ITREE_ASCENDING);
-
- va_start (ap, n);
- for (int i = 0; i < n; ++i)
- {
- struct itree_node *node = itree_iterator_next (g);
- ck_assert_ptr_nonnull (node);
- ck_assert_int_eq (node->begin, va_arg (ap, ptrdiff_t));
- }
- va_end (ap);
- ck_assert_ptr_null (itree_iterator_next (g));
- ck_assert_ptr_null (itree_iterator_next (g));
-}
-
-START_TEST (test_generator_2)
-{
- itree_init (&tree);
- struct itree_node nodes[3] = {0};
- for (int i = 0; i < 3; ++i)
- itree_insert (&tree, &nodes[i], 10 * (i + 1), 10 * (i + 2));
-
- test_check_generator (&tree, 0, 50, 3,
- 10, 20, 30);
- test_check_generator (&tree, 0, 10, 0);
- test_check_generator (&tree, 40, 50, 0);
- test_check_generator (&tree, 15, 35, 3,
- 10, 20, 30);
- test_check_generator (&tree, -100, -50, 0);
- test_check_generator (&tree, -100, -50, 0);
- test_check_generator (&tree, 100, 50, 0);
- test_check_generator (&tree, 100, 150, 0);
- test_check_generator (&tree, 0, 0, 0);
- test_check_generator (&tree, 40, 40, 0);
- test_check_generator (&tree, 30, 30, 0);
- test_check_generator (&tree, 35, 35, 1,
- 30);
-}
-END_TEST
-
-static void
-test_create_tree (struct itree_node *nodes, int n, bool doshuffle)
-{
- int *index = calloc (n, sizeof (int));
- for (int i = 0; i < n; ++i)
- index[i] = i;
- if (doshuffle)
- {
- srand (42);
- shuffle (index, n);
- }
-
- itree_init (&tree);
- for (int i = 0; i < n; ++i)
- {
- struct itree_node *node = &nodes[index[i]];
- itree_insert (&tree, node, node->begin, node->end);
- }
- free (index);
-}
-
-START_TEST (test_generator_3)
-{
- enum { N = 3 };
- struct itree_node nodes[N] = {{.begin = 10, .end = 10},
- {.begin = 10, .end = 10},
- {.begin = 10, .end = 10}};
- test_create_tree (nodes, N, true);
- test_check_generator (&tree, 0, 10, 0);
- test_check_generator (&tree, 10, 10, 3,
- 10, 10, 10);
- test_check_generator (&tree, 10, 20, 3,
- 10, 10, 10);
-}
-END_TEST
-
-START_TEST (test_generator_5)
-{
- enum { N = 4 };
- struct itree_node nodes[N] = {{.begin = 10, .end = 30},
- {.begin = 20, .end = 40},
- {.begin = 30, .end = 50},
- {.begin = 40, .end = 60}};
- test_create_tree (nodes, N, false);
- struct itree_iterator it, *g =
- itree_iterator_start (&it, &tree, 0, 100, ITREE_PRE_ORDER);
- for (int i = 0; i < N; ++i)
- {
- struct itree_node *n = itree_iterator_next (g);
- ck_assert_ptr_nonnull (n);
- switch (i)
- {
- case 0: ck_assert_int_eq (20, n->begin); break;
- case 1: ck_assert_int_eq (10, n->begin); break;
- case 2: ck_assert_int_eq (30, n->begin); break;
- case 3: ck_assert_int_eq (40, n->begin); break;
- }
- }
-}
-END_TEST
-
-START_TEST (test_generator_6)
-{
- enum { N = 4 };
- struct itree_node nodes[N] = {{.begin = 10, .end = 30},
- {.begin = 20, .end = 40},
- {.begin = 30, .end = 50},
- {.begin = 40, .end = 60}};
- test_create_tree (nodes, N, true);
- struct itree_iterator it, *g =
- itree_iterator_start (&it, &tree, 0, 100, ITREE_ASCENDING);
- for (int i = 0; i < N; ++i)
- {
- struct itree_node *n = itree_iterator_next (g);
- ck_assert_ptr_nonnull (n);
- switch (i)
- {
- case 0: ck_assert_int_eq (10, n->begin); break;
- case 1: ck_assert_int_eq (20, n->begin); break;
- case 2: ck_assert_int_eq (30, n->begin); break;
- case 3: ck_assert_int_eq (40, n->begin); break;
- }
- }
-}
-END_TEST
-
-START_TEST (test_generator_7)
-{
- enum { N = 4 };
- struct itree_node nodes[N] = {{.begin = 10, .end = 30},
- {.begin = 20, .end = 40},
- {.begin = 30, .end = 50},
- {.begin = 40, .end = 60}};
- test_create_tree (nodes, N, true);
- struct itree_iterator it, *g =
- itree_iterator_start (&it, &tree, 0, 100, ITREE_DESCENDING);
- for (int i = 0; i < N; ++i)
- {
- struct itree_node *n = itree_iterator_next (g);
- ck_assert_ptr_nonnull (n);
- switch (i)
- {
- case 0: ck_assert_int_eq (40, n->begin); break;
- case 1: ck_assert_int_eq (30, n->begin); break;
- case 2: ck_assert_int_eq (20, n->begin); break;
- case 3: ck_assert_int_eq (10, n->begin); break;
- }
- }
-}
-END_TEST
-
-START_TEST (test_generator_8)
-{
- enum { N = 2 };
- struct itree_node nodes[N] = {{.begin = 20, .end = 30},
- {.begin = 40, .end = 50}};
- test_create_tree (nodes, N, false);
- struct itree_iterator it, *g =
- itree_iterator_start (&it, &tree, 1, 60, ITREE_DESCENDING);
- struct itree_node *n = itree_iterator_next (g);
- ck_assert_int_eq (n->begin, 40);
- itree_iterator_narrow (g, 50, 60);
- n = itree_iterator_next (g);
- ck_assert_ptr_null (n);
-}
-END_TEST
-
-START_TEST (test_generator_9)
-{
- enum { N = 2 };
- struct itree_node nodes[N] = {{.begin = 25, .end = 25},
- {.begin = 20, .end = 30}};
- test_create_tree (nodes, N, false);
- struct itree_iterator it, *g =
- itree_iterator_start (&it, &tree, 1, 30, ITREE_DESCENDING);
- struct itree_node *n = itree_iterator_next (g);
- ck_assert_int_eq (n->begin, 25);
- itree_iterator_narrow (g, 25, 30);
- n = itree_iterator_next (g);
- ck_assert_int_eq (n->begin, 20);
-}
-END_TEST
-
-\f
-/* +===================================================================================+
- * | Insert Gap
- * +===================================================================================+ */
-
-static struct itree_tree gap_tree;
-static struct itree_node gap_node;
-
-#define N_BEG (itree_node_begin (&gap_tree, &gap_node))
-#define N_END (itree_node_end (&gap_tree, &gap_node))
-
-static void
-test_setup_gap_node (ptrdiff_t begin, ptrdiff_t end,
- bool front_advance, bool rear_advance)
-{
- itree_init (&gap_tree);
- gap_node.front_advance = front_advance;
- gap_node.rear_advance = rear_advance;
- itree_insert (&gap_tree, &gap_node, begin, end);
-}
-
-static void
-test_setup_gap_node_noadvance (ptrdiff_t begin, ptrdiff_t end)
-{
- test_setup_gap_node (begin, end, false, false);
-}
-
-START_TEST (test_gap_insert_1)
-{
- test_setup_gap_node_noadvance (100, 200);
- itree_insert_gap (&gap_tree, 100 + 10, 20, false);
- ck_assert_int_eq (N_BEG, 100);
- ck_assert_int_eq (N_END, 200 + 20);
-}
-END_TEST
-
-START_TEST (test_gap_insert_2)
-{
- test_setup_gap_node_noadvance (100, 200);
- itree_insert_gap (&gap_tree, 300, 10, false);
- ck_assert_int_eq (N_BEG, 100);
- ck_assert_int_eq (N_END, 200);
-}
-END_TEST
-
-START_TEST (test_gap_insert_3)
-{
- test_setup_gap_node_noadvance (100, 200);
- itree_insert_gap (&gap_tree, 0, 15, false);
- ck_assert_int_eq (N_BEG, 100 + 15);
- ck_assert_int_eq (N_END, 200 + 15);
-}
-END_TEST
-
-START_TEST (test_gap_insert_4)
-{
- test_setup_gap_node (100, 200, true, false);
- itree_insert_gap (&gap_tree, 100, 20, false);
- ck_assert_int_eq (N_BEG, 100 + 20);
- ck_assert_int_eq (N_END, 200 + 20);
-
-}
-END_TEST
-
-START_TEST (test_gap_insert_5)
-{
- test_setup_gap_node_noadvance (100, 200);
- itree_insert_gap (&gap_tree, 100, 20, false);
- ck_assert_int_eq (N_BEG, 100);
- ck_assert_int_eq (N_END, 200 + 20);
-
-}
-END_TEST
-
-START_TEST (test_gap_insert_6)
-{
- test_setup_gap_node (100, 200, false, true);
- itree_insert_gap (&gap_tree, 200, 20, false);
- ck_assert_int_eq (N_BEG, 100);
- ck_assert_int_eq (N_END, 200 + 20);
-
-}
-END_TEST
-
-START_TEST (test_gap_insert_7)
-{
- test_setup_gap_node_noadvance (100, 200);
- itree_insert_gap (&gap_tree, 200, 20, false);
- ck_assert_int_eq (N_BEG, 100);
- ck_assert_int_eq (N_END, 200);
-
-}
-END_TEST
-
-START_TEST (test_gap_insert_8)
-{
- test_setup_gap_node (100, 100, true, true);
- itree_insert_gap (&gap_tree, 100, 20, false);
- ck_assert_int_eq (N_BEG, 100 + 20);
- ck_assert_int_eq (N_END, 100 + 20);
-
-}
-END_TEST
-
-START_TEST (test_gap_insert_9)
-{
- test_setup_gap_node (100, 100, false, true);
- itree_insert_gap (&gap_tree, 100, 20, false);
- ck_assert_int_eq (N_BEG, 100);
- ck_assert_int_eq (N_END, 100 + 20);
-
-}
-END_TEST
-
-START_TEST (test_gap_insert_10)
-{
- test_setup_gap_node (100, 100, true, false);
- itree_insert_gap (&gap_tree, 100, 20, false);
- ck_assert_int_eq (N_BEG, 100);
- ck_assert_int_eq (N_END, 100);
-
-}
-END_TEST
-
-START_TEST (test_gap_insert_11)
-{
- test_setup_gap_node_noadvance (100, 100);
- itree_insert_gap (&gap_tree, 100, 20, false);
- ck_assert_int_eq (N_BEG, 100);
- ck_assert_int_eq (N_END, 100);
-
-}
-END_TEST
-
-\f
-/* +===================================================================================+
- * | Delete Gap
- * +===================================================================================+ */
-
-START_TEST (test_gap_delete_1)
-{
- test_setup_gap_node_noadvance (100, 200);
- itree_delete_gap (&gap_tree, 100 + 10, 20);
- ck_assert_int_eq (N_BEG, 100);
- ck_assert_int_eq (N_END, 200 - 20);
-
-}
-END_TEST
-
-START_TEST (test_gap_delete_2)
-{
- test_setup_gap_node_noadvance (100, 200);
- itree_delete_gap (&gap_tree, 200 + 10, 20);
- ck_assert_int_eq (N_BEG, 100);
- ck_assert_int_eq (N_END, 200);
-
-}
-END_TEST
-
-START_TEST (test_gap_delete_3)
-{
- test_setup_gap_node_noadvance (100, 200);
- itree_delete_gap (&gap_tree, 200, 20);
- ck_assert_int_eq (N_BEG, 100);
- ck_assert_int_eq (N_END, 200);
-
-}
-END_TEST
-
-START_TEST (test_gap_delete_4)
-{
- test_setup_gap_node_noadvance (100, 200);
- itree_delete_gap (&gap_tree, 100 - 20, 20);
- ck_assert_int_eq (N_BEG, 100 - 20);
- ck_assert_int_eq (N_END, 200 - 20);
-
-}
-END_TEST
-
-START_TEST (test_gap_delete_5)
-{
- test_setup_gap_node_noadvance (100, 200);
- itree_delete_gap (&gap_tree, 70, 20);
- ck_assert_int_eq (N_BEG, 100 - 20);
- ck_assert_int_eq (N_END, 200 - 20);
-
-}
-END_TEST
-
-START_TEST (test_gap_delete_6)
-{
- test_setup_gap_node_noadvance (100, 200);
- itree_delete_gap (&gap_tree, 80, 100);
- ck_assert_int_eq (N_BEG, 80);
- ck_assert_int_eq (N_END, 100);
-}
-END_TEST
-
-START_TEST (test_gap_delete_7)
-{
- test_setup_gap_node_noadvance (100, 200);
- itree_delete_gap (&gap_tree, 120, 100);
- ck_assert_int_eq (N_BEG, 100);
- ck_assert_int_eq (N_END, 120);
-}
-END_TEST
-
-START_TEST (test_gap_delete_8)
-{
- test_setup_gap_node_noadvance (100, 200);
- itree_delete_gap (&gap_tree, 100 - 20, 200 + 20);
- ck_assert_int_eq (N_BEG, 100 - 20);
- ck_assert_int_eq (N_END, 100 - 20);
-
-}
-END_TEST
-
-\f
-
-static Suite *
-basic_suite ()
-{
- Suite *s = suite_create ("basic");
-
- TCase *tc = tcase_create ("insert1");
- tcase_add_checked_fixture (tc, test_insert1_setup, NULL);
- tcase_add_test (tc, test_insert_1);
- tcase_add_test (tc, test_insert_2);
- tcase_add_test (tc, test_insert_3);
- tcase_add_test (tc, test_insert_4);
- tcase_add_test (tc, test_insert_5);
- tcase_add_test (tc, test_insert_6);
- suite_add_tcase (s, tc);
-
- tc = tcase_create ("insert2");
- tcase_add_checked_fixture (tc, test_insert2_setup, NULL);
- tcase_add_test (tc, test_insert_7);
- tcase_add_test (tc, test_insert_8);
- tcase_add_test (tc, test_insert_9);
- tcase_add_test (tc, test_insert_10);
- tcase_add_test (tc, test_insert_11);
- tcase_add_test (tc, test_insert_12);
- suite_add_tcase (s, tc);
-
- tc = tcase_create ("insert3");
- tcase_add_test (tc, test_insert_13);
- tcase_add_test (tc, test_insert_14);
- suite_add_tcase (s, tc);
-
- tc = tcase_create ("remove1");
- tcase_add_checked_fixture (tc, test_remove1_setup, NULL);
- tcase_add_test (tc, test_remove_1);
- tcase_add_test (tc, test_remove_2);
- tcase_add_test (tc, test_remove_3);
- tcase_add_test (tc, test_remove_4);
- suite_add_tcase (s, tc);
-
- tc = tcase_create ("remove2");
- tcase_add_checked_fixture (tc, test_remove2_setup, NULL);
- tcase_add_test (tc, test_remove_5);
- tcase_add_test (tc, test_remove_6);
- tcase_add_test (tc, test_remove_7);
- tcase_add_test (tc, test_remove_8);
- suite_add_tcase (s, tc);
-
- tc = tcase_create ("remove3");
- tcase_add_test (tc, test_remove_9);
- tcase_add_test (tc, test_remove_10);
- suite_add_tcase (s, tc);
-
- tc = tcase_create ("generator");
- tcase_add_test (tc, test_generator_1);
- tcase_add_test (tc, test_generator_2);
- tcase_add_test (tc, test_generator_3);
- tcase_add_test (tc, test_generator_5);
- tcase_add_test (tc, test_generator_6);
- tcase_add_test (tc, test_generator_7);
- tcase_add_test (tc, test_generator_8);
- tcase_add_test (tc, test_generator_9);
- suite_add_tcase (s, tc);
-
- tc = tcase_create ("insert_gap");
- tcase_add_test (tc, test_gap_insert_1);
- tcase_add_test (tc, test_gap_insert_2);
- tcase_add_test (tc, test_gap_insert_3);
- tcase_add_test (tc, test_gap_insert_4);
- tcase_add_test (tc, test_gap_insert_5);
- tcase_add_test (tc, test_gap_insert_6);
- tcase_add_test (tc, test_gap_insert_7);
- tcase_add_test (tc, test_gap_insert_8);
- tcase_add_test (tc, test_gap_insert_9);
- tcase_add_test (tc, test_gap_insert_10);
- tcase_add_test (tc, test_gap_insert_11);
- suite_add_tcase (s, tc);
-
- tc = tcase_create ("delete_gap");
- tcase_add_test (tc, test_gap_delete_1);
- tcase_add_test (tc, test_gap_delete_2);
- tcase_add_test (tc, test_gap_delete_3);
- tcase_add_test (tc, test_gap_delete_4);
- tcase_add_test (tc, test_gap_delete_5);
- tcase_add_test (tc, test_gap_delete_6);
- tcase_add_test (tc, test_gap_delete_7);
- tcase_add_test (tc, test_gap_delete_8);
- suite_add_tcase (s, tc);
-
- return s;
-}
-
-int
-main (void)
-{
- Suite *s = basic_suite ();
- SRunner *sr = srunner_create (s);
-
- srunner_run_all (sr, CK_ENV);
- int failed = srunner_ntests_failed (sr);
- srunner_free (sr);
- return failed ? EXIT_FAILURE : EXIT_SUCCESS;
-}
+++ /dev/null
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
-def a(x, y, y):
- return t; pass
+++ /dev/null
-;; -*- lexical-binding:t -*-
-
-;; Copyright (C) 2015-2025 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 'cl-lib)
-(require 'subr-x)
-(require 'seq)
-(require 'hi-lock)
-
-\f
-;; +===================================================================================+
-;; | Framework
-;; +===================================================================================+
-
-(defmacro perf-define-constant-test (name &optional doc &rest body)
- (declare (indent 1) (debug (symbol &optional string &rest form)))
- `(progn
- (put ',name 'perf-constant-test t)
- (defun ,name nil ,doc ,@body)))
-
-(defmacro perf-define-variable-test (name args &optional doc &rest body)
- (declare (indent 2) (debug defun))
- (unless (and (consp args)
- (= (length args) 1))
- (error "Function %s should accept exactly one argument." name))
- `(progn
- (put ',name 'perf-variable-test t)
- (defun ,name ,args ,doc ,@body)))
-
-(defmacro perf-define-test-suite (name &rest tests)
- (declare (indent 1))
- `(put ',name 'perf-test-suite
- ,(cons 'list tests)))
-
-(defun perf-constant-test-p (test)
- (get test 'perf-constant-test))
-
-(defun perf-variable-test-p (test)
- (get test 'perf-variable-test))
-
-(defun perf-test-suite-p (suite)
- (not (null (perf-test-suite-elements suite))))
-
-(defun perf-test-suite-elements (suite)
- (get suite 'perf-test-suite))
-
-(defun perf-expand-suites (test-and-suites)
- (apply #' append (mapcar (lambda (elt)
- (if (perf-test-suite-p elt)
- (perf-test-suite-elements elt)
- (list elt)))
- test-and-suites)))
-(defun perf-test-p (symbol)
- (or (perf-variable-test-p symbol)
- (perf-constant-test-p symbol)))
-
-(defun perf-all-tests ()
- (let (result)
- (mapatoms (lambda (symbol)
- (when (and (fboundp symbol)
- (perf-test-p symbol))
- (push symbol result))))
- (sort result #'string-lessp)))
-
-(defvar perf-default-test-argument 4096)
-
-(defun perf-run-1 (&optional k n &rest tests)
- "Run TESTS K times using N as argument for non-constant ones.
-
-Return test-total elapsed time."
- (random "")
- (when (and n (not (numberp n)))
- (push k tests)
- (push n tests)
- (setq n nil k nil))
- (when (and k (not (numberp k)))
- (push k tests)
- (setq k nil))
- (let* ((k (or k 1))
- (n (or n perf-default-test-argument))
- (tests (perf-expand-suites (or tests
- (perf-all-tests))))
- (variable-tests (seq-filter #'perf-variable-test-p tests))
- (constant-tests (seq-filter #'perf-constant-test-p tests))
- (max-test-string-width (perf-max-symbol-length tests)))
- (unless (seq-every-p #'perf-test-p tests)
- (error "Some of these are not tests: %s" tests))
- (cl-labels ((format-result (result)
- (cond
- ((numberp result) (format "%.2f" result))
- ((stringp result) result)
- ((null result) "N/A")))
- (format-test (fn)
- (concat (symbol-name fn)
- (make-string
- (+ (- max-test-string-width
- (length (symbol-name fn)))
- 1)
- ?\s)))
- (format-summary (results _total)
- (let ((min (apply #'min results))
- (max (apply #'max results))
- (avg (/ (apply #'+ results) (float (length results)))))
- (format "n=%d min=%.2f avg=%.2f max=%.2f" (length results) min avg max)))
- (run-test (fn)
- (let ((total 0) results)
- (dotimes (_ (max 0 k))
- (garbage-collect)
- (princ (concat " " (format-test fn)))
- (let ((result (condition-case-unless-debug err
- (cond
- ((perf-variable-test-p fn)
- (random "") (car (funcall fn n)))
- ((perf-constant-test-p fn)
- (random "") (car (funcall fn)))
- (t "skip"))
- (error (error-message-string err)))))
- (when (numberp result)
- (cl-incf total result)
- (push result results))
- (princ (format-result result))
- (terpri)))
- (when (> (length results) 1)
- (princ (concat "#" (format-test fn)
- (format-summary results total)))
- (terpri)))))
- (when variable-tests
- (terpri)
- (dolist (fn variable-tests)
- (run-test fn)
- (terpri)))
- (when constant-tests
- (dolist (fn constant-tests)
- (run-test fn)
- (terpri))))))
-
-(defun perf-run (&optional k n &rest tests)
- (interactive
- (let* ((n (if current-prefix-arg
- (prefix-numeric-value current-prefix-arg)
- perf-default-test-argument))
- (tests (mapcar #'intern
- (completing-read-multiple
- (format "Run tests (n=%d): " n)
- (perf-all-tests) nil t nil 'perf-test-history))))
- (cons 1 (cons n tests))))
- (with-current-buffer (get-buffer-create "*perf-results*")
- (let ((inhibit-read-only t)
- (standard-output (current-buffer)))
- (erase-buffer)
- (apply #'perf-run-1 k n tests)
- (display-buffer (current-buffer)))))
-
-
-(defun perf-batch-parse-command-line (args)
- (let ((k 1)
- (n perf-default-test-argument)
- tests)
- (while args
- (cond ((string-match-p "\\`-[cn]\\'" (car args))
- (unless (and (cdr args)
- (string-match-p "\\`[0-9]+\\'" (cadr args)))
- (error "%s expects a natnum argument" (car args)))
- (if (equal (car args) "-c")
- (setq k (string-to-number (cadr args)))
- (setq n (string-to-number (cadr args))))
- (setq args (cddr args)))
- (t (push (intern (pop args)) tests))))
- (list k n tests)))
-
-
-(defun perf-run-batch ()
- "Runs tests from `command-line-args-left' and kill emacs."
- (let ((standard-output #'external-debugging-output))
- (condition-case err
- (cl-destructuring-bind (k n tests)
- (perf-batch-parse-command-line command-line-args-left)
- (apply #'perf-run-1 k n tests)
- (save-buffers-kill-emacs))
- (error
- (princ (error-message-string err))
- (save-buffers-kill-emacs)))))
-
-(defconst perf-number-of-columns 70)
-
-(defun perf-insert-lines (n)
- "Insert N lines into the current buffer."
- (dotimes (i n)
- (insert (make-string 70 (if (= (% i 2) 0)
- ?.
- ?O))
- ?\n)))
-
-(defun perf-switch-to-buffer-scroll-random (n &optional buffer)
- (interactive)
- (set-window-buffer nil (or buffer (current-buffer)))
- (goto-char (point-min))
- (redisplay t)
- (dotimes (_ n)
- (goto-char (random (point-max)))
- (recenter)
- (redisplay t)))
-
-(defun perf-insert-overlays (n &optional create-callback random-p)
- (if random-p
- (perf-insert-overlays-random n create-callback)
- (perf-insert-overlays-sequential n create-callback)))
-
-(defun perf-insert-overlays-sequential (n &optional create-callback)
- "Insert an overlay every Nth line."
- (declare (indent 1))
- (let ((i 0)
- (create-callback (or create-callback #'ignore)))
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (when (= 0 (% i n))
- (let ((ov (make-overlay (point-at-bol) (point-at-eol))))
- (funcall create-callback ov)
- (overlay-put ov 'priority (random (buffer-size)))))
- (cl-incf i)
- (forward-line)))))
-
-(defun perf-insert-overlays-random (n &optional create-callback)
- "Insert an overlay every Nth line."
- (declare (indent 1))
- (let ((create-callback (or create-callback #'ignore)))
- (save-excursion
- (while (>= (cl-decf n) 0)
- (let* ((beg (1+ (random (point-max))))
- (ov (make-overlay beg (+ beg (random 70)))))
- (funcall create-callback ov)
- (overlay-put ov 'priority (random (buffer-size))))))))
-
-(defun perf-insert-overlays-hierarchical (n &optional create-callback)
- (let ((create-callback (or create-callback #'ignore)))
- (save-excursion
- (goto-char (point-min))
- (let ((spacing (floor (/ (/ (count-lines (point-min) (point-max))
- (float 3))
- n))))
- (when (< spacing 1)
- (error "Hierarchical overlay overflow !!"))
- (dotimes (i n)
- (funcall create-callback
- (make-overlay (point)
- (save-excursion
- (goto-char (point-max))
- (forward-line (- (* spacing i)))
- (point))))
-
- (when (eobp)
- (error "End of buffer in hierarchical overlays"))
- (forward-line spacing))))))
-
-(defun perf-overlay-ascii-chart (&optional buffer width)
- (interactive)
- (save-current-buffer
- (when buffer (set-buffer buffer))
- (unless width (setq width 100))
- (let* ((ovl (sort (overlays-in (point-min) (point-max))
- (lambda (ov1 ov2)
- (or (<= (overlay-start ov1)
- (overlay-start ov2))
- (and
- (= (overlay-start ov1)
- (overlay-start ov2))
- (< (overlay-end ov1)
- (overlay-end ov2)))))))
- (ov-width (apply #'max (mapcar (lambda (ov)
- (- (overlay-end ov)
- (overlay-start ov)))
- ovl)))
- (ov-min (apply #'min (mapcar #'overlay-start ovl)))
- (ov-max (apply #'max (mapcar #'overlay-end ovl)))
- (scale (/ (float width) (+ ov-min ov-width))))
- (with-current-buffer (get-buffer-create "*overlay-ascii-chart*")
- (let ((inhibit-read-only t))
- (erase-buffer)
- (buffer-disable-undo)
- (insert (format "%06d%s%06d\n" ov-min (make-string (- width 12) ?\s) ov-max))
- (dolist (ov ovl)
- (let ((length (round (* scale (- (overlay-end ov)
- (overlay-start ov))))))
- (insert (make-string (round (* scale (overlay-start ov))) ?\s))
- (cl-case length
- (0 (insert "O"))
- (1 (insert "|"))
- (t (insert (format "|%s|" (make-string (- length 2) ?-)))))
- (insert "\n")))
- (goto-char (point-min)))
- (read-only-mode 1)
- (pop-to-buffer (current-buffer))))))
-
-(defconst perf-overlay-faces (mapcar #'intern (seq-take hi-lock-face-defaults 3)))
-
-(defun perf-overlay-face-callback (ov)
- (overlay-put ov 'face (nth (random (length perf-overlay-faces))
- perf-overlay-faces)))
-
-(defun perf-overlay-invisible-callback (ov)
- (overlay-put ov 'invisble (= 1 (random 2))))
-
-(defun perf-overlay-display-callback (ov)
- (overlay-put ov 'display (make-string 70 ?*)))
-
-(defmacro perf-define-display-test (overlay-type property-type scroll-type)
- (let ((name (intern (format "perf-display-%s/%s/%s"
- overlay-type property-type scroll-type)))
- (arg (make-symbol "n")))
-
- `(perf-define-variable-test ,name (,arg)
- (with-temp-buffer
- (perf-insert-lines ,arg)
- (overlay-recenter (point-max))
- ,@(perf-define-display-test-1 arg overlay-type property-type scroll-type)))))
-
-(defun perf-define-display-test-1 (arg overlay-type property-type scroll-type)
- (list (append (cl-case overlay-type
- (sequential
- (list 'perf-insert-overlays-sequential 2))
- (hierarchical
- `(perf-insert-overlays-hierarchical (/ ,arg 10)))
- (random
- `(perf-insert-overlays-random (/ ,arg 2)))
- (t (error "Invalid insert type: %s" overlay-type)))
- (list
- (cl-case property-type
- (display '#'perf-overlay-display-callback)
- (face '#'perf-overlay-face-callback)
- (invisible '#'perf-overlay-invisible-callback)
- (t (error "Invalid overlay type: %s" overlay-type)))))
- (list 'benchmark-run 1
- (cl-case scroll-type
- (scroll '(perf-switch-to-buffer-scroll-up-and-down))
- (random `(perf-switch-to-buffer-scroll-random (/ ,arg 50)))
- (t (error "Invalid scroll type: %s" overlay-type))))))
-
-(defun perf-max-symbol-length (symbols)
- "Return the longest symbol in SYMBOLS, or -1 if symbols is nil."
- (if (null symbols)
- -1
- (apply #'max (mapcar
- (lambda (elt)
- (length (symbol-name elt)))
- symbols))))
-
-(defun perf-insert-text (n)
- "Insert N character into the current buffer."
- (let ((ncols 68)
- (char ?.))
- (dotimes (_ (/ n ncols))
- (insert (make-string (1- ncols) char) ?\n))
- (when (> (% n ncols) 0)
- (insert (make-string (1- (% n ncols)) char) ?\n))))
-
-(defconst perf-insert-overlays-default-length 24)
-
-(defun perf-insert-overlays-scattered (n &optional length)
- "Insert N overlays of max length 24 randomly."
- (dotimes (_ n)
- (let ((begin (random (1+ (point-max)))))
- (make-overlay
- begin (+ begin (random (1+ (or length perf-insert-overlays-default-length 0))))))))
-
-(defvar perf-marker-gc-protection nil)
-
-(defun perf-insert-marker-scattered (n)
- "Insert N marker randomly."
- (setq perf-marker-gc-protection nil)
- (dotimes (_ n)
- (push (copy-marker (random (1+ (point-max))))
- perf-marker-gc-protection)))
-
-(defun perf-switch-to-buffer-scroll-up-and-down (&optional buffer)
- (interactive)
- (set-window-buffer nil (or buffer (current-buffer)))
- (goto-char (point-min))
- (redisplay t)
- (while (condition-case nil
- (progn (scroll-up) t)
- (end-of-buffer nil))
- (redisplay t))
- (while (condition-case nil
- (progn (scroll-down) t)
- (beginning-of-buffer nil))
- (redisplay t)))
-
-(defun perf-emacs-lisp-setup ()
- (add-to-list 'imenu-generic-expression
- '(nil "^\\s-*(perf-define\\(?:\\w\\|\\s_\\)*\\s-*\\(\\(?:\\w\\|\\s_\\)+\\)" 1)))
-
-(add-hook 'emacs-lisp-mode 'perf-emacs-lisp-setup)
-
-\f
-;; +===================================================================================+
-;; | Basic performance tests
-;; +===================================================================================+
-
-(perf-define-variable-test perf-make-overlay (n)
- (with-temp-buffer
- (overlay-recenter (point-min))
- (benchmark-run 1
- (dotimes (_ n)
- (make-overlay 1 1)))))
-
-(perf-define-variable-test perf-make-overlay-continuous (n)
- (with-temp-buffer
- (perf-insert-text n)
- (overlay-recenter (point-max))
- (benchmark-run 1
- (dotimes (i n)
- (make-overlay i (1+ i))))))
-
-(perf-define-variable-test perf-make-overlay-scatter (n)
- (with-temp-buffer
- (perf-insert-text n)
- (benchmark-run 1
- (perf-insert-overlays-scattered n))))
-
-(perf-define-variable-test perf-delete-overlay (n)
- (with-temp-buffer
- (let ((ovls (cl-loop for i from 1 to n
- collect (make-overlay 1 1))))
- (overlay-recenter (point-min))
- (benchmark-run 1
- (mapc #'delete-overlay ovls)))))
-
-(perf-define-variable-test perf-delete-overlay-continuous (n)
- (with-temp-buffer
- (perf-insert-text n)
- (let ((ovls (cl-loop for i from 1 to n
- collect (make-overlay i (1+ i)))))
- (overlay-recenter (point-min))
- (benchmark-run 1
- (mapc #'delete-overlay ovls)))))
-
-(perf-define-variable-test perf-delete-overlay-scatter (n)
- (with-temp-buffer
- (perf-insert-text n)
- (let ((ovls (progn (perf-insert-overlays-scattered n)
- (overlays-in (point-min) (point-max)))))
- (benchmark-run 1
- (mapc #'delete-overlay ovls)))))
-
-(perf-define-variable-test perf-overlays-at (n)
- (with-temp-buffer
- (perf-insert-text n)
- (perf-insert-overlays-scattered n)
- (benchmark-run 1
- (dotimes (i (point-max))
- (overlays-at i)))))
-
-(perf-define-variable-test perf-overlays-in (n)
- (with-temp-buffer
- (perf-insert-text n)
- (perf-insert-overlays-scattered n)
- (let ((len perf-insert-overlays-default-length))
- (benchmark-run 1
- (dotimes (i (- (point-max) len))
- (overlays-in i (+ i len)))))))
-
-(perf-define-variable-test perf-insert-before (n)
- (with-temp-buffer
- (perf-insert-text n)
- (perf-insert-overlays-scattered n)
- (goto-char 1)
- (overlay-recenter (point-min))
- (benchmark-run 1
- (dotimes (_ (/ n 2))
- (insert ?X)))))
-
-(perf-define-variable-test perf-insert-before-empty (n)
- (let ((perf-insert-overlays-default-length 0))
- (perf-insert-before n)))
-(perf-define-variable-test perf-insert-after-empty (n)
- (let ((perf-insert-overlays-default-length 0))
- (perf-insert-after n)))
-(perf-define-variable-test perf-insert-scatter-empty (n)
- (let ((perf-insert-overlays-default-length 0))
- (perf-insert-scatter n)))
-(perf-define-variable-test perf-delete-before-empty (n)
- (let ((perf-insert-overlays-default-length 0))
- (perf-delete-before n)))
-(perf-define-variable-test perf-delete-after-empty (n)
- (let ((perf-insert-overlays-default-length 0))
- (perf-delete-after n)))
-(perf-define-variable-test perf-delete-scatter-empty (n)
- (let ((perf-insert-overlays-default-length 0))
- (perf-delete-scatter n)))
-
-(defmacro perf-define-marker-test (type where)
- (let ((name (intern (format "perf-%s-%s-marker" type where))))
- `(perf-define-variable-test ,name (n)
- (with-temp-buffer
- (perf-insert-text n)
- (perf-insert-marker-scattered n)
- (goto-char ,(cl-case where
- (after (list 'point-max))
- (t (list 'point-min))))
- (benchmark-run 1
- (dotimes (_ (/ n 2))
- ,@(when (eq where 'scatter)
- (list '(goto-char (max 1 (random (point-max))))))
- ,(cl-case type
- (insert (list 'insert ?X))
- (delete (list 'delete-char (if (eq where 'after) -1 1))))))))))
-
-(perf-define-test-suite perf-marker-suite
- (perf-define-marker-test insert before)
- (perf-define-marker-test insert after)
- (perf-define-marker-test insert scatter)
- (perf-define-marker-test delete before)
- (perf-define-marker-test delete after)
- (perf-define-marker-test delete scatter))
-
-(perf-define-variable-test perf-insert-after (n)
- (with-temp-buffer
- (perf-insert-text n)
- (perf-insert-overlays-scattered n)
- (goto-char (point-max))
- (overlay-recenter (point-max))
- (benchmark-run 1
- (dotimes (_ (/ n 2))
- (insert ?X)))))
-
-(perf-define-variable-test perf-insert-scatter (n)
- (with-temp-buffer
- (perf-insert-text n)
- (perf-insert-overlays-scattered n)
- (goto-char (point-max))
- (benchmark-run 1
- (dotimes (_ (/ n 2))
- (goto-char (1+ (random (point-max))))
- (insert ?X)))))
-
-(perf-define-variable-test perf-delete-before (n)
- (with-temp-buffer
- (perf-insert-text n)
- (perf-insert-overlays-scattered n)
- (goto-char 1)
- (overlay-recenter (point-min))
- (benchmark-run 1
- (dotimes (_ (/ n 2))
- (delete-char 1)))))
-
-(perf-define-variable-test perf-delete-after (n)
- (with-temp-buffer
- (perf-insert-text n)
- (perf-insert-overlays-scattered n)
- (goto-char (point-max))
- (overlay-recenter (point-max))
- (benchmark-run 1
- (dotimes (_ (/ n 2))
- (delete-char -1)))))
-
-(perf-define-variable-test perf-delete-scatter (n)
- (with-temp-buffer
- (perf-insert-text n)
- (perf-insert-overlays-scattered n)
- (goto-char (point-max))
- (benchmark-run 1
- (dotimes (_ (/ n 2))
- (goto-char (max 1 (random (point-max))))
- (delete-char 1)))))
-
-(perf-define-test-suite perf-insert-delete-suite
- 'perf-insert-before
- 'perf-insert-after
- 'perf-insert-scatter
- 'perf-delete-before
- 'perf-delete-after
- 'perf-delete-scatter
- )
-
-\f
-;; +===================================================================================+
-;; | Redisplay (new)
-;; +===================================================================================+
-
-;; 5000
-;; 25000
-;; 75000
-
-;; Number of Overlays = N / 2
-;;
-;; (except for the hierarchical case, where it is divided by 10.)
-
- ;; . scrolling through a buffer with lots of overlays that affect faces
- ;; of characters in the buffer text
- ;; . scrolling through a buffer with lots of overlays that define
- ;; 'display' properties which are strings
- ;; . scrolling through a buffer with lots of overlays that define
- ;; 'invisible' properties
-
-(perf-define-test-suite perf-display-suite
- (perf-define-display-test sequential display scroll)
- (perf-define-display-test sequential display random)
- (perf-define-display-test sequential face scroll)
- (perf-define-display-test sequential face random)
- (perf-define-display-test sequential invisible scroll)
- (perf-define-display-test sequential invisible random)
- (perf-define-display-test random display scroll)
- (perf-define-display-test random display random)
- (perf-define-display-test random face scroll)
- (perf-define-display-test random face random)
- (perf-define-display-test random invisible scroll)
- (perf-define-display-test random invisible random))
-
-;; |------------|
-;; |--------|
-;; |----|
-(perf-define-display-test hierarchical face scroll)
-
-
-
-\f
-;; +===================================================================================+
-;; | Real World
-;; +===================================================================================+
-
-(require 'python)
-
-(defconst perf-many-errors-file
- (expand-file-name "many-errors.py"
- (and load-file-name (file-name-directory load-file-name))))
-
-(perf-define-constant-test perf-realworld-flycheck
- (interactive)
- (package-initialize)
- (when (and (require 'flycheck nil t)
- (file-exists-p perf-many-errors-file)
- (or (executable-find "pylint")
- (executable-find "flake8")))
- (setq flycheck-python-pylint-executable
- (executable-find "pylint"))
- (setq flycheck-python-flake8-executable
- (executable-find "flake8"))
- (setq python-indent-guess-indent-offset-verbose nil)
- (setq flycheck-check-syntax-automatically nil)
- (setq flycheck-checker-error-threshold nil)
- (setq flycheck-display-errors-function nil)
- (with-current-buffer (find-file-noselect perf-many-errors-file)
- (let* ((done)
- (flycheck-after-syntax-check-hook
- (list (lambda () (setq done t)))))
- (flycheck-mode 1)
- (flycheck-buffer)
- (benchmark-run 1
- (while (not done)
- (accept-process-output))
- (perf-switch-to-buffer-scroll-up-and-down)
- (flycheck-mode -1))))))
-
-;; https://lists.gnu.org/archive/html/emacs-devel/2009-04/msg00242.html
-(defun make-lines-invisible (regexp &optional arg)
- "Make all lines matching a regexp invisible and intangible.
-With a prefix arg, make it visible again. It is not necessary
-that REGEXP matches the whole line; if a hit is found, the
-affected line gets automatically selected.
-
-This command affects the whole buffer."
- (interactive "MRegexp: \nP")
- (let (ov
- ovs
- count)
- (cond
- ((equal arg '(4))
- (setq ovs (overlays-in (point-min) (point-max)))
- (mapc (lambda (o)
- (if (overlay-get o 'make-lines-invisible)
- (delete-overlay o)))
- ovs))
- (t
- (save-excursion
- (goto-char (point-min))
- (setq count 0)
- (while (re-search-forward regexp nil t)
- (setq count (1+ count))
- (if (= (% count 100) 0)
- (message "%d" count))
- (setq ov (make-overlay (line-beginning-position)
- (1+ (line-end-position))))
- (overlay-put ov 'make-lines-invisible t)
- (overlay-put ov 'invisible t)
- (overlay-put ov 'intangible t)
- (goto-char (line-end-position))))))))
-
-(perf-define-constant-test perf-realworld-make-lines-invisible
- (with-temp-buffer
- (insert-file-contents "/usr/share/dict/words")
- (set-window-buffer nil (current-buffer))
- (redisplay t)
- (overlay-recenter (point-max))
- (benchmark-run 1
- (make-lines-invisible "a"))))
-
-(perf-define-constant-test perf-realworld-line-numbering
- (interactive)
- (with-temp-buffer
- (insert-file-contents "/usr/share/dict/words")
- (overlay-recenter (point-max))
- (goto-char (point-min))
- (let* ((nlines (count-lines (point-min) (point-max)))
- (line 1)
- (width 0))
- (dotimes (i nlines) ;;-with-progress-reporter "Creating overlays"
- (let ((ov (make-overlay (point) (point)))
- (str (propertize (format "%04d" line) 'face 'shadow)))
- (overlay-put ov 'before-string
- (propertize " " 'display `((margin left-margin) ,str)))
- (setq width (max width (length str)))
- (cl-incf line)
- (forward-line)))
- (benchmark-run 1
- (let ((left-margin-width width))
- (perf-switch-to-buffer-scroll-up-and-down))))))
-
-(perf-define-test-suite perf-realworld-suite
- 'perf-realworld-flycheck
- 'perf-realworld-make-lines-invisible
- 'perf-realworld-line-numbering)
-
-\f
-;; +===================================================================================+
-;; | next-overlay-change
-;; +===================================================================================+
-
-(perf-define-variable-test perf-noc-hierarchical/forward/linear (n)
- "Search linear for the next change on every line."
- (with-temp-buffer
- (perf-insert-lines (* 3 n))
- (perf-insert-overlays-hierarchical n)
- (goto-char (point-min))
- (benchmark-run 1
- (while (not (eobp))
- (next-overlay-change (point))
- (forward-line)))))
-
-(perf-define-variable-test perf-noc-sequential/forward/linear (n)
- "Search linear for the next change on every line."
- (with-temp-buffer
- (perf-insert-lines (* 3 n))
- (perf-insert-overlays-sequential n)
- (goto-char (point-min))
- (benchmark-run 1
- (while (not (eobp))
- (next-overlay-change (point))
- (forward-line)))))
-
-(perf-define-variable-test perf-noc-hierarchical/forward/backnforth (n)
- "Search back and forth for the next change from `point-min' to `point-max'."
- (with-temp-buffer
- (perf-insert-lines (* 3 n))
- (overlay-recenter (point-max))
- (perf-insert-overlays-hierarchical n)
- (goto-char (point-min))
- (benchmark-run 1
- (while (not (eobp))
- (next-overlay-change (point))
- (next-overlay-change (+ (point) 2))
- (forward-char)))))
-
-(perf-define-test-suite perf-noc-suite
- 'perf-noc-hierarchical/forward/linear
- 'perf-noc-hierarchical/forward/backnforth
- 'perf-noc-hierarchical/forward/backnforth)
projects / emacs.git / commitdiff