[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/comp-static-data 7d35d66c8e: Merge branch 'master' into scratch/
|
From: |
Vibhav Pant |
|
Subject: |
scratch/comp-static-data 7d35d66c8e: Merge branch 'master' into scratch/comp-static-data |
|
Date: |
Thu, 17 Nov 2022 03:13:16 -0500 (EST) |
branch: scratch/comp-static-data
commit 7d35d66c8e59190d8358d977c470af31716ffc63
Merge: 821471c887 623db40dd1
Author: Vibhav Pant <vibhavp@gmail.com>
Commit: Vibhav Pant <vibhavp@gmail.com>
Merge branch 'master' into scratch/comp-static-data
---
.clang-format | 16 +-
.dir-locals.el | 3 +-
doc/emacs/maintaining.texi | 7 +
doc/emacs/mark.texi | 17 +-
doc/misc/auth.texi | 18 ++
doc/misc/erc.texi | 31 ++-
etc/ERC-NEWS | 7 +
etc/NEWS | 36 ++++
lisp/apropos.el | 3 +-
lisp/auth-source-pass.el | 112 +++++++++-
lisp/bookmark.el | 4 +-
lisp/buff-menu.el | 54 ++++-
lisp/dynamic-setting.el | 18 +-
lisp/emacs-lisp/seq.el | 126 +++++------
lisp/erc/erc-backend.el | 140 +++++++++++--
lisp/erc/erc-common.el | 3 +
lisp/erc/erc-compat.el | 145 +++++++++++++
lisp/erc/erc-networks.el | 9 +-
lisp/erc/erc-pcomplete.el | 4 +
lisp/erc/erc.el | 241 ++++++++++++++-------
lisp/faces.el | 13 +-
lisp/gnus/nnrss.el | 6 +-
lisp/keymap.el | 52 ++++-
lisp/ldefs-boot.el | 156 ++++++++++++--
lisp/leim/quail/japanese.el | 2 +-
lisp/net/browse-url.el | 24 +++
lisp/net/eudc-capf.el | 11 +-
lisp/org/ol.el | 2 +-
lisp/org/org-faces.el | 2 +-
lisp/progmodes/eglot.el | 7 +-
lisp/progmodes/elisp-mode.el | 37 ++--
lisp/progmodes/project.el | 23 ++
lisp/progmodes/xref.el | 7 +-
lisp/repeat.el | 41 ++--
lisp/server.el | 12 +-
lisp/simple.el | 7 +-
lisp/subr.el | 2 +-
lisp/url/url-irc.el | 32 ++-
lisp/vc/vc.el | 2 +-
src/comp.c | 2 +-
src/frame.c | 35 +++-
src/ftcrfont.c | 38 +++-
src/ftfont.h | 7 +
src/haikufns.c | 17 +-
src/itree.c | 228 ++++++++++----------
src/nsfns.m | 17 +-
src/pgtkfns.c | 17 +-
src/w32fns.c | 17 +-
src/xfns.c | 25 ++-
src/xsettings.c | 2 +
src/xterm.c | 79 +++++--
src/xterm.h | 2 +-
test/lisp/auth-source-pass-tests.el | 267 +++++++++++++++++++++++-
test/lisp/erc/erc-dcc-tests.el | 3 +-
test/lisp/erc/erc-networks-tests.el | 17 ++
test/lisp/erc/erc-scenarios-base-reconnect.el | 46 ++++
test/lisp/erc/erc-scenarios-misc.el | 28 +++
test/lisp/erc/erc-services-tests.el | 3 -
test/lisp/erc/erc-tests.el | 225 ++++++++++++++++++++
test/lisp/erc/resources/erc-d/erc-d-tests.el | 1 +
test/lisp/erc/resources/erc-scenarios-common.el | 3 +-
test/lisp/erc/resources/join/legacy/foonet.eld | 2 +-
test/lisp/net/browse-url-tests.el | 9 +
test/lisp/server-tests.el | 41 ++++
test/src/buffer-tests.el | 87 ++++----
65 files changed, 2142 insertions(+), 508 deletions(-)
diff --git a/.clang-format b/.clang-format
index 464375bd41..2208240a66 100644
--- a/.clang-format
+++ b/.clang-format
@@ -1,15 +1,18 @@
Language: Cpp
BasedOnStyle: GNU
AlignEscapedNewlinesLeft: true
+AlignOperands: Align
AlwaysBreakAfterReturnType: TopLevelDefinitions
BreakBeforeBinaryOperators: All
BreakBeforeBraces: GNU
ColumnLimit: 70
ContinuationIndentWidth: 2
-ForEachMacros: [FOR_EACH_TAIL,
- FOR_EACH_TAIL_SAFE,
- FOR_EACH_LIVE_BUFFER,
- ITREE_FOREACH]
+ForEachMacros:
+ - FOR_EACH_TAIL
+ - FOR_EACH_TAIL_SAFE
+ - FOR_EACH_LIVE_BUFFER
+ - ITREE_FOREACH
+ - FOR_EACH_ALIST_VALUE
IncludeCategories:
- Regex: '^<config\.h>$'
Priority: -1
@@ -19,6 +22,11 @@ IncludeCategories:
Priority: 2
- Regex: '.*'
Priority: 3
+WhitespaceSensitiveMacros:
+ - STR
+ - CALL1I
+ - CALL2I
+ - STR_VALUE
KeepEmptyLinesAtTheStartOfBlocks: false
MaxEmptyLinesToKeep: 1
PenaltyBreakBeforeFirstCallParameter: 2000
diff --git a/.dir-locals.el b/.dir-locals.el
index a85769b534..f0ab46236f 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -7,7 +7,8 @@
(emacs-lisp-docstring-fill-column . 65)
(vc-git-annotate-switches . "-w")
(bug-reference-url-format . "https://debbugs.gnu.org/%s";)
- (diff-add-log-use-relative-names . t)))
+ (diff-add-log-use-relative-names . t)
+ (vc-prepare-patches-separately . nil)))
(c-mode . ((c-file-style . "GNU")
(c-noise-macro-names . ("INLINE" "NO_INLINE"
"ATTRIBUTE_NO_SANITIZE_UNDEFINED"
"UNINIT" "CALLBACK" "ALIGN_STACK"))
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 3e03bd817a..44e9e1896f 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -1832,6 +1832,8 @@ directory. @xref{Top,Eshell,Eshell, eshell, Eshell: The
Emacs Shell}.
@item C-x p b
Switch to another buffer belonging to the current project
(@code{project-switch-to-buffer}).
+@item C-x p C-b
+List the project buffers (@code{project-list-buffers}).
@item C-x p k
Kill all live buffers that belong to the current project
(@code{project-kill-buffers}).
@@ -1847,6 +1849,11 @@ switch between buffers that belong to the current
project by prompting
for a buffer to switch and considering only the current project's
buffers as candidates for completion.
+@findex project-list-buffers
+ Like the command @code{list-buffers} (@pxref{List Buffers}), the
+command @kbd{C-x p C-b} (@code{project-list-buffers}) displays a list
+of existing buffers, but only belonging to the current project.
+
@findex project-kill-buffers
@vindex project-kill-buffer-conditions
@vindex project-kill-buffers-display-buffer-list
diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi
index db96093a17..5472a288d1 100644
--- a/doc/emacs/mark.texi
+++ b/doc/emacs/mark.texi
@@ -50,10 +50,10 @@ Ring}. Additionally, some commands will have an effect
even on an
inactive region (for example @dfn{upcase-region}). You can also
reactivate the region with commands like @kbd{C-x C-x}.
- The above default behavior is known as Transient Mark mode.
-Disabling Transient Mark mode switches Emacs to an alternative
-behavior, in which the region is usually not highlighted.
-@xref{Disabled Transient Mark}.
+ The above behavior, which is the default in interactive sessions, is
+known as Transient Mark mode. Disabling Transient Mark mode switches
+Emacs to an alternative behavior, in which the region is usually not
+highlighted. @xref{Disabled Transient Mark}.
@vindex highlight-nonselected-windows
Setting the mark in one buffer has no effect on the marks in other
@@ -455,10 +455,11 @@ motion keys will extend the region set by shift-selection.
The default behavior of the mark and region, in which setting the
mark activates it and highlights the region, is called Transient Mark
-mode. This is a minor mode that is enabled by default. It can be
-toggled with @kbd{M-x transient-mark-mode}, or with the
-@samp{Highlight Active Region} menu item in the @samp{Options} menu.
-Turning it off switches Emacs to an alternative mode of operation:
+mode. This is a minor mode that is enabled by default in interactive
+sessions. It can be toggled with @kbd{M-x transient-mark-mode}, or
+with the @samp{Highlight Active Region} menu item in the
+@samp{Options} menu. Turning it off switches Emacs to an alternative
+mode of operation:
@itemize @bullet
@item
diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi
index 9dc63af6bc..872e5f88f5 100644
--- a/doc/misc/auth.texi
+++ b/doc/misc/auth.texi
@@ -526,6 +526,8 @@ If several entries match, the one matching the most items
(where an
while searching for an entry matching the @code{rms} user on host
@code{gnu.org} and port @code{22}, then the entry
@file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}.
+However, such processing is not applied when the option
+@code{auth-source-pass-extra-parameters} is set to @code{t}.
Users of @code{pass} may also be interested in functionality provided
by other Emacs packages:
@@ -549,6 +551,22 @@ Set this variable to a string that should separate an host
name from a
port in an entry. Defaults to @samp{:}.
@end defvar
+@defvar auth-source-pass-extra-query-keywords
+This expands the selection of available keywords to include
+@code{:max} and @code{:require} and tells more of them to accept a
+list of query parameters as an argument. When searching, it also
+favors the @samp{rms@@gnu.org.gpg} form for usernames over the
+@samp{gnu.org/rms.gpg} form, regardless of whether a @code{:user}
+param was provided.
+
+In general, if you prefer idiosyncrasies traditionally exhibited by
+this backend, such as prioritizing field count in a filename, try
+setting this option to @code{nil}. But, if you experience problems
+predicting the outcome of searches relative to other auth-source
+backends or encounter code expecting to query multiple backends
+uniformly, try flipping it back to @code{t} (the default).
+@end defvar
+
@node Help for developers
@chapter Help for developers
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index 3db83197f9..0d807e323e 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -79,6 +79,7 @@ Advanced Usage
* Connecting:: Ways of connecting to an IRC server.
* Sample Configuration:: An example configuration file.
+* Integrations:: Integrations available for ERC.
* Options:: Options that are available for ERC.
@end detailmenu
@@ -526,6 +527,7 @@ Translate morse code in messages
@menu
* Connecting:: Ways of connecting to an IRC server.
* Sample Configuration:: An example configuration file.
+* Integrations:: Integrations available for ERC.
* Options:: Options that are available for ERC.
@end menu
@@ -861,7 +863,8 @@ The default value for all three options is the function
@code{erc-auth-source-search}. It tries to merge relevant contextual
parameters with those provided or discovered from the logical connection
or the underlying transport. Some auth-source back ends may not be
-compatible; netrc, plstore, json, and secrets are currently supported.
+compatible; netrc, plstore, json, secrets, and pass are currently
+supported.
@end defopt
@subheading Full name
@@ -990,6 +993,32 @@ stuff, to the current ERC buffer."
;; (setq erc-kill-server-buffer-on-quit t)
@end lisp
+@node Integrations
+@section Integrations
+@cindex integrations
+
+@subheading URL
+For anything to work, you'll want to set @code{url-irc-function} to
+@code{url-irc-erc}. As a rule of thumb, libraries relying directly on
+@code{url-retrieve} should be fine out the box from Emacs 29.1 onward.
+On older versions of Emacs, you may need to @code{(require 'erc)}
+beforehand. @pxref{Retrieving URLs,,, url, URL}.
+
+For other apps and libraries, such as those relying on the
+higher-level @code{browse-url}, you'll oftentimes be asked to specify
+a pattern, sometimes paired with a function that accepts a string URL
+as a first argument. For example, with EWW, you may need to tack
+something like @code{"\\|\\`irc6?s?:"} onto the end of
+@code{eww-use-browse-url}. But with @code{gnus-button-alist}, you'll
+need a function as well:
+
+@lisp
+ '("\\birc6?s?://[][a-z0-9.,@@_:+%?&/#-]+" 0 t browse-url-irc 0)
+@end lisp
+
+@noindent
+Users on Emacs 28 and below may need to use @code{browse-url} instead.
+
@node Options
@section Options
@cindex options
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 5cabb9b015..f638d4717a 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -77,6 +77,13 @@ blanks when 'erc-send-whitespace-lines' is active. New
options have
also been added for warning when input spans multiple lines. Although
off by default, new users are encouraged to enable them.
+** URL handling has improved.
+Clicking on 'irc://' and 'ircs://' links elsewhere in Emacs now does
+the right thing most of the time. However, for security reasons,
+users are now prompted to confirm connection parameters prior to lift
+off. See the new '(erc) Integrations' section in the Info manual to
+override this.
+
** Miscellaneous behavioral changes impacting the user experience.
A bug has been fixed that saw prompts being mangled, doubled, or
erased in server buffers upon disconnection. Instead, input prompts
diff --git a/etc/NEWS b/etc/NEWS
index 7cd192b9d3..47fc9f1e8e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -439,6 +439,12 @@ The user options 'url-gateway-rlogin-host',
'url-gateway-rlogin-parameters', and 'url-gateway-rlogin-user-name'
are also obsolete.
+---
+** The user function 'url-irc-function' now takes a 'scheme' argument.
+The user option 'url-irc-function' is now called with a sixth argument
+corresponding to the scheme portion of the target URL. For example,
+this would be "ircs" for a URL like "ircs://irc.libera.chat".
+
---
** The linum.el library is now obsolete.
We recommend using either the built-in 'display-line-numbers-mode', or
@@ -1395,6 +1401,14 @@ If non-nil and there's only one matching option,
auto-select that.
If non-nil, this user option describes what entries not to add to the
database stored on disk.
+** Auth-Source
+
++++
+*** New user option 'auth-source-pass-extra-query-keywords'.
+Whether to recognize additional keyword params, like ':max' and
+':require', as well as accept lists of query terms paired with
+applicable keywords.
+
** Dired
+++
@@ -2212,6 +2226,10 @@ it with new 'term-{faint,italic,slow-blink,fast-blink}'
faces.
*** 'project-find-file' and 'project-or-external-find-file' now accept
a prefix argument which is interpreted to mean "include all files".
++++
+*** New command 'project-list-buffers' bound to 'C-x p C-b'.
+This command displays a list of buffers from the current project.
+
+++
*** 'project-kill-buffers' can display the list of buffers to kill.
Customize the user option 'project-kill-buffers-display-buffer-list'
@@ -2630,6 +2648,17 @@ This user option decides which URL scheme that
'browse-url' and
related functions will use by default. For example, you could
customize this to "https" to always prefer HTTPS URLs.
+---
+*** New user option 'browse-url-irc-function'.
+This option specifies a function for opening irc:// links. It
+defaults to the new function 'browse-url-irc'.
+
+---
+*** New function 'browse-url-irc'.
+This multipurpose autoloaded function can be used for opening irc://
+and ircs:// URLS by any caller that passes a URL string as an initial
+arg.
+
---
*** Support for the Netscape web browser has been removed.
This support has been obsolete since Emacs 25.1. The final version of
@@ -2856,6 +2885,9 @@ remote host are shown. Alternatively, the user option
*** 'outlineify-sticky' command is renamed to 'allout-outlinify-sticky'.
The old name is still available as an obsolete function alias.
+---
+*** The url-irc library now understands ircs:// links.
+
---
*** New command 'world-clock-copy-time-as-kill' for 'M-x world-clock'.
It copies the current line into the kill ring.
@@ -4043,6 +4075,10 @@ This function allows defining a number of keystrokes
with one form.
** New macro 'defvar-keymap'.
This macro allows defining keymap variables more conveniently.
+** 'repeat-map' can be defined in the macro 'defvar-keymap'.
+This is possible either by using ':repeat t' or more advanced
+':repeat (:enter (commands ...) :exit (commands ...))'.
+
---
** 'kbd' can now be used in built-in, preloaded libraries.
It no longer depends on edmacro.el and cl-lib.el.
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 62a37df820..d9d8f4c372 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -651,7 +651,8 @@ while a list of strings is used as a word list."
(defun apropos (pattern &optional do-all)
"Show all meaningful Lisp symbols whose names match PATTERN.
Symbols are shown if they are defined as functions, variables, or
-faces, or if they have nonempty property lists.
+faces, or if they have nonempty property lists, or if they are
+known keywords.
PATTERN can be a word, a list of words (separated by spaces),
or a regexp (using some regexp special characters). If it is a word,
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index 0955e2ed07..dc274843e1 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -55,13 +55,27 @@
:type 'string
:version "27.1")
+(defcustom auth-source-pass-extra-query-keywords t
+ "Whether to consider additional keywords when performing a query.
+Specifically, when the value is t, recognize the `:max' and
+`:require' keywords and accept lists of query parameters for
+certain keywords, such as `:host' and `:user'. Also, wrap all
+returned secrets in a function and forgo any further results
+filtering unless given an applicable `:require' argument. When
+this option is nil, do none of that, and enact the narrowing
+behavior described toward the bottom of the Info node `(auth) The
+Unix password store'."
+ :type 'boolean
+ :version "29.1")
+
(cl-defun auth-source-pass-search (&rest spec
&key backend type host user port
+ require max
&allow-other-keys)
"Given some search query, return matching credentials.
See `auth-source-search' for details on the parameters SPEC, BACKEND, TYPE,
-HOST, USER and PORT."
+HOST, USER, PORT, REQUIRE, and MAX."
(cl-assert (or (null type) (eq type (oref backend type)))
t "Invalid password-store search: %s %s")
(cond ((eq host t)
@@ -70,6 +84,8 @@ HOST, USER and PORT."
((null host)
;; Do not build a result, as none will match when HOST is nil
nil)
+ (auth-source-pass-extra-query-keywords
+ (auth-source-pass--build-result-many host port user require max))
(t
(when-let ((result (auth-source-pass--build-result host port user)))
(list result)))))
@@ -89,6 +105,39 @@ HOSTS can be a string or a list of strings."
(seq-subseq retval 0 -2)) ;; remove
password
retval))))
+(defvar auth-source-pass--match-regexp nil)
+
+(defun auth-source-pass--match-regexp (s)
+ (rx-to-string ; autoloaded
+ `(: (or bot "/")
+ (or (: (? (group-n 20 (+ (not (in ?\ ?/ ?@ ,s)))) "@")
+ (group-n 10 (+ (not (in ?\ ?/ ?@ ,s))))
+ (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s))))))
+ (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s))))
+ (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s)))))
+ (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s)))))))
+ eot)
+ 'no-group))
+
+(defun auth-source-pass--build-result-many (hosts ports users require max)
+ "Return multiple `auth-source-pass--build-result' values."
+ (unless (listp hosts) (setq hosts (list hosts)))
+ (unless (listp users) (setq users (list users)))
+ (unless (listp ports) (setq ports (list ports)))
+ (let* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp
+ auth-source-pass-port-separator))
+ (rv (auth-source-pass--find-match-many hosts users ports
+ require (or max 1))))
+ (when auth-source-debug
+ (auth-source-pass--do-debug "final result: %S" rv))
+ (let (out)
+ (dolist (e rv out)
+ (when-let* ((s (plist-get e :secret)) ; not captured by closure in 29.1
+ (v (auth-source--obfuscate s)))
+ (setf (plist-get e :secret)
+ (lambda () (auth-source--deobfuscate v))))
+ (push e out)))))
+
;;;###autoload
(defun auth-source-pass-enable ()
"Enable auth-source-password-store."
@@ -206,6 +255,67 @@ HOSTS can be a string or a list of strings."
hosts
(list hosts))))
+(defun auth-source-pass--retrieve-parsed (seen path port-number-p)
+ (when (string-match auth-source-pass--match-regexp path)
+ (puthash path
+ `( :host ,(or (match-string 10 path) (match-string 11 path))
+ ,@(if-let* ((tr (match-string 21 path)))
+ (list :user tr :suffix t)
+ (list :user (match-string 20 path)))
+ :port ,(and-let* ((p (or (match-string 30 path)
+ (match-string 31 path)))
+ (n (string-to-number p)))
+ (if (or (zerop n) (not port-number-p))
+ (format "%s" p)
+ n)))
+ seen)))
+
+(defun auth-source-pass--match-parts (parts key value require)
+ (let ((mv (plist-get parts key)))
+ (if (memq key require)
+ (and value (equal mv value))
+ (or (not value) (not mv) (equal mv value)))))
+
+(defun auth-source-pass--find-match-many (hosts users ports require max)
+ "Return plists for valid combinations of HOSTS, USERS, PORTS."
+ (let ((seen (make-hash-table :test #'equal))
+ (entries (auth-source-pass-entries))
+ out suffixed suffixedp)
+ (catch 'done
+ (dolist (host hosts out)
+ (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host)))
+ (unless (or (not (equal "443" p)) (string-prefix-p "https://"; host))
+ (setq p nil))
+ (dolist (user (or users (list u)))
+ (dolist (port (or ports (list p)))
+ (dolist (e entries)
+ (when-let*
+ ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed
+ seen e (integerp port))))
+ ((equal host (plist-get m :host)))
+ ((auth-source-pass--match-parts m :port port require))
+ ((auth-source-pass--match-parts m :user user require))
+ (parsed (auth-source-pass-parse-entry e))
+ ;; For now, ignore body-content pairs, if any,
+ ;; from `auth-source-pass--parse-data'.
+ (secret (or (auth-source-pass--get-attr 'secret parsed)
+ (not (memq :secret require)))))
+ (push
+ `( :host ,host ; prefer user-provided :host over h
+ ,@(and-let* ((u (plist-get m :user))) (list :user u))
+ ,@(and-let* ((p (plist-get m :port))) (list :port p))
+ ,@(and secret (not (eq secret t)) (list :secret secret)))
+ (if (setq suffixedp (plist-get m :suffix)) suffixed out))
+ (unless suffixedp
+ (when (or (zerop (cl-decf max))
+ (null (setq entries (delete e entries))))
+ (throw 'done out)))))
+ (setq suffixed (nreverse suffixed))
+ (while suffixed
+ (push (pop suffixed) out)
+ (when (zerop (cl-decf max))
+ (throw 'done out))))))))))
+
(defun auth-source-pass--disambiguate (host &optional user port)
"Return (HOST USER PORT) after disambiguation.
Disambiguate between having user provided inside HOST (e.g.,
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index b57ad12986..15e7273f91 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -365,8 +365,8 @@ BOOKMARK-RECORD is, e.g., one element from
`bookmark-alist'."
(car bookmark-record))
(defun bookmark-type-from-full-record (bookmark-record)
- "Return then type of BOOKMARK-RECORD.
-BOOKMARK-RECORD is, e.g., one element from `bookmark-alist'. It's
+ "Return the type of BOOKMARK-RECORD.
+BOOKMARK-RECORD is, e.g., one element from `bookmark-alist'. Its
type is read from the symbol property named
`bookmark-handler-type' read on the record handler function."
(let ((handler (bookmark-get-handler bookmark-record)))
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index abf152f058..aa5f70edf2 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -1,7 +1,6 @@
;;; buff-menu.el --- Interface for viewing and manipulating buffers -*-
lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1993-1995, 2000-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
@@ -101,6 +100,13 @@ as it is by default."
This is set by the prefix argument to `buffer-menu' and related
commands.")
+(defvar-local Buffer-menu-filter-predicate nil
+ "Function to filter out buffers in the buffer list.
+Buffers that don't satisfy the predicate will be skipped.
+The value should be a function of one argument; it will be
+called with the buffer. If this function returns non-nil,
+then the buffer will be displayed in the buffer list.")
+
(defvar-keymap Buffer-menu-mode-map
:doc "Local keymap for `Buffer-menu-mode' buffers."
:parent tabulated-list-mode-map
@@ -133,10 +139,12 @@ commands.")
"M-s a C-s" #'Buffer-menu-isearch-buffers
"M-s a C-M-s" #'Buffer-menu-isearch-buffers-regexp
"M-s a C-o" #'Buffer-menu-multi-occur
-
"<mouse-2>" #'Buffer-menu-mouse-select
"<follow-link>" 'mouse-face)
+(put 'Buffer-menu-delete :advertised-binding "d")
+(put 'Buffer-menu-this-window :advertised-binding "f")
+
(easy-menu-define Buffer-menu-mode-menu Buffer-menu-mode-map
"Menu for `Buffer-menu-mode' buffers."
'("Buffer-Menu"
@@ -236,6 +244,26 @@ In Buffer Menu mode, the following commands are defined:
(lambda (&optional _noconfirm) 'fast))
(add-hook 'tabulated-list-revert-hook 'list-buffers--refresh nil t))
+(defun buffer-menu--display-help ()
+ (message "%s"
+ (substitute-command-keys
+ (concat
+ "Commands: "
+ "\\<Buffer-menu-mode-map>"
+ "\\[Buffer-menu-delete], "
+ "\\[Buffer-menu-save], "
+ "\\[Buffer-menu-execute], "
+ "\\[Buffer-menu-unmark]; "
+ "\\[Buffer-menu-this-window], "
+ "\\[Buffer-menu-other-window], "
+ "\\[Buffer-menu-1-window], "
+ "\\[Buffer-menu-2-window], "
+ "\\[Buffer-menu-mark], "
+ "\\[Buffer-menu-select]; "
+ "\\[Buffer-menu-not-modified], "
+ "\\[Buffer-menu-toggle-read-only]; "
+ "\\[quit-window] to quit; \\[describe-mode] for help"))))
+
(defun buffer-menu (&optional arg)
"Switch to the Buffer Menu.
By default, the Buffer Menu lists all buffers except those whose
@@ -261,8 +289,7 @@ the `Buffer-menu-name-width', `Buffer-menu-size-width' and
`Buffer-menu-mode-width' variables."
(interactive "P")
(switch-to-buffer (list-buffers-noselect arg))
- (message
- "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
+ (buffer-menu--display-help))
(defun buffer-menu-other-window (&optional arg)
"Display the Buffer Menu in another window.
@@ -273,8 +300,7 @@ with a space (which are for internal use). With prefix
argument
ARG, show only buffers that are visiting files."
(interactive "P")
(switch-to-buffer-other-window (list-buffers-noselect arg))
- (message
- "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
+ (buffer-menu--display-help))
;;;###autoload
(defun list-buffers (&optional arg)
@@ -597,19 +623,23 @@ This behaves like invoking \\[read-only-mode] in that
buffer."
;;; Functions for populating the Buffer Menu.
;;;###autoload
-(defun list-buffers-noselect (&optional files-only buffer-list)
+(defun list-buffers-noselect (&optional files-only buffer-list
filter-predicate)
"Create and return a Buffer Menu buffer.
This is called by `buffer-menu' and others as a subroutine.
If FILES-ONLY is non-nil, show only file-visiting buffers.
If BUFFER-LIST is non-nil, it should be a list of buffers; it
-means list those buffers and no others."
+means list those buffers and no others.
+If FILTER-PREDICATE is non-nil, it should be a function
+that filters out buffers from the list of buffers.
+See more at `Buffer-menu-filter-predicate'."
(let ((old-buffer (current-buffer))
(buffer (get-buffer-create "*Buffer List*")))
(with-current-buffer buffer
(Buffer-menu-mode)
(setq Buffer-menu-files-only
(and files-only (>= (prefix-numeric-value files-only) 0)))
+ (setq Buffer-menu-filter-predicate filter-predicate)
(list-buffers--refresh buffer-list old-buffer)
(tabulated-list-print))
buffer))
@@ -631,6 +661,8 @@ means list those buffers and no others."
(marked-buffers (Buffer-menu-marked-buffers))
(buffer-menu-buffer (current-buffer))
(show-non-file (not Buffer-menu-files-only))
+ (filter-predicate (and (functionp Buffer-menu-filter-predicate)
+ Buffer-menu-filter-predicate))
entries name-width)
;; Collect info for each buffer we're interested in.
(dolist (buffer (or buffer-list
@@ -644,7 +676,9 @@ means list those buffers and no others."
(and (or (not (string= (substring name 0 1) " "))
file)
(not (eq buffer buffer-menu-buffer))
- (or file show-non-file))))
+ (or file show-non-file)
+ (or (not filter-predicate)
+ (funcall filter-predicate buffer)))))
(push (list buffer
(vector (cond
((eq buffer old-buffer) ".")
diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el
index 8ac9a1e9e6..ee6d1ceb35 100644
--- a/lisp/dynamic-setting.el
+++ b/lisp/dynamic-setting.el
@@ -51,19 +51,11 @@ the current form for the frame (i.e. hinting or somesuch
changed)."
;; Set the font on all current and future frames, as though
;; the `default' face had been "set for this session":
(set-frame-font new-font nil frame-list)
- ;; Just redraw the existing fonts on all frames:
- (dolist (f frame-list)
- (let ((frame-font
- (or (font-get (face-attribute 'default :font f 'default)
- :user-spec)
- (frame-parameter f 'font-parameter))))
- (when frame-font
- (set-frame-parameter f 'font-parameter frame-font)
- (set-face-attribute 'default f
- :width 'normal
- :weight 'normal
- :slant 'normal
- :font frame-font))))))))
+ ;; Just reconsider the existing fonts on all frames on each
+ ;; display, by clearing the font and face caches. This will
+ ;; cause all fonts to be recreated.
+ (dolist (frame frame-list)
+ (reconsider-frame-fonts frame))))))
(defun dynamic-setting-handle-config-changed-event (event)
"Handle config-changed-event on the display in EVENT.
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 82ade0ac0c..1645da2eb0 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -63,8 +63,7 @@
;; preloaded. See also Bug#39761#26.
(defmacro seq-doseq (spec &rest body)
- "Loop over a sequence.
-Evaluate BODY with VAR bound to each element of SEQUENCE, in turn.
+ "Loop over a SEQUENCE, evaluating BODY with VAR bound to each of its
elements.
Similar to `dolist' but can be applied to lists, strings, and vectors.
@@ -95,7 +94,7 @@ name to be bound to the rest of SEQUENCE."
,@body))
(defmacro seq-setq (args sequence)
- "Assign to the variables in ARGS the elements of SEQUENCE.
+ "Assign the elements of SEQUENCE to the variables in ARGS.
ARGS can also include the `&rest' marker followed by a variable
name to be bound to the rest of SEQUENCE."
@@ -105,7 +104,7 @@ name to be bound to the rest of SEQUENCE."
;;; Basic seq functions that have to be implemented by new sequence types
(cl-defgeneric seq-elt (sequence n)
- "Return Nth element of SEQUENCE."
+ "Return the Nth element of SEQUENCE."
(elt sequence n))
;; Default gv setters for `seq-elt'.
@@ -118,7 +117,7 @@ name to be bound to the rest of SEQUENCE."
(setcar (nthcdr n sequence) store))
(cl-defgeneric seq-length (sequence)
- "Return the number of elements of SEQUENCE."
+ "Return the number of elements in SEQUENCE."
(length sequence))
(defun seq-first (sequence)
@@ -126,11 +125,12 @@ name to be bound to the rest of SEQUENCE."
(seq-elt sequence 0))
(defun seq-rest (sequence)
- "Return a sequence of the elements of SEQUENCE except the first one."
+ "Return SEQUENCE with its first element removed."
(seq-drop sequence 1))
(cl-defgeneric seq-do (function sequence)
- "Apply FUNCTION to each element of SEQUENCE, presumably for side effects.
+ "Apply FUNCTION to each element of SEQUENCE.
+Presumably, FUNCTION has useful side effects.
Return SEQUENCE."
(mapc function sequence))
@@ -216,8 +216,9 @@ the sequence, and its index within the sequence."
(mapcar function sequence))
(cl-defgeneric seq-mapn (function sequence &rest sequences)
- "Like `seq-map' but FUNCTION is mapped over all SEQUENCES.
-The arity of FUNCTION must match the number of SEQUENCES, and the
+ "Return the result of applying FUNCTION to each element of SEQUENCEs.
+Like `seq-map', but FUNCTION is mapped over all SEQUENCEs.
+The arity of FUNCTION must match the number of SEQUENCEs, and the
mapping stops on the shortest sequence.
Return a list of the results.
@@ -232,7 +233,7 @@ Return a list of the results.
(nreverse result)))
(cl-defgeneric seq-drop (sequence n)
- "Remove the first N elements of SEQUENCE and return the result.
+ "Remove the first N elements of SEQUENCE and return the resulting sequence.
The result is a sequence of the same type as SEQUENCE.
If N is a negative integer or zero, SEQUENCE is returned."
@@ -243,7 +244,7 @@ If N is a negative integer or zero, SEQUENCE is returned."
;;;###autoload
(cl-defgeneric seq-take (sequence n)
- "Take the first N elements of SEQUENCE and return the result.
+ "Return the sequence made of the first N elements of SEQUENCE.
The result is a sequence of the same type as SEQUENCE.
If N is a negative integer or zero, an empty sequence is
@@ -252,14 +253,17 @@ returned."
(cl-defgeneric seq-drop-while (pred sequence)
"Remove the successive elements of SEQUENCE for which PRED returns non-nil.
-PRED is a function of one argument. The result is a sequence of
-the same type as SEQUENCE."
+PRED is a function of one argument. The function keeps removing
+elements from SEQUENCE until PRED returns nil for an element.
+Value is a sequence of the same type as SEQUENCE."
(seq-drop sequence (seq--count-successive pred sequence)))
(cl-defgeneric seq-take-while (pred sequence)
"Take the successive elements of SEQUENCE for which PRED returns non-nil.
-PRED is a function of one argument. The result is a sequence of
-the same type as SEQUENCE."
+PRED is a function of one argument. The function keeps collecting
+elements from SEQUENCE and adding them to the result until PRED
+returns nil for an element.
+Value is a sequence of the same type as SEQUENCE."
(seq-take sequence (seq--count-successive pred sequence)))
(cl-defgeneric seq-empty-p (sequence)
@@ -267,7 +271,7 @@ the same type as SEQUENCE."
(= 0 (seq-length sequence)))
(cl-defgeneric seq-sort (pred sequence)
- "Sort SEQUENCE using PRED as comparison function.
+ "Sort SEQUENCE using PRED as the sorting comparison function.
The result is a sequence of the same type as SEQUENCE."
(let ((result (seq-sort pred (append sequence nil))))
(seq-into result (type-of sequence))))
@@ -277,7 +281,7 @@ The result is a sequence of the same type as SEQUENCE."
;;;###autoload
(defun seq-sort-by (function pred sequence)
- "Sort SEQUENCE using PRED as a comparison function.
+ "Sort SEQUENCE transformed by FUNCTION using PRED as the comparison function.
Elements of SEQUENCE are transformed by FUNCTION before being
sorted. FUNCTION must be a function of one argument."
(seq-sort (lambda (a b)
@@ -300,7 +304,7 @@ sorted. FUNCTION must be a function of one argument."
(cl-defgeneric seq-concatenate (type &rest sequences)
"Concatenate SEQUENCES into a single sequence of type TYPE.
-TYPE must be one of following symbols: vector, string or list.
+TYPE must be one of following symbols: `vector', `string' or `list'.
\n(fn TYPE SEQUENCE...)"
(setq sequences (mapcar #'seq-into-sequence sequences))
@@ -322,8 +326,8 @@ of sequence."
(cl-defgeneric seq-into (sequence type)
"Concatenate the elements of SEQUENCE into a sequence of type TYPE.
-TYPE can be one of the following symbols: vector, string or
-list."
+TYPE can be one of the following symbols: `vector', `string' or
+`list'."
(pcase type
(`vector (seq--into-vector sequence))
(`string (seq--into-string sequence))
@@ -332,7 +336,7 @@ list."
;;;###autoload
(cl-defgeneric seq-filter (pred sequence)
- "Return a list of all elements for which (PRED element) is non-nil in
SEQUENCE."
+ "Return a list of all the elements in SEQUENCE for which PRED returns
non-nil."
(let ((exclude (make-symbol "exclude")))
(delq exclude (seq-map (lambda (elt)
(if (funcall pred elt)
@@ -342,13 +346,13 @@ list."
;;;###autoload
(cl-defgeneric seq-remove (pred sequence)
- "Return a list of all the elements for which (PRED element) is nil in
SEQUENCE."
+ "Return a list of all the elements in SEQUENCE for which PRED returns nil."
(seq-filter (lambda (elt) (not (funcall pred elt)))
sequence))
;;;###autoload
(cl-defgeneric seq-remove-at-position (sequence n)
- "Return a copy of SEQUENCE where the element at N got removed.
+ "Return a copy of SEQUENCE with the element at index N removed.
N is the (zero-based) index of the element that should not be in
the result.
@@ -381,7 +385,7 @@ If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is
not called."
;;;###autoload
(cl-defgeneric seq-every-p (pred sequence)
- "Return non-nil if (PRED element) is non-nil for all elements of SEQUENCE."
+ "Return non-nil if PRED returns non-nil for all the elements of SEQUENCE."
(catch 'seq--break
(seq-doseq (elt sequence)
(or (funcall pred elt)
@@ -390,8 +394,8 @@ If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is
not called."
;;;###autoload
(cl-defgeneric seq-some (pred sequence)
- "Return non-nil if PRED is satisfied for at least one element of SEQUENCE.
-If so, return the first non-nil value returned by PRED."
+ "Return non-nil if PRED returns non-nil for at least one element of SEQUENCE.
+If the value is non-nil, it is the first non-nil value returned by PRED."
(catch 'seq--break
(seq-doseq (elt sequence)
(let ((result (funcall pred elt)))
@@ -401,12 +405,12 @@ If so, return the first non-nil value returned by PRED."
;;;###autoload
(cl-defgeneric seq-find (pred sequence &optional default)
- "Return the first element for which (PRED element) is non-nil in SEQUENCE.
-If no element is found, return DEFAULT.
+ "Return the first element in SEQUENCE for which PRED returns non-nil.
+If no such element is found, return DEFAULT.
Note that `seq-find' has an ambiguity if the found element is
-identical to DEFAULT, as it cannot be known if an element was
-found or not."
+identical to DEFAULT, as in that case it is impossible to know
+whether an element was found or not."
(catch 'seq--break
(seq-doseq (elt sequence)
(when (funcall pred elt)
@@ -414,7 +418,7 @@ found or not."
default))
(cl-defgeneric seq-count (pred sequence)
- "Return the number of elements for which (PRED element) is non-nil in
SEQUENCE."
+ "Return the number of elements in SEQUENCE for which PRED returns non-nil."
(let ((count 0))
(seq-doseq (elt sequence)
(when (funcall pred elt)
@@ -422,8 +426,8 @@ found or not."
count))
(cl-defgeneric seq-contains (sequence elt &optional testfn)
- "Return the first element in SEQUENCE that is equal to ELT.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return the first element in SEQUENCE that is \"equal\" to ELT.
+\"Equality\" is defined by the function TESTFN, which defaults to `equal'."
(declare (obsolete seq-contains-p "27.1"))
(seq-some (lambda (e)
(when (funcall (or testfn #'equal) elt e)
@@ -431,8 +435,8 @@ Equality is defined by the function TESTFN, which defaults
to `equal'."
sequence))
(cl-defgeneric seq-contains-p (sequence elt &optional testfn)
- "Return non-nil if SEQUENCE contains an element equal to ELT.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return non-nil if SEQUENCE contains an element \"equal\" to ELT.
+\"Equality\" is defined by the function TESTFN, which defaults to `equal'."
(catch 'seq--break
(seq-doseq (e sequence)
(let ((r (funcall (or testfn #'equal) e elt)))
@@ -442,15 +446,16 @@ Equality is defined by the function TESTFN, which
defaults to `equal'."
(cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn)
"Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements.
-This does not depend on the order of the elements.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+The order of the elements in the sequences is not important.
+\"Equality\" of elements is defined by the function TESTFN, which
+defaults to `equal'."
(and (seq-every-p (lambda (item1) (seq-contains-p sequence2 item1 testfn))
sequence1)
(seq-every-p (lambda (item2) (seq-contains-p sequence1 item2 testfn))
sequence2)))
;;;###autoload
(cl-defgeneric seq-position (sequence elt &optional testfn)
- "Return the (zero-based) index of the first element in SEQUENCE equal to ELT.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return the (zero-based) index of the first element in SEQUENCE \"equal\" to
ELT.
+\"Equality\" is defined by the function TESTFN, which defaults to `equal'."
(let ((index 0))
(catch 'seq--break
(seq-doseq (e sequence)
@@ -461,11 +466,11 @@ Equality is defined by the function TESTFN, which
defaults to `equal'."
;;;###autoload
(cl-defgeneric seq-positions (sequence elt &optional testfn)
- "Return indices for which (TESTFN (seq-elt SEQUENCE index) ELT) is non-nil.
+ "Return list of indices of SEQUENCE elements for which TESTFN returns
non-nil.
-TESTFN is a two-argument function which is passed each element of
-SEQUENCE as first argument and ELT as second. TESTFN defaults to
-`equal'.
+TESTFN is a two-argument function which is called with each element of
+SEQUENCE as the first argument and ELT as the second.
+TESTFN defaults to `equal'.
The result is a list of (zero-based) indices."
(let ((result '()))
@@ -479,7 +484,7 @@ The result is a list of (zero-based) indices."
;;;###autoload
(cl-defgeneric seq-uniq (sequence &optional testfn)
"Return a list of the elements of SEQUENCE with duplicates removed.
-TESTFN is used to compare elements, or `equal' if TESTFN is nil."
+TESTFN is used to compare elements, and defaults to `equal'."
(let ((result '()))
(seq-doseq (elt sequence)
(unless (seq-contains-p result elt testfn)
@@ -514,15 +519,15 @@ TESTFN is used to compare elements, or `equal' if TESTFN
is nil."
(nreverse result)))
(cl-defgeneric seq-mapcat (function sequence &optional type)
- "Concatenate the result of applying FUNCTION to each element of SEQUENCE.
-The result is a sequence of type TYPE, or a list if TYPE is nil."
+ "Concatenate the results of applying FUNCTION to each element of SEQUENCE.
+The result is a sequence of type TYPE; TYPE defaults to `list'."
(apply #'seq-concatenate (or type 'list)
(seq-map function sequence)))
(cl-defgeneric seq-partition (sequence n)
"Return list of elements of SEQUENCE grouped into sub-sequences of length N.
The last sequence may contain less than N elements. If N is a
-negative integer or 0, nil is returned."
+negative integer or 0, the function returns nil."
(unless (< n 1)
(let ((result '()))
(while (not (seq-empty-p sequence))
@@ -532,8 +537,9 @@ negative integer or 0, nil is returned."
;;;###autoload
(cl-defgeneric seq-union (sequence1 sequence2 &optional testfn)
- "Return a list of all elements that appear in either SEQUENCE1 or SEQUENCE2.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return a list of all the elements that appear in either SEQUENCE1 or
SEQUENCE2.
+\"Equality\" of elements is defined by the function TESTFN, which
+defaults to `equal'."
(let* ((accum (lambda (acc elt)
(if (seq-contains-p acc elt testfn)
acc
@@ -544,8 +550,9 @@ Equality is defined by the function TESTFN, which defaults
to `equal'."
;;;###autoload
(cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn)
- "Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return a list of all the elements that appear in both SEQUENCE1 and
SEQUENCE2.
+\"Equality\" of elements is defined by the function TESTFN, which
+defaults to `equal'."
(seq-reduce (lambda (acc elt)
(if (seq-contains-p sequence2 elt testfn)
(cons elt acc)
@@ -554,8 +561,9 @@ Equality is defined by the function TESTFN, which defaults
to `equal'."
'()))
(cl-defgeneric seq-difference (sequence1 sequence2 &optional testfn)
- "Return a list of the elements that appear in SEQUENCE1 but not in SEQUENCE2.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return list of all the elements that appear in SEQUENCE1 but not in
SEQUENCE2.
+\"Equality\" of elements is defined by the function TESTFN, which
+defaults to `equal'."
(seq-reduce (lambda (acc elt)
(if (seq-contains-p sequence2 elt testfn)
acc
@@ -591,7 +599,7 @@ SEQUENCE must be a sequence of numbers or markers."
(apply #'max (seq-into sequence 'list)))
(defun seq--count-successive (pred sequence)
- "Count successive elements for which (PRED element) is non-nil in SEQUENCE."
+ "Count successive elements in SEQUENCE for which PRED returns non-nil."
(let ((n 0)
(len (seq-length sequence)))
(while (and (< n len)
@@ -628,13 +636,13 @@ SEQUENCE must be a sequence of numbers or markers."
;; TODO: make public?
(defun seq--elt-safe (sequence n)
- "Return element of SEQUENCE at the index N.
+ "Return the element of SEQUENCE whose zero-based index is N.
If no element is found, return nil."
(ignore-errors (seq-elt sequence n)))
;;;###autoload
(cl-defgeneric seq-random-elt (sequence)
- "Return a random element from SEQUENCE.
+ "Return a randomly chosen element from SEQUENCE.
Signal an error if SEQUENCE is empty."
(if (seq-empty-p sequence)
(error "Sequence cannot be empty")
@@ -681,8 +689,8 @@ Signal an error if SEQUENCE is empty."
(concat sequence)))
(defun seq-split (sequence length)
- "Split SEQUENCE into a list of sub-sequences of at most LENGTH.
-All the sub-sequences will be of LENGTH, except the last one,
+ "Split SEQUENCE into a list of sub-sequences of at most LENGTH elements.
+All the sub-sequences will be LENGTH long, except the last one,
which may be shorter."
(when (< length 1)
(error "Sub-sequence length must be larger than zero"))
@@ -696,7 +704,7 @@ which may be shorter."
(nreverse result)))
(defun seq-keep (function sequence)
- "Apply FUNCTION to SEQUENCE and return all non-nil results."
+ "Apply FUNCTION to SEQUENCE and return the list of all the non-nil results."
(delq nil (seq-map function sequence)))
(provide 'seq)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 026b34849a..15fd6ac50f 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -299,6 +299,9 @@ function `erc-server-process-alive' instead.")
(defvar-local erc--server-last-reconnect-count 0
"Snapshot of reconnect count when the connection was established.")
+(defvar-local erc--server-reconnect-timer nil
+ "Auto-reconnect timer for a network context.")
+
(defvar-local erc-server-quitting nil
"Non-nil if the user requests a quit.")
@@ -401,6 +404,16 @@ This only has an effect if `erc-server-auto-reconnect' is
non-nil."
If a key is pressed while ERC is waiting, it will stop waiting."
:type 'number)
+(defcustom erc-server-reconnect-function 'erc-server-delayed-reconnect
+ "Function called by the reconnect timer to create a new connection.
+Called with a server buffer as its only argument. Potential uses
+include exponential backoff and probing for connectivity prior to
+dialing. Use `erc-schedule-reconnect' to instead try again later
+and optionally alter the attempts tally."
+ :package-version '(ERC . "5.4.1") ; FIXME on next release
+ :type '(choice (function-item erc-server-delayed-reconnect)
+ function))
+
(defcustom erc-split-line-length 440
"The maximum length of a single message.
If a message exceeds this size, it is broken into multiple ones.
@@ -625,12 +638,18 @@ The current buffer is given by BUFFER."
(let ((p (plist-put parameters :nowait t)))
(apply #'open-network-stream name buffer host service p)))
+(defvar erc--server-connect-dumb-ipv6-regexp
+ ;; Not for validation (gives false positives).
+ (rx bot "[" (group (+ (any xdigit digit ":.")) (? "%" (+ alnum))) "]" eot))
+
(defun erc-server-connect (server port buffer &optional client-certificate)
"Perform the connection and login using the specified SERVER and PORT.
We will store server variables in the buffer given by BUFFER.
CLIENT-CERTIFICATE may optionally be used to specify a TLS client
certificate to use for authentication when connecting over
TLS (see `erc-session-client-certificate' for more details)."
+ (when (string-match erc--server-connect-dumb-ipv6-regexp server)
+ (setq server (match-string 1 server)))
(let ((msg (erc-format-message 'connect ?S server ?p port)) process
(args `(,(format "erc-%s-%s" server port) nil ,server ,port)))
(when client-certificate
@@ -645,7 +664,8 @@ TLS (see `erc-session-client-certificate' for more
details)."
(setq erc-server-process process)
(setq erc-server-quitting nil)
(setq erc-server-reconnecting nil
- erc--server-reconnecting nil)
+ erc--server-reconnecting nil
+ erc--server-reconnect-timer nil)
(setq erc-server-timed-out nil)
(setq erc-server-banned nil)
(setq erc-server-error-occurred nil)
@@ -686,6 +706,7 @@ Make sure you are in an ERC buffer when running this."
(with-current-buffer buffer
(erc-update-mode-line)
(erc-set-active-buffer (current-buffer))
+ (setq erc--server-reconnecting t)
(setq erc-server-last-sent-time 0)
(setq erc-server-lines-sent 0)
(let ((erc-server-connect-function (or erc-session-connector
@@ -758,37 +779,59 @@ EVENT is the message received from the closed connection
process."
erc-server-reconnecting)
(erc--server-reconnect-p event)))
+(defconst erc--mode-line-process-reconnecting
+ '(:eval (erc-with-server-buffer
+ (and erc--server-reconnect-timer
+ (format ": reconnecting in %.1fs"
+ (- (timer-until erc--server-reconnect-timer
+ (current-time)))))))
+ "Mode-line construct showing seconds until next reconnect attempt.
+Move point around to refresh.")
+
+(defun erc--cancel-auto-reconnect-timer ()
+ (when erc--server-reconnect-timer
+ (cancel-timer erc--server-reconnect-timer)
+ (erc-display-message nil 'notice nil 'reconnect-canceled
+ ?u (buffer-name)
+ ?c (- (timer-until erc--server-reconnect-timer
+ (current-time))))
+ (setq erc--server-reconnect-timer nil)
+ (erc-update-mode-line)))
+
+(defun erc-schedule-reconnect (buffer &optional incr)
+ "Create and return a reconnect timer for BUFFER.
+When `erc-server-reconnect-attempts' is a number, increment
+`erc-server-reconnect-count' by INCR unconditionally."
+ (let ((count (and (integerp erc-server-reconnect-attempts)
+ (- erc-server-reconnect-attempts
+ (cl-incf erc-server-reconnect-count (or incr 1))))))
+ (erc-display-message nil 'error (current-buffer) 'reconnecting
+ ?m erc-server-reconnect-timeout
+ ?i (if count erc-server-reconnect-count "N")
+ ?n (if count erc-server-reconnect-attempts "A"))
+ (setq erc-server-reconnecting nil
+ erc--server-reconnect-timer
+ (run-at-time erc-server-reconnect-timeout nil
+ erc-server-reconnect-function buffer))))
+
(defun erc-process-sentinel-2 (event buffer)
"Called when `erc-process-sentinel-1' has detected an unexpected disconnect."
- (if (not (buffer-live-p buffer))
- (erc-update-mode-line)
+ (when (buffer-live-p buffer)
(with-current-buffer buffer
- (let ((reconnect-p (erc--server-reconnect-p event)) message delay)
+ (let ((reconnect-p (erc--server-reconnect-p event)) message)
(setq message (if reconnect-p 'disconnected 'disconnected-noreconnect))
(erc-display-message nil 'error (current-buffer) message)
(if (not reconnect-p)
;; terminate, do not reconnect
(progn
- (setq erc--server-reconnecting nil)
+ (setq erc--server-reconnecting nil
+ erc--server-reconnect-timer nil)
(erc-display-message nil 'error (current-buffer)
'terminated ?e event)
- ;; Update mode line indicators
- (erc-update-mode-line)
(set-buffer-modified-p nil))
;; reconnect
- (condition-case nil
- (progn
- (setq erc-server-reconnecting nil
- erc--server-reconnecting t
- erc-server-reconnect-count (1+
erc-server-reconnect-count))
- (setq delay erc-server-reconnect-timeout)
- (run-at-time delay nil
- #'erc-server-delayed-reconnect buffer))
- (error (unless (integerp erc-server-reconnect-attempts)
- (message "%s ... %s"
- "Reconnecting until we succeed"
- "kill the ERC server buffer to stop"))
- (erc-server-delayed-reconnect buffer))))))))
+ (erc-schedule-reconnect buffer))))
+ (erc-update-mode-line)))
(defun erc-process-sentinel-1 (event buffer)
"Called when `erc-process-sentinel' has decided that we're disconnecting.
@@ -1085,8 +1128,37 @@ See also `erc-server-send'."
;;;; Handling responses
+(defcustom erc-tags-format 'overridable
+ "Shape of the `tags' alist in `erc-response' objects.
+When set to `legacy', pre-5.5 parsing behavior takes effect for
+the tags portion of every message. The resulting alist contains
+conses of the form (STRING . LIST), in which LIST is comprised of
+at most one, possibly empty string. When set to nil, ERC only
+parses tags if an active module defines an implementation. It
+otherwise ignores them. In such cases, each alist element is a
+cons of a symbol and an optional, nonempty string.
+
+With the default value of `overridable', ERC behaves as it does
+with `legacy' except that it emits a warning whenever first
+encountering a message containing tags in a given Emacs session.
+But it only does so when a module implementing overriding,
+non-legacy behavior isn't already active in the current network
+context.
+
+Note that future bundled modules providing IRCv3 functionality
+will not be compatible with the legacy format. User code should
+eventually transition to expecting this \"5.5+ variant\" and set
+this option to nil."
+ :package-version '(ERC . "5.4.1") ; FIXME increment on next release
+ :type '(choice (const nil)
+ (const legacy)
+ (const overridable)))
+
(defun erc-parse-tags (string)
"Parse IRCv3 tags list in STRING to a (tag . value) alist."
+ (erc--parse-message-tags string))
+
+(defun erc--parse-tags (string)
(let ((tags)
(tag-strings (split-string string ";")))
(dolist (tag-string tag-strings tags)
@@ -1096,6 +1168,28 @@ See also `erc-server-send'."
`(,pair))
tags)))))
+;; A benefit of this function being internal is not having to define a
+;; separate method just to ensure an `erc-tags-format' value of
+;; `legacy' always wins. A downside is that module code must take
+;; care to preserve that promise manually.
+
+(cl-defgeneric erc--parse-message-tags (string)
+ "Parse STRING into an alist of (TAG . VALUE) conses.
+Expect TAG to be a symbol and VALUE nil or a nonempty string.
+Don't split composite raw-input values containing commas;
+instead, leave them as a single string."
+ (when erc-tags-format
+ (unless (or (eq erc-tags-format 'legacy)
+ (get 'erc-parse-tags 'erc-v3-warned-p))
+ (put 'erc-parse-tags 'erc-v3-warned-p t)
+ (display-warning
+ 'ERC
+ (concat
+ "Legacy ERC tags behavior is currently in effect, but other modules,"
+ " including those bundled with ERC, may override this in future"
+ " releases. See `erc-tags-format' for more info.")))
+ (erc--parse-tags string)))
+
(defun erc-parse-server-response (proc string)
"Parse and act upon a complete line from an IRC server.
PROC is the process (connection) from which STRING was received.
@@ -1105,9 +1199,9 @@ PROCs `process-buffer' is `current-buffer' when this
function is called."
(let* ((tag-list (when (eq (aref string 0) ?@)
(substring string 1
(string-search " " string))))
- (msg (make-erc-response :unparsed string :tags (when tag-list
- (erc-parse-tags
- tag-list))))
+ (msg (make-erc-response :unparsed string :tags
+ (when tag-list
+ (erc--parse-message-tags tag-list))))
(string (if tag-list
(substring string (+ 1 (string-search " " string)))
string))
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index d8aac36eab..23a1933798 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -77,6 +77,9 @@
(cl-defstruct (erc--target-channel (:include erc--target)))
(cl-defstruct (erc--target-channel-local (:include erc--target-channel)))
+;; Beginning in 5.5/29.1, the `tags' field may take on one of two
+;; differing types. See `erc-tags-format' for details.
+
(cl-defstruct (erc-response (:conc-name erc-response.))
(unparsed "" :type string)
(sender "" :type string)
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 03bd8f1352..d23703394b 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -32,6 +32,7 @@
;;; Code:
(require 'compat nil 'noerror)
+(eval-when-compile (require 'cl-lib) (require 'url-parse))
;;;###autoload(autoload 'erc-define-minor-mode "erc-compat")
(define-obsolete-function-alias 'erc-define-minor-mode
@@ -157,6 +158,121 @@ If START or END is negative, it counts from the end."
res))))))
+;;;; Auth Source
+
+(declare-function auth-source-pass--get-attr
+ "auth-source-pass" (key entry-data))
+(declare-function auth-source-pass--disambiguate
+ "auth-source-pass" (host &optional user port))
+(declare-function auth-source-backend-parse-parameters
+ "auth-source-pass" (entry backend))
+(declare-function auth-source-backend "auth-source" (&rest slots))
+(declare-function auth-source-pass-entries "auth-source-pass" nil)
+(declare-function auth-source-pass-parse-entry "auth-source-pass" (entry))
+
+(defvar auth-sources)
+(defvar auth-source-backend-parser-functions)
+
+;; This hard codes `auth-source-pass-port-separator' to ":"
+(defun erc-compat--29-auth-source-pass--retrieve-parsed (seen e port-number-p)
+ (when (string-match (rx (or bot "/")
+ (or (: (? (group-n 20 (+ (not (in " /@")))) "@")
+ (group-n 10 (+ (not (in " /:@"))))
+ (? ":" (group-n 30 (+ (not (in " /:"))))))
+ (: (group-n 11 (+ (not (in " /:@"))))
+ (? ":" (group-n 31 (+ (not (in " /:")))))
+ (? "/" (group-n 21 (+ (not (in " /:")))))))
+ eot)
+ e)
+ (puthash e `( :host ,(or (match-string 10 e) (match-string 11 e))
+ ,@(if-let* ((tr (match-string 21 e)))
+ (list :user tr :suffix t)
+ (list :user (match-string 20 e)))
+ :port ,(and-let* ((p (or (match-string 30 e)
+ (match-string 31 e)))
+ (n (string-to-number p)))
+ (if (or (zerop n) (not port-number-p))
+ (format "%s" p)
+ n)))
+ seen)))
+
+;; This looks bad, but it just inlines `auth-source-pass--find-match-many'.
+(defun erc-compat--29-auth-source-pass--build-result-many
+ (hosts users ports require max)
+ "Return a plist of HOSTS, PORTS, USERS, and secret."
+ (unless (listp hosts) (setq hosts (list hosts)))
+ (unless (listp users) (setq users (list users)))
+ (unless (listp ports) (setq ports (list ports)))
+ (unless max (setq max 1))
+ (let ((seen (make-hash-table :test #'equal))
+ (entries (auth-source-pass-entries))
+ (check (lambda (m k v)
+ (let ((mv (plist-get m k)))
+ (if (memq k require)
+ (and v (equal mv v))
+ (or (not v) (not mv) (equal mv v))))))
+ out suffixed suffixedp)
+ (catch 'done
+ (dolist (host hosts)
+ (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host)))
+ (unless (or (not (equal "443" p)) (string-prefix-p "https://"; host))
+ (setq p nil))
+ (dolist (user (or users (list u)))
+ (dolist (port (or ports (list p)))
+ (dolist (e entries)
+ (when-let*
+ ((m (or (gethash e seen)
+ (erc-compat--29-auth-source-pass--retrieve-parsed
+ seen e (integerp port))))
+ ((equal host (plist-get m :host)))
+ ((funcall check m :port port))
+ ((funcall check m :user user))
+ (parsed (auth-source-pass-parse-entry e))
+ (secret (or (auth-source-pass--get-attr 'secret parsed)
+ (not (memq :secret require)))))
+ (push
+ `( :host ,host ; prefer user-provided :host over h
+ ,@(and-let* ((u (plist-get m :user))) (list :user u))
+ ,@(and-let* ((p (plist-get m :port))) (list :port p))
+ ,@(and secret (not (eq secret t)) (list :secret secret)))
+ (if (setq suffixedp (plist-get m :suffix)) suffixed out))
+ (unless suffixedp
+ (when (or (zerop (cl-decf max))
+ (null (setq entries (delete e entries))))
+ (throw 'done out)))))
+ (setq suffixed (nreverse suffixed))
+ (while suffixed
+ (push (pop suffixed) out)
+ (when (zerop (cl-decf max))
+ (throw 'done out))))))))
+ (reverse out)))
+
+(cl-defun erc-compat--29-auth-source-pass-search
+ (&rest spec &key host user port require max &allow-other-keys)
+ ;; From `auth-source-pass-search'
+ (cl-assert (and host (not (eq host t)))
+ t "Invalid password-store search: %s %s")
+ (erc-compat--29-auth-source-pass--build-result-many
+ host user port require max))
+
+(defun erc-compat--29-auth-source-pass-backend-parse (entry)
+ (when (eq entry 'password-store)
+ (auth-source-backend-parse-parameters
+ entry (auth-source-backend
+ :source "."
+ :type 'password-store
+ :search-function #'erc-compat--29-auth-source-pass-search))))
+
+(defun erc-compat--auth-source-backend-parser-functions ()
+ (if (memq 'password-store auth-sources)
+ (progn
+ (require 'auth-source-pass)
+ `(,@(unless (bound-and-true-p auth-source-pass-extra-query-keywords)
+ '(erc-compat--29-auth-source-pass-backend-parse))
+ ,@auth-source-backend-parser-functions))
+ auth-source-backend-parser-functions))
+
+
;;;; Misc 29.1
(defmacro erc-compat--with-memoization (table &rest forms)
@@ -168,6 +284,35 @@ If START or END is negative, it counts from the end."
`(cl--generic-with-memoization ,table ,@forms))
(t `(progn ,@forms))))
+(defvar url-irc-function)
+
+(defun erc-compat--29-browse-url-irc (string &rest _)
+ (require 'url-irc)
+ (let* ((url (url-generic-parse-url string))
+ (url-irc-function
+ (if (function-equal url-irc-function 'url-irc-erc)
+ (lambda (host port chan user pass)
+ (erc-handle-irc-url host port chan user pass (url-type url)))
+ url-irc-function)))
+ (url-irc url)))
+
+(cond ((fboundp 'browse-url-irc)) ; 29
+ ((boundp 'browse-url-default-handlers) ; 28
+ (cl-pushnew '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
+ browse-url-default-handlers))
+ ((boundp 'browse-url-browser-function) ; 27
+ (require 'browse-url)
+ (let ((existing browse-url-browser-function))
+ (setq browse-url-browser-function
+ (if (functionp existing)
+ (lambda (u &rest r)
+ (apply (if (string-match-p "\\`irc6?s?://" u)
+ #'erc-compat--29-browse-url-irc
+ existing)
+ u r))
+ (cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
+ existing))))))
+
(provide 'erc-compat)
;;; erc-compat.el ends here
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index dba6ead073..b3e5fcf1a3 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1256,14 +1256,15 @@ server name and search for a match in
`erc-networks-alist'."
(defconst erc-networks--name-missing-sentinel (gensym "Unknown ")
"Value to cover rare case of a literal NETWORK=nil.")
-(defun erc-networks--determine ()
+(defun erc-networks--determine (&optional server)
"Return the name of the network as a symbol.
-Search `erc-networks-alist' for a known entity matching
+Search `erc-networks-alist' for a known entity matching SERVER or
`erc-server-announced-name'. If that fails, use the display name
given by the `RPL_ISUPPORT' NETWORK parameter."
(or (cl-loop for (name matcher) in erc-networks-alist
- when (and matcher (string-match (concat matcher "\\'")
- erc-server-announced-name))
+ when (and matcher
+ (string-match (concat matcher "\\'")
+ (or server erc-server-announced-name)))
return name)
(and-let* ((vanity (erc--get-isupport-entry 'NETWORK 'single))
((intern vanity))))
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index af8528dbc3..3ba18e835b 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -179,6 +179,10 @@ for use on `completion-at-point-function'."
(defun pcomplete/erc-mode/UNIGNORE ()
(pcomplete-here (erc-with-server-buffer erc-ignore-list)))
+(defun pcomplete/erc-mode/RECONNECT ()
+ (pcomplete-here '("cancel"))
+ (pcomplete-opt "a"))
+
;;; Functions that provide possible completions.
(defun pcomplete-erc-commands ()
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 6b14cf87e2..2312246e3e 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -70,7 +70,7 @@
(require 'auth-source)
(require 'time-date)
(require 'iso8601)
-(eval-when-compile (require 'subr-x))
+(eval-when-compile (require 'subr-x) (require 'url-parse))
(defconst erc-version "5.4.1"
"This version of ERC.")
@@ -1542,6 +1542,11 @@ symbol, it may have these values:
* ircs -> 994
* ircd -> 6667
* ircd-dalnet -> 7000"
+ ;; These were updated somewhat in 2022 to reflect modern standards
+ ;; and practices. See also:
+ ;;
+ ;; https://datatracker.ietf.org/doc/html/rfc7194#section-1
+ ;; https://www.iana.org/assignments/service-names-port-numbers
(cond
((symbolp port)
(erc-normalize-port (symbol-name port)))
@@ -1554,8 +1559,10 @@ symbol, it may have these values:
194)
((string-equal port "ircs")
994)
- ((string-equal port "ircd")
+ ((string-equal port "ircu") 6667) ; 6665-6669
+ ((string-equal port "ircd") ; nonstandard (irc-serv is 529)
6667)
+ ((string-equal port "ircs-u") 6697)
((string-equal port "ircd-dalnet")
7000)
(t
@@ -1924,7 +1931,9 @@ removed from the list will be disabled."
If CONNECT is non-nil, connect to the server. Otherwise assume
already connected and just create a separate buffer for the new
-target CHANNEL.
+target given by CHANNEL, meaning these parameters are mutually
+exclusive. Note that CHANNEL may also be a query; its name has
+been retained for historical reasons.
Use PASSWD as user password on the server. If TGT-LIST is
non-nil, use it to initialize `erc-default-recipients'.
@@ -2032,12 +2041,12 @@ Returns the buffer for the given server or channel."
;; Saving log file on exit
(run-hook-with-args 'erc-connect-pre-hook buffer)
- (when connect
- (erc-server-connect erc-session-server
- erc-session-port
- buffer
- erc-session-client-certificate))
- (erc-update-mode-line)
+ (if connect
+ (erc-server-connect erc-session-server
+ erc-session-port
+ buffer
+ erc-session-client-certificate)
+ (erc-update-mode-line))
;; Now display the buffer in a window as per user wishes.
(unless (eq buffer old-buffer)
@@ -2094,52 +2103,51 @@ parameters SERVER and NICK."
:group 'erc-hooks
:type '(repeat function))
+(defun erc--ensure-url (input)
+ (unless (string-match (rx bot "irc" (? "6") (? "s") "://") input)
+ (when (and (string-match (rx (? (+ any) "@")
+ (or (group (* (not "[")) ":" (* any))
+ (+ any))
+ ":" (+ (not (any ":]"))) eot)
+ input)
+ (match-beginning 1))
+ (setq input (concat "[" (substring input (match-beginning 1)) "]")))
+ (setq input (concat "irc://" input)))
+ input)
+
;;;###autoload
(defun erc-select-read-args ()
"Prompt the user for values of nick, server, port, and password."
- (let (user-input server port nick passwd)
- (setq user-input (read-string
- "IRC server: "
- (erc-compute-server) 'erc-server-history-list))
-
- (if (string-match "\\(.*\\):\\(.*\\)\\'" user-input)
- (setq port (erc-string-to-port (match-string 2 user-input))
- user-input (match-string 1 user-input))
- (setq port
- (erc-string-to-port (read-string
- "IRC port: " (erc-port-to-string
- (erc-compute-port))))))
-
- (if (string-match "\\`\\(.*\\)@\\(.*\\)" user-input)
- (setq nick (match-string 1 user-input)
- user-input (match-string 2 user-input))
- (setq nick
- (if (erc-already-logged-in server port nick)
- (read-string
- (erc-format-message 'nick-in-use ?n nick)
- nick 'erc-nick-history-list)
- (read-string
- "Nickname: " (erc-compute-nick nick)
- 'erc-nick-history-list))))
-
- (setq server user-input)
-
- (setq passwd (if erc-prompt-for-password
- (read-passwd "Server password: ")
- (with-suppressed-warnings ((obsolete erc-password))
- erc-password)))
+ (require 'url-parse)
+ (let* ((input (let ((d (erc-compute-server)))
+ (read-string (format "Server (default is %S): " d)
+ nil 'erc-server-history-list d)))
+ ;; For legacy reasons, also accept a URL without a scheme.
+ (url (url-generic-parse-url (erc--ensure-url input)))
+ (server (url-host url))
+ (sp (and (or (string-suffix-p "s" (url-type url))
+ (and (equal server erc-default-server)
+ (not (string-prefix-p "irc://" input))))
+ 'ircs-u))
+ (port (or (url-portspec url)
+ (erc-compute-port
+ (let ((d (erc-compute-port sp))) ; may be a string
+ (read-string (format "Port (default is %s): " d)
+ nil nil d)))))
+ ;; Trust the user not to connect twice accidentally. We
+ ;; can't use `erc-already-logged-in' to check for an existing
+ ;; connection without modifying it to consider USER and PASS.
+ (nick (or (url-user url)
+ (let ((d (erc-compute-nick)))
+ (read-string (format "Nickname (default is %S): " d)
+ nil 'erc-nick-history-list d))))
+ (passwd (or (url-password url)
+ (if erc-prompt-for-password
+ (read-passwd "Server password (optional): ")
+ (with-suppressed-warnings ((obsolete erc-password))
+ erc-password)))))
(when (and passwd (string= "" passwd))
(setq passwd nil))
-
- (while (erc-already-logged-in server port nick)
- ;; hmm, this is a problem when using multiple connections to a bnc
- ;; with the same nick. Currently this code prevents using more than one
- ;; bnc with the same nick. actually it would be nice to have
- ;; bncs transparent, so that erc-compute-buffer-name displays
- ;; the server one is connected to.
- (setq nick (read-string
- (erc-format-message 'nick-in-use ?n nick)
- nick 'erc-nick-history-list)))
(list :server server :port port :nick nick :password passwd)))
;;;###autoload
@@ -2184,7 +2192,7 @@ interactively."
;;;###autoload
(cl-defun erc-tls (&key (server (erc-compute-server))
- (port (erc-compute-port))
+ (port (erc-compute-port 'ircs-u))
(nick (erc-compute-nick))
(user (erc-compute-user))
password
@@ -3225,7 +3233,9 @@ host but different ports would result in the one with
port 123 getting
the nod. Much the same would happen for entries sharing only a port:
the one with host foo would win."
(when-let*
- ((priority (map-keys defaults))
+ ((auth-source-backend-parser-functions
+ (erc-compat--auth-source-backend-parser-functions))
+ (priority (map-keys defaults))
(test (lambda (a b)
(catch 'done
(dolist (key priority)
@@ -3802,17 +3812,17 @@ the message given by REASON."
(put 'erc-cmd-GQUIT 'do-not-parse-args t)
(put 'erc-cmd-GQUIT 'process-not-needed t)
-(defun erc-cmd-RECONNECT ()
- "Try to reconnect to the current IRC server."
+(defun erc--cmd-reconnect ()
(let ((buffer (erc-server-buffer))
(process nil))
(unless (buffer-live-p buffer)
(setq buffer (current-buffer)))
(with-current-buffer buffer
+ (when erc--server-reconnect-timer
+ (erc--cancel-auto-reconnect-timer))
(setq erc-server-quitting nil)
(with-suppressed-warnings ((obsolete erc-server-reconnecting))
(setq erc-server-reconnecting t))
- (setq erc--server-reconnecting t)
(setq erc-server-reconnect-count 0)
(setq process (get-buffer-process (erc-server-buffer)))
(when process
@@ -3826,6 +3836,18 @@ the message given by REASON."
(setq erc--server-reconnecting nil
erc-server-reconnecting nil)))))
t)
+
+(defun erc-cmd-RECONNECT (&rest args)
+ "Try reconnecting to the current IRC server.
+Alternatively, CANCEL a scheduled attempt for either the current
+connection or, with -A, all applicable connections.
+
+\(fn [CANCEL [-A]])"
+ (pcase args
+ (`("cancel" "-a") (erc-buffer-filter #'erc--cancel-auto-reconnect-timer))
+ (`("cancel") (erc-with-server-buffer (erc--cancel-auto-reconnect-timer)))
+ (_ (erc--cmd-reconnect))))
+
(put 'erc-cmd-RECONNECT 'process-not-needed t)
(defun erc-cmd-SERVER (server)
@@ -6391,7 +6413,7 @@ non-nil value is found.
- PORT (the argument passed to this function)
- The `erc-port' option
- The `erc-default-port' variable"
- (or port erc-port erc-default-port))
+ (erc-normalize-port (or port erc-port erc-default-port)))
;; time routines
@@ -6711,11 +6733,12 @@ shortened server name instead."
(?s . ,(erc-format-target-and/or-server))
(?S . ,(erc-format-target-and/or-network))
(?t . ,(erc-format-target))))
- (process-status (cond ((and (erc-server-process-alive)
- (not erc-server-connected))
- ":connecting")
- ((erc-server-process-alive)
- "")
+ (process-status (cond ((erc-server-process-alive buffer)
+ (unless erc-server-connected
+ ": connecting"))
+ ((erc-with-server-buffer
+ erc--server-reconnect-timer)
+ erc--mode-line-process-reconnecting)
(t
": CLOSED")))
(face (cond ((eq erc-header-line-face-method nil)
@@ -6726,7 +6749,7 @@ shortened server name instead."
'erc-header-line))))
(setq mode-line-buffer-identification
(list (format-spec erc-mode-line-format spec)))
- (setq mode-line-process (list process-status))
+ (setq mode-line-process process-status)
(let ((header (if erc-header-line-format
(format-spec erc-header-line-format spec)
nil)))
@@ -6911,6 +6934,8 @@ All windows are opened in the current frame."
(disconnected . "\n\nConnection failed! Re-establishing connection...\n")
(disconnected-noreconnect
. "\n\nConnection failed! Not re-establishing connection.\n")
+ (reconnecting . "Reconnecting in %ms: attempt %i/%n ...")
+ (reconnect-canceled . "Canceled %u reconnect timer with %cs to go...")
(finished . "\n\n*** ERC finished ***\n")
(terminated . "\n\n*** ERC terminated: %e\n")
(login . "Logging in as `%n'...")
@@ -7161,25 +7186,83 @@ This function should be on `erc-kill-channel-hook'."
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
-;; FIXME change user to nick, and use API to find server buffer
+(defcustom erc-url-connect-function nil
+ "When non-nil, a function used to connect to an IRC URL.
+Called with a string meant to represent a URL scheme, like
+\"ircs\", followed by any number of keyword arguments recognized
+by `erc' and `erc-tls'."
+ :group 'erc
+ :package-version '(ERC . "5.4.1") ; FIXME increment on release
+ :type '(choice (const nil) function))
+
+(defun erc--url-default-connect-function (scheme &rest plist)
+ (let* ((ircsp (if scheme
+ (string-suffix-p "s" scheme)
+ (or (eql 6697 (plist-get plist :port))
+ (yes-or-no-p "Connect using TLS? "))))
+ (erc-server (plist-get plist :server))
+ (erc-port (or (plist-get plist :port)
+ (and ircsp (erc-normalize-port 'ircs-u))
+ erc-port))
+ (erc-nick (or (plist-get plist :nick) erc-nick))
+ (erc-password (plist-get plist :password))
+ (args (erc-select-read-args)))
+ (unless ircsp
+ (setq ircsp (eql 6697 erc-port)))
+ (apply (if ircsp #'erc-tls #'erc) args)))
+
;;;###autoload
-(defun erc-handle-irc-url (host port channel user password)
- "Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD.
+(defun erc-handle-irc-url (host port channel nick password &optional scheme)
+ "Use ERC to IRC on HOST:PORT in CHANNEL.
If ERC is already connected to HOST:PORT, simply /join CHANNEL.
-Otherwise, connect to HOST:PORT as USER and /join CHANNEL."
- (let ((server-buffer
- (car (erc-buffer-filter
- (lambda ()
- (and (string-equal erc-session-server host)
- (= erc-session-port port)
- (erc-open-server-buffer-p)))))))
- (with-current-buffer (or server-buffer (current-buffer))
- (if (and server-buffer channel)
- (erc-cmd-JOIN channel)
- (erc-open host port (or user (erc-compute-nick))
(erc-compute-full-name)
- (not server-buffer) password nil channel
- (when server-buffer
- (get-buffer-process server-buffer)))))))
+Otherwise, connect to HOST:PORT as NICK and /join CHANNEL.
+
+Beginning with ERC 5.5, new connections require human intervention.
+Customize `erc-url-connect-function' to override this."
+ (when (eql port 0) (setq port nil))
+ (let* ((net (erc-networks--determine host))
+ (server-buffer
+ ;; Viable matches may slip through the cracks for unknown
+ ;; networks. Additional passes could likely improve things.
+ (car (erc-buffer-filter
+ (lambda ()
+ (and (not erc--target)
+ (erc-server-process-alive)
+ ;; Always trust a matched network.
+ (or (and net (eq net (erc-network)))
+ (and (string-equal erc-session-server host)
+ ;; Ports only matter when dialed hosts
+ ;; match and we have sufficient info.
+ (or (not port)
+ (= (erc-normalize-port erc-session-port)
+ port)))))))))
+ key deferred)
+ (unless server-buffer
+ (setq deferred t
+ server-buffer (apply (or erc-url-connect-function
+ #'erc--url-default-connect-function)
+ scheme
+ :server host
+ `(,@(and port (list :port port))
+ ,@(and nick (list :nick nick))
+ ,@(and password `(:password ,password))))))
+ (when channel
+ ;; These aren't percent-decoded by default
+ (when (string-prefix-p "%" channel)
+ (setq channel (url-unhex-string channel)))
+ (cl-multiple-value-setq (channel key) (split-string channel "[?]"))
+ (if deferred
+ ;; Alternatively, we could make this a defmethod, so when
+ ;; autojoin is loaded, it can do its own thing. Also, as
+ ;; with `erc-once-with-server-event', it's fine to set local
+ ;; hooks here because they're killed when reconnecting.
+ (with-current-buffer server-buffer
+ (letrec ((f (lambda (&rest _)
+ (remove-hook 'erc-after-connect f t)
+ (erc-cmd-JOIN channel key))))
+ (add-hook 'erc-after-connect f nil t)))
+ (with-current-buffer server-buffer
+ (erc-cmd-JOIN channel key))))))
(provide 'erc)
diff --git a/lisp/faces.el b/lisp/faces.el
index 09e8110449..5ae1c65a4d 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -787,13 +787,12 @@ specified below. WIDTH specifies the width of the lines
to draw; it
defaults to 1. If WIDTH is negative, the absolute value is the width
of the lines, and draw top/bottom lines inside the characters area,
not around it. COLOR is the name of the color to draw in, default is
-the foreground color of the face for simple boxes, and the background
-color of the face for 3D boxes. STYLE specifies whether a 3D box
-should be draw. If STYLE is `released-button', draw a box looking
-like a released 3D button. If STYLE is `pressed-button' draw a box
-that appears like a pressed button. If STYLE is nil, the default if
-the property list doesn't contain a style specification, draw a 2D
-box.
+the background color of the face for 3D boxes and `flat-button', and
+the foreground color of the face for other boxes. STYLE specifies
+whether a 3D box should be draw. If STYLE is `released-button', draw
+a box looking like a released 3D button. If STYLE is `pressed-button'
+draw a box that appears like a pressed button. If STYLE is nil,
+`flat-button' or omitted, draw a 2D box.
`:inverse-video'
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 99e7b2a6f3..66cee52865 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -77,7 +77,7 @@ this variable to the list of fields to be ignored.")
"List of RSS addresses.")
(defvar nnrss-use-local nil
- "If non-nil nnrss will read the feeds from local files in nnrss-directory.")
+ "If non-nil nnrss will read the feeds from local files in
`nnrss-directory'.")
(defvar nnrss-description-field 'X-Gnus-Description
"Field name used for DESCRIPTION.
@@ -398,7 +398,7 @@ otherwise return nil."
(declare-function libxml-parse-html-region "xml.c"
(start end &optional base-url discard-comments))
(defun nnrss-fetch (url &optional local)
- "Fetch URL and put it in a the expected Lisp structure."
+ "Fetch URL and put it in the expected Lisp structure."
(mm-with-unibyte-buffer
;;some versions of url.el need this to close the connection quickly
(let (cs xmlform htmlform)
@@ -800,7 +800,7 @@ It is useful when `(setq nnrss-use-local t)'."
node))
(defun nnrss-find-el (tag data &optional found-list)
- "Find the all matching elements in the data.
+ "Find all the matching elements in the data.
Careful with this on large documents!"
(when (consp data)
(dolist (bit data)
diff --git a/lisp/keymap.el b/lisp/keymap.el
index 107565590c..0285c0571f 100644
--- a/lisp/keymap.el
+++ b/lisp/keymap.el
@@ -559,22 +559,37 @@ In addition to the keywords accepted by `define-keymap',
this
macro also accepts a `:doc' keyword, which (if present) is used
as the variable documentation string.
-\(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY
DEFINITION]...)"
+When a `:repeat' keyword is non-nil, put `repeat-map' symbol
+properties on commands in this map for `repeat-mode'. The value
+could also be a property list with properties `:enter' and `:exit',
+for example, :repeat (:enter (commands ...) :exit (commands ...)).
+`:enter' is a list of additional commands that only enter `repeat-mode'.
+When the list is empty then by default all commands in the map enter
+`repeat-mode'. This is applicable when a command has the `repeat-map'
+symbol property on its symbol, but doesn't exist in the map. `:exit'
+is a list of commands that exit `repeat-mode'. When the list is
+empty, no commands in the map exit `repeat-mode'. This is applicable
+when a command exists in the map, but doesn't have the `repeat-map'
+symbol property on its symbol.
+
+\(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP REPEAT
&rest [KEY DEFINITION]...)"
(declare (indent 1))
(let ((opts nil)
- doc)
+ doc repeat props)
(while (and defs
(keywordp (car defs))
(not (eq (car defs) :menu)))
(let ((keyword (pop defs)))
(unless defs
(error "Uneven number of keywords"))
- (if (eq keyword :doc)
- (setq doc (pop defs))
- (push keyword opts)
- (push (pop defs) opts))))
+ (cond
+ ((eq keyword :doc) (setq doc (pop defs)))
+ ((eq keyword :repeat) (setq repeat (pop defs)))
+ (t (push keyword opts)
+ (push (pop defs) opts)))))
(unless (zerop (% (length defs) 2))
(error "Uneven number of key/definition pairs: %s" defs))
+
(let ((defs defs)
key seen-keys)
(while defs
@@ -585,9 +600,28 @@ as the variable documentation string.
(error "Duplicate definition for key '%s' in keymap '%s'"
key variable-name)
(push key seen-keys)))))
- `(defvar ,variable-name
- (define-keymap ,@(nreverse opts) ,@defs)
- ,@(and doc (list doc)))))
+
+ (when repeat
+ (let ((defs defs)
+ def)
+ (dolist (def (plist-get repeat :enter))
+ (push `(put ',def 'repeat-map ',variable-name) props))
+ (while defs
+ (pop defs)
+ (setq def (pop defs))
+ (when (and (memq (car def) '(function quote))
+ (not (memq (cadr def) (plist-get repeat :exit))))
+ (push `(put ,def 'repeat-map ',variable-name) props)))))
+
+ (let ((defvar-form
+ `(defvar ,variable-name
+ (define-keymap ,@(nreverse opts) ,@defs)
+ ,@(and doc (list doc)))))
+ (if repeat
+ `(progn
+ ,defvar-form
+ ,@(nreverse props))
+ defvar-form))))
(defun make-non-key-event (symbol)
"Mark SYMBOL as an event that shouldn't be returned from `where-is'."
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index c754e72354..3f36cfbba5 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -10010,7 +10010,7 @@ If ERC is already connected to HOST:PORT, simply /join
CHANNEL.
Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
(fn HOST PORT CHANNEL USER PASSWORD)")
-(register-definition-prefixes "erc" '("define-erc-module" "erc-"))
+(register-definition-prefixes "erc" '("erc-"))
;;; Generated autoloads from erc/erc-autoaway.el
@@ -10033,6 +10033,11 @@ Otherwise, connect to HOST:PORT as USER and /join
CHANNEL.
(register-definition-prefixes "erc-capab" '("erc-capab-identify-"))
+;;; Generated autoloads from erc/erc-common.el
+
+(register-definition-prefixes "erc-common" '("define-erc-module" "erc-"))
+
+
;;; Generated autoloads from erc/erc-compat.el
(register-definition-prefixes "erc-compat" '("erc-"))
@@ -10931,6 +10936,23 @@ Edit the hotlist of directory servers in a specialized
buffer." t)
(register-definition-prefixes "eudcb-bbdb" '("eudc-bbdb-"))
+;;; Generated autoloads from net/eudcb-ecomplete.el
+
+(autoload 'eudc-ecomplete-query-internal "eudcb-ecomplete" "\
+Query `ecomplete' with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE). Since `ecomplete'
+does not provide attributes in the usual sense, the
+back-end-specific attribute names in
+`eudc-ecomplete-attributes-translation-alist' are used as the
+KEY (that is, the \"type\" of match) when looking for matches in
+`ecomplete-database'.
+
+RETURN-ATTRS is ignored.
+
+(fn QUERY &optional RETURN-ATTRS)")
+(register-definition-prefixes "eudcb-ecomplete"
'("eudc-ecomplete-attributes-translation-alist"))
+
+
;;; Generated autoloads from net/eudcb-ldap.el
(register-definition-prefixes "eudcb-ldap" '("eudc-"))
@@ -10946,6 +10968,26 @@ Edit the hotlist of directory servers in a specialized
buffer." t)
(register-definition-prefixes "eudcb-macos-contacts" '("eudc-macos-contacts-"))
+;;; Generated autoloads from net/eudcb-mailabbrev.el
+
+(autoload 'eudc-mailabbrev-query-internal "eudcb-mailabbrev" "\
+Query `mailabbrev' with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE). Since `mailabbrev'
+does not provide attributes in the usual sense, only the email,
+name, and firstname attributes in the QUERY are considered, and
+their values are matched against the alias names in the mailrc
+file. When a mailrc alias is a distribution list, that is it
+expands to more that one email address, the individual recipient
+specifications are formatted using `eudc-rfc5322-make-address',
+and returned as a comma-separated list in the email address
+attribute.
+
+RETURN-ATTRS is a list of attributes to return, defaulting to
+`eudc-default-return-attributes'.
+
+(fn QUERY &optional RETURN-ATTRS)")
+
+
;;; Generated autoloads from emacs-lisp/ewoc.el
(autoload 'ewoc-create "ewoc" "\
@@ -11280,7 +11322,7 @@ See `text-scale-increase' for more details.
(define-key ctl-x-map [(control ?0)] 'text-scale-adjust)
(autoload 'text-scale-adjust "face-remap" "\
Adjust the font size in the current buffer by INC steps.
-INC may be passed as a numeric prefix argument.
+Interactively, INC is the prefix numeric argument, and defaults to 1.
The actual adjustment made depends on the final component of the
keybinding used to invoke the command, with all modifiers removed:
@@ -11290,13 +11332,14 @@ keybinding used to invoke the command, with all
modifiers removed:
\\`0' Reset the font size to the global default
After adjusting, continue to read input events and further adjust
-the font size as long as the input event read
-(with all modifiers removed) is one of the above characters.
+the font size as long as the input event (with all modifiers removed)
+is one of the above characters.
-Each step scales the height of the default face by the variable
-`text-scale-mode-step' (a negative number of steps decreases the
-height by the same amount). As a special case, an argument of 0
-will remove any scaling currently active.
+Each step scales the height of the default face by the factor that
+is the value of `text-scale-mode-step' (a negative number of steps
+decreases the height by that factor). As a special case, an argument
+of 0 will remove any scaling currently active, thus resetting the
+font size to the original value.
This command is a special-purpose wrapper around the
`text-scale-increase' command which makes repetition convenient
@@ -11322,19 +11365,22 @@ Adjust the height of the default face by the scale in
the pinch event EVENT.
(define-key ctl-x-map [(control meta ?-)] 'global-text-scale-adjust)
(define-key ctl-x-map [(control meta ?0)] 'global-text-scale-adjust)
(autoload 'global-text-scale-adjust "face-remap" "\
-Globally adjust the font size by INCREMENT.
+Change (a.k.a. \"adjust\") the font size of all faces by INCREMENT.
-Interactively, INCREMENT may be passed as a numeric prefix argument.
+Interactively, INCREMENT is the prefix numeric argument, and defaults
+to 1. Positive values of INCREMENT increase the font size, negative
+values decrease it.
-The adjustment made depends on the final component of the key binding
-used to invoke the command, with all modifiers removed:
+When you invoke this command, it performs the initial change of the
+font size, and after that allows further changes by typing one of the
+following keys immediately after invoking the command:
\\`+', \\`=' Globally increase the height of the default face
\\`-' Globally decrease the height of the default face
\\`0' Globally reset the height of the default face
-After adjusting, further adjust the font size as long as the key,
-with all modifiers removed, is one of the above characters.
+(The change of the font size produced by these keys depends on the
+final component of the key sequence, with all modifiers removed.)
Buffer-local face adjustments have higher priority than global
face adjustments.
@@ -21217,6 +21263,9 @@ a greeting from the server.
:nowait, if non-nil, says the connection should be made
asynchronously, if possible.
+:noquery - when exiting Emacs and the network process is running,
+don't query the user if it's non-nil.
+
:shell-command is a `format-spec' string that can be used if
:type is `shell'. It has two specs, %s for host and %p for port
number. Example: \"ssh gateway nc %s %p\".
@@ -23064,6 +23113,81 @@ Location of the file used to speed up activation of
packages at startup." :type
(register-definition-prefixes "package" '("bad-signature" "define-package"
"describe-package-1" "package-"))
+;;; Generated autoloads from emacs-lisp/package-vc.el
+
+(defvar package-vc-selected-packages 'nil "\
+List of packages that must be installed.
+Each member of the list 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 of the form described in
+ `package-vc-archive-spec-alist', giving a package
+ specification.
+
+This user option differs from `package-selected-packages' in that
+it is meant to be specified manually. You can also use the
+function `package-vc-selected-packages' to apply the changes.")
+(custom-autoload 'package-vc-selected-packages "package-vc" nil)
+(autoload 'package-vc-install "package-vc" "\
+Fetch a package NAME-OR-URL and set it up for using with Emacs.
+If NAME-OR-URL is a URL, download the package from the repository
+at that URL; the function will try to guess the name of the package
+from the URL. Otherwise NAME-OR-URL should be a symbol whose name
+is the package name, and the URL for the package will be taken from
+the package's metadata.
+By default, this function installs the last version of the package
+available from its repository, but if REV is given and non-nil, it
+specifies the revision to install. If REV has the special value
+`:last-release' (interactively, the prefix argument), that stands
+for the last released version of the package.
+When calling from Lisp, optional argument NAME overrides the package
+name as deduced from NAME-OR-URL.
+Optional argument BACKEND specifies the VC backend to use for cloning
+the package's repository; this is only possible if NAME-OR-URL is a URL,
+a string. If BACKEND is omitted or nil, the function
+uses `package-vc--guess-backend' to guess the backend.
+
+(fn NAME-OR-URL &optional NAME REV BACKEND)" t)
+(autoload 'package-vc-checkout "package-vc" "\
+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-link-directory' 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.
+
+(fn PKG-DESC DIRECTORY &optional REV)" t)
+(autoload 'package-vc-install-from-checkout "package-vc" "\
+Set up the package NAME in DIR by linking it into the ELPA directory.
+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. Otherwise infer the package
+name from the base name of DIR.
+
+(fn DIR NAME)" t)
+(autoload 'package-vc-refresh "package-vc" "\
+Refresh the installation for package given by PKG-DESC.
+Interactively, prompt for the name of the package to refresh.
+
+(fn PKG-DESC)" t)
+(autoload 'package-vc-prepare-patch "package-vc" "\
+Send patch for REVISIONS to maintainer of the package PKG using SUBJECT.
+SUBJECT and REVISIONS are passed on to `vc-prepare-patch', which see.
+PKG must be a package description.
+Interactively, prompt for PKG, SUBJECT, and REVISIONS. However,
+if the current buffer has marked commit log entries, REVISIONS
+are the tags of the marked entries, see `log-view-get-marked'.
+
+(fn PKG SUBJECT REVISIONS)" t)
+(register-definition-prefixes "package-vc" '("package-vc-"))
+
+
;;; Generated autoloads from emacs-lisp/package-x.el
(autoload 'package-upload-file "package-x" "\
@@ -24616,7 +24740,7 @@ Open profile FILENAME.
;;; Generated autoloads from progmodes/project.el
-(push (purecopy '(project 0 8 2)) package--builtin-versions)
+(push (purecopy '(project 0 8 3)) package--builtin-versions)
(autoload 'project-current "project" "\
Return the project instance in DIRECTORY, defaulting to `default-directory'.
@@ -26744,6 +26868,8 @@ Return ROT13 encryption of STRING.
(fn STRING)")
(autoload 'rot13-region "rot13" "\
ROT13 encrypt the region between START and END in current buffer.
+If invoked interactively and the buffer is read-only, a message
+will be printed instead.
(fn START END)" t)
(autoload 'rot13-other-window "rot13" "\
diff --git a/lisp/leim/quail/japanese.el b/lisp/leim/quail/japanese.el
index df080fc0e8..fb8b9e6166 100644
--- a/lisp/leim/quail/japanese.el
+++ b/lisp/leim/quail/japanese.el
@@ -359,7 +359,7 @@ input method.
The input method `japanese-zenkaku' is used to enter full width
JISX0208 characters corresponding to typed ASCII characters.
-List of the all key sequences for Roman-Kana transliteration is shown
+List of all the key sequences for Roman-Kana transliteration is shown
at the tail.
:: Kana-Kanji conversion ::
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 1597f3651a..7ac6396d31 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -222,6 +222,14 @@ be used instead."
(function :tag "Other function"))
:version "26.1")
+(defcustom browse-url-irc-function 'browse-url-irc
+ "Function to open an irc:// link."
+ :type '(choice
+ (function-item :tag "Emacs IRC" :value browse-url-irc)
+ (const :tag "None" nil)
+ (function :tag "Other function"))
+ :version "29.1")
+
(defcustom browse-url-button-regexp
(concat
"\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|gemini\\|"
@@ -547,6 +555,11 @@ process), or nil (we don't know)."
(function-put 'browse-url--man 'browse-url-browser-kind
#'browse-url--browser-kind-man)
+(defun browse-url--irc (url &rest args)
+ "Call `browse-url-irc-function' with URL and ARGS."
+ (funcall browse-url-irc-function url args))
+(function-put 'browse-url--irc 'browse-url-browser-kind 'internal)
+
(defun browse-url--browser (url &rest args)
"Call `browse-url-browser-function' with URL and ARGS."
(funcall browse-url-browser-function url args))
@@ -565,6 +578,7 @@ process), or nil (we don't know)."
(defvar browse-url-default-handlers
'(("\\`mailto:"; . browse-url--mailto)
("\\`man:" . browse-url--man)
+ ("\\`irc6?s?://" . browse-url--irc)
(browse-url--non-html-file-url-p . browse-url-emacs))
"Like `browse-url-handlers' but populated by Emacs and packages.
@@ -1510,6 +1524,16 @@ used instead of `browse-url-new-window-flag'."
(function-put 'browse-url-text-emacs 'browse-url-browser-kind 'internal)
+;; --- irc ---
+
+;;;###autoload
+(defun browse-url-irc (url &rest _)
+ "Call `url-irc' directly after parsing URL.
+This function is a fit for options like `gnus-button-alist'."
+ (url-irc (url-generic-parse-url url)))
+
+(function-put 'browse-url-irc 'browse-url-browser-kind 'internal)
+
;; --- mailto ---
(autoload 'rfc6068-parse-mailto-url "rfc6068")
diff --git a/lisp/net/eudc-capf.el b/lisp/net/eudc-capf.el
index 92f0c80493..e2bbd5b28b 100644
--- a/lisp/net/eudc-capf.el
+++ b/lisp/net/eudc-capf.el
@@ -123,11 +123,12 @@ queried for email addresses, and the results delivered to
(match-end 0)))
(end (point))
(prefix (save-excursion (buffer-substring-no-properties beg
end))))
- (list beg end
- (completion-table-with-cache
- (lambda (_)
- (eudc-query-with-words (split-string prefix "[ \t]+") t))
- t))))))
+ (let ((result
+ (eudc-query-with-words (split-string prefix "[ \t]+") t)))
+ (when result
+ (list beg end
+ (completion-table-with-cache
+ (lambda (_) result) t))))))))
(provide 'eudc-capf)
;;; eudc-capf.el ends here
diff --git a/lisp/org/ol.el b/lisp/org/ol.el
index 4ad1f6d345..108f031cde 100644
--- a/lisp/org/ol.el
+++ b/lisp/org/ol.el
@@ -339,7 +339,7 @@ another window."
(defcustom org-link-search-must-match-exact-headline 'query-to-create
"Non-nil means internal fuzzy links can only match headlines.
-When nil, the a fuzzy link may point to a target or a named
+When nil, the fuzzy link may point to a target or a named
construct in the document. When set to the special value
`query-to-create', offer to create a new headline when none
matched.
diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el
index d96898372f..78148a1b6d 100644
--- a/lisp/org/org-faces.el
+++ b/lisp/org/org-faces.el
@@ -137,7 +137,7 @@ The following faces apply, with this priority.
Since column view works by putting overlays with a display property
over individual characters in the buffer, the face of the underlining
-character (this might for example be the a TODO keyword) might still
+character (this might for example be the TODO keyword) might still
shine through in some properties. So when your column view looks
funny, with \"random\" colors, weight, strike-through, try to explicitly
set the properties in the `org-column' face. For example, set
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 12808e80c4..397c8e0937 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -1688,7 +1688,7 @@ For example, to keep your Company customization, add the
symbol
`company' to this variable.")
(defun eglot--stay-out-of-p (symbol)
- "Tell if Eglot should stay of of SYMBOL."
+ "Tell if Eglot should stay out of SYMBOL."
(cl-find (symbol-name symbol) eglot-stay-out-of
:test (lambda (s thing)
(let ((re (if (symbolp thing) (symbol-name thing) thing)))
@@ -2298,8 +2298,7 @@ Instead of a plist, an alist ((SECTION . VALUE) ...) can
be used
instead, but this variant is less reliable and not recommended.
This variable should be set as a directory-local variable. See
-See info node `(emacs)Directory Variables' for various ways to to
-that.
+info node `(emacs)Directory Variables' for various ways to do that.
Here's an example value that establishes two sections relevant to
the Pylsp and Gopls LSP servers:
@@ -3213,7 +3212,7 @@ at point. With prefix argument, prompt for ACTION-KIND."
actions)))
(defun eglot--read-execute-code-action (actions server &optional action-kind)
- "Helper for interactive calls to `eglot-code-actions'"
+ "Helper for interactive calls to `eglot-code-actions'."
(let* ((menu-items
(or (cl-loop for a in actions
collect (cons (plist-get a :title) a))
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 537b9484bd..5b3e0146fa 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -280,7 +280,9 @@ Comments in the form will be lost."
(remove-hook 'electric-pair-mode-hook #'emacs-lisp-set-electric-text-pairs))
(defun elisp-enable-lexical-binding (&optional interactive)
- "Make the current buffer use `lexical-binding'."
+ "Make the current buffer use `lexical-binding'.
+INTERACTIVE non-nil means ask the user for confirmation; this
+happens in interactive invocations."
(interactive "p")
(if lexical-binding
(when interactive
@@ -360,7 +362,7 @@ be used instead.
;;; Completion at point for Elisp
(defun elisp--local-variables-1 (vars sexp)
- "Return the vars locally bound around the witness, or nil if not found."
+ "Return VARS locally bound around the witness, or nil if not found."
(let (res)
(while
(unless
@@ -463,7 +465,7 @@ be used instead.
lastvars)))))
(defun elisp--expect-function-p (pos)
- "Return non-nil if the symbol at point is expected to be a function."
+ "Return non-nil if the symbol at position POS is expected to be a function."
(or
(and (eq (char-before pos) ?')
(eq (char-before (1- pos)) ?#))
@@ -1331,12 +1333,12 @@ Semicolons start comments.
(defun eval-print-last-sexp (&optional eval-last-sexp-arg-internal)
"Evaluate sexp before point; print value into current buffer.
+Interactively, EVAL-LAST-SEXP-ARG-INTERNAL is the prefix numeric argument.
Normally, this function truncates long output according to the value
of the variables `eval-expression-print-length' and
-`eval-expression-print-level'. With a prefix argument of zero,
-however, there is no such truncation. Such a prefix argument
-also causes integers to be printed in several additional formats
-\(octal, hexadecimal, and character).
+`eval-expression-print-level'. But if EVAL-LAST-SEXP-ARG-INTERNAL is zero,
+there is no such truncation, and integers are printed in several additional
+formats (octal, hexadecimal, and character).
If `eval-expression-debug-on-error' is non-nil, which is the default,
this command arranges for all errors to enter the debugger."
@@ -1557,8 +1559,8 @@ POS specifies the starting position where EXP was found
and defaults to point."
(defun eval-last-sexp (eval-last-sexp-arg-internal)
"Evaluate sexp before point; print value in the echo area.
-Interactively, with a non `-' prefix argument, print output into
-current buffer.
+Interactively, EVAL-LAST-SEXP-ARG-INTERNAL is the prefix argument.
+With a non `-' prefix argument, print output into current buffer.
This commands handles `defvar', `defcustom' and `defface' the
same way that `eval-defun' does. See the doc string of that
@@ -1588,7 +1590,7 @@ this command arranges for all errors to enter the
debugger."
(car value))))
(defun elisp--eval-defun-1 (form)
- "Treat some expressions specially.
+ "Treat some expressions in FORM specially.
Reset the `defvar' and `defcustom' variables to the initial value.
\(For `defcustom', use the :set function if there is one.)
Reinitialize the face according to the `defface' specification."
@@ -1688,7 +1690,7 @@ Return the result of evaluation."
elisp--eval-defun-result))
(defun eval-defun (edebug-it)
- "Evaluate the top-level form containing point.
+ "Evaluate EDEBUG-IT or the top-level form containing point.
If point isn't in a top-level form, evaluate the first top-level
form after point. If there is no top-level form after point,
eval the first preceeding top-level form.
@@ -1734,7 +1736,8 @@ which see."
;;; ElDoc Support
(defvar elisp--eldoc-last-data (make-vector 3 nil)
- "Bookkeeping; elements are as follows:
+ "Bookkeeping.
+Elements are as follows:
0 - contains the last symbol read from the buffer.
1 - contains the string last displayed in the echo area for variables,
or argument string for functions.
@@ -1766,7 +1769,7 @@ it is preferable to use ElDoc's interfaces directly.")
"use ElDoc's interfaces instead." "28.1")
(defun elisp-eldoc-funcall (callback &rest _ignored)
- "Document function call at point.
+ "Document function call at point by calling CALLBACK.
Intended for `eldoc-documentation-functions' (which see)."
(let* ((sym-info (elisp--fnsym-in-current-sexp))
(fn-sym (car sym-info)))
@@ -1778,7 +1781,7 @@ Intended for `eldoc-documentation-functions' (which see)."
'font-lock-keyword-face)))))
(defun elisp-eldoc-var-docstring (callback &rest _ignored)
- "Document variable at point.
+ "Document variable at point by calling CALLBACK.
Intended for `eldoc-documentation-functions' (which see).
Also see `elisp-eldoc-var-docstring-with-value'."
(let* ((sym (elisp--current-symbol))
@@ -1789,7 +1792,7 @@ Also see `elisp-eldoc-var-docstring-with-value'."
:face 'font-lock-variable-name-face))))
(defun elisp-eldoc-var-docstring-with-value (callback &rest _)
- "Document variable at point.
+ "Document variable at point by calling CALLBACK.
Intended for `eldoc-documentation-functions' (which see).
Compared to `elisp-eldoc-var-docstring', this also includes the
current variable value and a bigger chunk of the docstring."
@@ -1817,6 +1820,7 @@ current variable value and a bigger chunk of the
docstring."
(defun elisp-get-fnsym-args-string (sym &optional index)
"Return a string containing the parameter list of the function SYM.
+INDEX is the index of the parameter in the returned string to highlight.
If SYM is a subr and no arglist is obtainable from the docstring
or elsewhere, return a 1-line docstring."
(let ((argstring
@@ -1847,7 +1851,8 @@ or elsewhere, return a 1-line docstring."
sym argstring index))))
(defun elisp--highlight-function-argument (sym args index)
- "Highlight argument INDEX in ARGS list for function SYM."
+ "Highlight the argument of function SYM whose index is INDEX.
+ARGS is the argument list of function SYM."
;; FIXME: This should probably work on the list representation of `args'
;; rather than its string representation.
;; FIXME: This function is much too long, we need to split it up!
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index ed26872ae7..63510e9050 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -712,6 +712,7 @@ DIRS must contain directory names."
(define-key map "G" 'project-or-external-find-regexp)
(define-key map "r" 'project-query-replace-regexp)
(define-key map "x" 'project-execute-extended-command)
+ (define-key map "\C-b" 'project-list-buffers)
map)
"Keymap for project commands.")
@@ -1222,6 +1223,28 @@ displayed."
(interactive (list (project--read-project-buffer)))
(display-buffer-other-frame buffer-or-name))
+;;;###autoload
+(defun project-list-buffers (&optional arg)
+ "Display a list of project buffers.
+The list is displayed in a buffer named \"*Buffer List*\".
+
+By default, all project buffers are listed except those whose names
+start with a space (which are for internal use). With prefix argument
+ARG, show only buffers that are visiting files."
+ (interactive "P")
+ (let ((pr (project-current t)))
+ (display-buffer
+ (if (version< emacs-version "29.0.50")
+ (let ((buf (list-buffers-noselect arg (project-buffers pr))))
+ (with-current-buffer buf
+ (setq-local revert-buffer-function
+ (lambda (&rest _ignored)
+ (list-buffers--refresh (project-buffers pr))
+ (tabulated-list-print t))))
+ buf)
+ (list-buffers-noselect
+ arg nil (lambda (buf) (memq buf (project-buffers pr))))))))
+
(defcustom project-kill-buffer-conditions
'(buffer-file-name ; All file-visiting buffers are included.
;; Most of temp and logging buffers (aside from hidden ones):
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index bb36688ef8..89a090ae93 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1237,16 +1237,21 @@ local keymap that binds `RET' to
`xref-quit-and-goto-xref'."
(max-height (/ (window-height) 2))
(size-fun (lambda (window)
(fit-window-to-buffer window max-height)))
+ xref-alist
buf)
(cond
((not (cdr xrefs))
(xref-pop-to-location (car xrefs)
(assoc-default 'display-action alist)))
(t
+ ;; Call it here because it can call (project-current), and that
+ ;; might depend on individual buffer, not just directory.
+ (setq xref-alist (xref--analyze xrefs))
+
(with-current-buffer (get-buffer-create xref-buffer-name)
(xref--ensure-default-directory dd (current-buffer))
(xref--transient-buffer-mode)
- (xref--show-common-initialize (xref--analyze xrefs) fetcher alist)
+ (xref--show-common-initialize xref-alist fetcher alist)
(pop-to-buffer (current-buffer)
`(display-buffer-in-direction . ((direction . below)
(window-height .
,size-fun))))
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 0ae68d6024..f2e1c0ad5a 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -588,21 +588,32 @@ Used in `repeat-mode'."
(when (and (symbolp (car a))
(symbolp (car b)))
(string-lessp (car a) (car b))))))
- (insert (format-message
- "`%s' keymap is repeatable by these commands:\n"
- (car keymap)))
- (dolist (command (sort (cdr keymap) #'string-lessp))
- (let* ((info (help-fns--analyze-function command))
- (map (list (if (symbolp (car keymap))
- (symbol-value (car keymap))
- (car keymap))))
- (desc (mapconcat (lambda (key)
- (propertize (key-description key)
- 'face 'help-key-binding))
- (or (where-is-internal command map)
- (where-is-internal (nth 3 info) map))
- ", ")))
- (insert (format-message " `%s' (bound to %s)\n" command
desc))))
+ (insert (format-message "* `%s'\n" (car keymap)))
+
+ (let* ((map (if (symbolp (car keymap))
+ (symbol-value (car keymap))
+ (car keymap)))
+ (repeat-commands (cdr keymap))
+ map-commands commands-enter commands-exit)
+ (map-keymap (lambda (_key cmd) (when (symbolp cmd) (push cmd
map-commands))) map)
+ (setq map-commands (seq-uniq map-commands))
+ (setq commands-enter (seq-difference repeat-commands
map-commands))
+ (setq commands-exit (seq-difference map-commands
repeat-commands))
+
+ (when (or commands-enter commands-exit) (insert "\n"))
+ (when commands-enter
+ (insert (concat "Entered with: "
+ (mapconcat (lambda (cmd) (format-message
"`%s'" cmd))
+ commands-enter ", ")
+ "\n")))
+ (when commands-exit
+ (insert (concat "Exited with: "
+ (mapconcat (lambda (cmd) (format-message
"`%s'" cmd))
+ commands-exit ", ")
+ "\n"))))
+
+ (when (symbolp (car keymap))
+ (insert (substitute-command-keys (format-message "\\{%s}" (car
keymap)))))
(insert "\n")))))))
(provide 'repeat)
diff --git a/lisp/server.el b/lisp/server.el
index 90d97c1538..553890ce29 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -670,7 +670,6 @@ the `server-process' variable."
"/tmp/")
(ignore-errors
(delete-directory (file-name-directory server-file))))))
- (setq server-mode nil) ;; already set by the minor mode code
(display-warning
'server
(concat "Unable to start the Emacs server.\n"
@@ -688,7 +687,9 @@ server or call `\\[server-force-delete]' to forcibly
disconnect it."))
(if leave-dead
(progn
(unless (eq t leave-dead) (server-log (message "Server stopped")))
- (setq server-process nil))
+ (setq server-mode nil
+ global-minor-modes (delq 'server-mode global-minor-modes)
+ server-process nil))
;; Make sure there is a safe directory in which to place the socket.
(server-ensure-safe-dir server-dir)
(when server-process
@@ -728,6 +729,8 @@ server or call `\\[server-force-delete]' to forcibly
disconnect it."))
:plist '(:authenticated t)))))
(unless server-process (error "Could not start server process"))
(process-put server-process :server-file server-file)
+ (setq server-mode t)
+ (push 'server-mode global-minor-modes)
(when server-use-tcp
(let ((auth-key (server-get-auth-key)))
(process-put server-process :auth-key auth-key)
@@ -796,6 +799,10 @@ by the current Emacs process, use the `server-process'
variable."
t)
(file-error nil)))
+;; This keymap is empty, but allows users to define keybindings to use
+;; when `server-mode' is active.
+(defvar-keymap server-mode-map)
+
;;;###autoload
(define-minor-mode server-mode
"Toggle Server mode.
@@ -805,6 +812,7 @@ Server mode runs a process that accepts commands from the
`server-start' for details."
:global t
:version "22.1"
+ :keymap server-mode-map
;; Fixme: Should this check for an existing server socket and do
;; nothing if there is one (for multiple Emacs sessions)?
(server-start (not server-mode)))
diff --git a/lisp/simple.el b/lisp/simple.el
index a53b7b1d0d..0f44b14948 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2494,9 +2494,10 @@ Also see `suggest-key-bindings'."
(defun execute-extended-command--describe-binding-msg (function binding
shorter)
(format-message "You can run the command `%s' with %s"
function
- (cond (shorter (concat "M-x " shorter))
- ((stringp binding) binding)
- (t (key-description binding)))))
+ (propertize (cond (shorter (concat "M-x " shorter))
+ ((stringp binding) binding)
+ (t (key-description binding)))
+ 'face 'help-key-binding)))
(defun execute-extended-command (prefixarg &optional command-name typed)
"Read a command name, then read the arguments and call the command.
diff --git a/lisp/subr.el b/lisp/subr.el
index 6b83196d05..adaa0a9135 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -7061,7 +7061,7 @@ CONDITION is either:
(defun match-buffers (condition &optional buffers arg)
"Return a list of buffers that match CONDITION.
-See `buffer-match' for details on CONDITION. By default all
+See `buffer-match-p' for details on CONDITION. By default all
buffers are checked, this can be restricted by passing an
optional argument BUFFERS, set to a list of buffers to check.
ARG is passed to `buffer-match', for predicate conditions in
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
index 9161f7d13e..f97b6de6fe 100644
--- a/lisp/url/url-irc.el
+++ b/lisp/url/url-irc.el
@@ -38,11 +38,13 @@ The function should take the following arguments:
PORT - the port number of the IRC server to contact
CHANNEL - What channel on the server to visit right away (can be nil)
USER - What username to use
-PASSWORD - What password to use"
+PASSWORD - What password to use.
+ SCHEME - a URI scheme, such as \"irc\" or \"ircs\""
:type '(choice (const :tag "rcirc" :value url-irc-rcirc)
(const :tag "ERC" :value url-irc-erc)
(const :tag "ZEN IRC" :value url-irc-zenirc)
(function :tag "Other"))
+ :version "29.1" ; Added SCHEME
:group 'url)
;; External.
@@ -51,7 +53,7 @@ PASSWORD - What password to use"
(defvar zenirc-server-alist)
(defvar zenirc-buffer-name)
-(defun url-irc-zenirc (host port channel user password)
+(defun url-irc-zenirc (host port channel user password _)
(let ((zenirc-buffer-name (if (and user host port)
(format "%s@%s:%d" user host port)
(format "%s:%d" host port)))
@@ -65,14 +67,14 @@ PASSWORD - What password to use"
(insert "/join " channel)
(zenirc-send-line))))
-(defun url-irc-rcirc (host port channel user password)
+(defun url-irc-rcirc (host port channel user password _)
(let ((chan (when channel (concat "#" channel))))
(rcirc-connect host port user nil nil (when chan (list chan)) password)
(when chan
(switch-to-buffer (concat chan "@" host)))))
-(defun url-irc-erc (host port channel user password)
- (erc-handle-irc-url host port channel user password))
+(defun url-irc-erc (host port channel user password scheme)
+ (erc-handle-irc-url host port channel user password scheme))
;;;###autoload
(defun url-irc (url)
@@ -80,16 +82,32 @@ PASSWORD - What password to use"
(port (url-port url))
(pass (url-password url))
(user (url-user url))
- (chan (url-filename url)))
+ (chan (url-filename url))
+ (type (url-type url))
+ (compatp (eql 5 (cdr (func-arity url-irc-function)))))
(if (url-target url)
(setq chan (concat chan "#" (url-target url))))
(if (string-match "^/" chan)
(setq chan (substring chan 1 nil)))
(if (= (length chan) 0)
(setq chan nil))
- (funcall url-irc-function host port chan user pass)
+ (when compatp
+ (lwarn 'url :error "Obsolete value for `url-irc-function'"))
+ (apply url-irc-function
+ host port chan user pass (unless compatp (list type)))
nil))
+;;;; ircs://
+
+;; The function `url-scheme-get-property' tries and fails to load the
+;; nonexistent url-ircs.el but falls back to using the following:
+
+;;;###autoload
+(defconst url-ircs-default-port 6697 "Default port for IRCS connections.")
+
+;;;###autoload
+(defalias 'url-ircs 'url-irc)
+
(provide 'url-irc)
;;; url-irc.el ends here
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 513fbb23fe..fd59c95fc8 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -3567,7 +3567,7 @@ to provide the `find-revision' operation instead."
(defun vc-clone (remote &optional backend directory rev)
"Use BACKEND to clone REMOTE into DIRECTORY.
-If successful, returns the a string with the directory of the
+If successful, returns the string with the directory of the
checkout. If BACKEND is nil, iterate through every known backend
in `vc-handled-backends' until one succeeds. If REV is non-nil,
it indicates a specific revision to check out."
diff --git a/src/comp.c b/src/comp.c
index 315ab4afff..89e16b1c4b 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -8064,7 +8064,7 @@ file_in_eln_sys_dir (Lisp_Object filename)
/* Load related routines. */
DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0,
doc: /* Load native elisp code FILENAME.
-LATE_LOAD has to be non-nil when loading for deferred compilation. */)
+LATE-LOAD has to be non-nil when loading for deferred compilation. */)
(Lisp_Object filename, Lisp_Object late_load)
{
CHECK_STRING (filename);
diff --git a/src/frame.c b/src/frame.c
index f076a5ba54..bfdd03e501 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -4749,7 +4749,7 @@ gui_set_font_backend (struct frame *f, Lisp_Object
new_value, Lisp_Object old_va
if (FRAME_FONT (f))
{
/* Reconsider default font after backend(s) change (Bug#23386). */
- FRAME_RIF(f)->default_font_parameter (f, Qnil);
+ FRAME_RIF (f)->default_font_parameter (f, Qnil);
face_change = true;
windows_or_buffers_changed = 18;
}
@@ -5946,6 +5946,37 @@ This function is for internal use only. */)
return f->was_invisible ? Qt : Qnil;
}
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+DEFUN ("reconsider-frame-fonts", Freconsider_frame_fonts,
+ Sreconsider_frame_fonts, 1, 1, 0,
+ doc: /* Recreate FRAME's default font using updated font parameters.
+Signal an error if FRAME is not a window system frame. This should be
+called after a `config-changed' event is received, signalling that the
+parameters (such as pixel density) used by the system to open fonts
+have changed. */)
+ (Lisp_Object frame)
+{
+ struct frame *f;
+
+ f = decode_window_system_frame (frame);
+
+ /* First, call this to reinitialize any font backend specific
+ stuff. */
+
+ if (FRAME_RIF (f)->default_font_parameter)
+ FRAME_RIF (f)->default_font_parameter (f, Qnil);
+
+ /* Now call this to apply the existing value(s) of the `default'
+ face. */
+ call1 (Qface_set_after_frame_default, frame);
+
+ return Qnil;
+}
+
+#endif
+
/***********************************************************************
Multimonitor data
@@ -6634,6 +6665,6 @@ iconify the top level frame instead. */);
#ifdef HAVE_WINDOW_SYSTEM
defsubr (&Sx_get_resource);
defsubr (&Sx_parse_geometry);
+ defsubr (&Sreconsider_frame_fonts);
#endif
-
}
diff --git a/src/ftcrfont.c b/src/ftcrfont.c
index dc765e5aee..ede8f1323c 100644
--- a/src/ftcrfont.c
+++ b/src/ftcrfont.c
@@ -737,7 +737,7 @@ struct font_driver const ftcrfont_driver =
.filter_properties = ftfont_filter_properties,
.combining_capability = ftfont_combining_capability,
#ifdef HAVE_PGTK
- .cached_font_ok = ftcrfont_cached_font_ok
+ .cached_font_ok = ftcrfont_cached_font_ok,
#endif
};
#ifdef HAVE_HARFBUZZ
@@ -755,6 +755,42 @@ syms_of_ftcrfont (void)
pdumper_do_now_and_after_load (syms_of_ftcrfont_for_pdumper);
}
+#ifdef HAVE_X_WINDOWS
+
+/* Place the default font options used by Cairo on the given display
+ in OPTIONS. */
+
+void
+ftcrfont_get_default_font_options (struct x_display_info *dpyinfo,
+ cairo_font_options_t *options)
+{
+ Pixmap drawable;
+ cairo_surface_t *surface;
+
+ /* Cairo doesn't allow fetching the default font options for a
+ display, so the only option is to create a drawable, and an Xlib
+ surface for that drawable, and to get the font options from there
+ instead. */
+
+ drawable = XCreatePixmap (dpyinfo->display, dpyinfo->root_window,
+ 1, 1, dpyinfo->n_planes);
+ surface = cairo_xlib_surface_create (dpyinfo->display, drawable,
+ dpyinfo->visual, 1, 1);
+
+ if (!surface)
+ {
+ XFreePixmap (dpyinfo->display, drawable);
+ return;
+ }
+
+ cairo_surface_get_font_options (surface, options);
+ XFreePixmap (dpyinfo->display, drawable);
+ cairo_surface_destroy (surface);
+ return;
+}
+
+#endif
+
static void
syms_of_ftcrfont_for_pdumper (void)
{
diff --git a/src/ftfont.h b/src/ftfont.h
index cfab8d3154..ee56e2d760 100644
--- a/src/ftfont.h
+++ b/src/ftfont.h
@@ -84,4 +84,11 @@ struct font_info
#endif
};
+#if defined USE_CAIRO && defined HAVE_X_WINDOWS
+
+extern void ftcrfont_get_default_font_options (struct x_display_info *,
+ cairo_font_options_t *);
+
+#endif /* USE_CAIRO && HAVE_X_WINDOWS */
+
#endif /* EMACS_FTFONT_H */
diff --git a/src/haikufns.c b/src/haikufns.c
index 711202c5df..5717d0354f 100644
--- a/src/haikufns.c
+++ b/src/haikufns.c
@@ -175,10 +175,19 @@ haiku_change_tool_bar_height (struct frame *f, int height)
void
haiku_change_tab_bar_height (struct frame *f, int height)
{
- int unit = FRAME_LINE_HEIGHT (f);
- int old_height = FRAME_TAB_BAR_HEIGHT (f);
- int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ int unit, old_height, lines;
+ Lisp_Object fullscreen;
+
+ unit = FRAME_LINE_HEIGHT (f);
+ old_height = FRAME_TAB_BAR_HEIGHT (f);
+ fullscreen = get_frame_param (f, Qfullscreen);
+
+ /* This differs from the tool bar code in that the tab bar height is
+ not rounded up. Otherwise, if redisplay_tab_bar decides to grow
+ the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed,
+ leading to the tab bar height being incorrectly set upon the next
+ call to x_set_font. (bug#59285) */
+ lines = height / unit;
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
diff --git a/src/itree.c b/src/itree.c
index ae69c97d6d..da0242905c 100644
--- a/src/itree.c
+++ b/src/itree.c
@@ -155,7 +155,7 @@ nav_flag (nodeptr_and_flag nav)
}
/* Simple dynamic array. */
-struct interval_stack
+struct itree_stack
{
nodeptr_and_flag *nodes;
size_t size;
@@ -164,10 +164,10 @@ struct interval_stack
/* This is just a simple dynamic array with stack semantics. */
-static struct interval_stack*
-interval_stack_create (intmax_t initial_size)
+static struct itree_stack*
+itree_stack_create (intmax_t initial_size)
{
- struct interval_stack *stack = xmalloc (sizeof (struct interval_stack));
+ struct itree_stack *stack = xmalloc (sizeof (struct itree_stack));
stack->size = max (0, initial_size);
stack->nodes = xmalloc (stack->size * sizeof (struct itree_node*));
stack->length = 0;
@@ -175,7 +175,7 @@ interval_stack_create (intmax_t initial_size)
}
static void
-interval_stack_destroy (struct interval_stack *stack)
+itree_stack_destroy (struct itree_stack *stack)
{
if (! stack)
return;
@@ -185,13 +185,13 @@ interval_stack_destroy (struct interval_stack *stack)
}
static void
-interval_stack_clear (struct interval_stack *stack)
+itree_stack_clear (struct itree_stack *stack)
{
stack->length = 0;
}
static inline void
-interval_stack_ensure_space (struct interval_stack *stack, uintmax_t nelements)
+itree_stack_ensure_space (struct itree_stack *stack, uintmax_t nelements)
{
if (nelements > stack->size)
{
@@ -204,31 +204,31 @@ interval_stack_ensure_space (struct interval_stack
*stack, uintmax_t nelements)
/* Push NODE on the STACK, while settings its visited flag to FLAG. */
static inline void
-interval_stack_push_flagged (struct interval_stack *stack,
+itree_stack_push_flagged (struct itree_stack *stack,
struct itree_node *node, bool flag)
{
eassert (node);
/* FIXME: While the stack used in the iterator is bounded by the tree
depth and could be easily pre-allocated to a large enough size to avoid
- this "ensure" check, `interval_stack_push` is also used elsewhere to
+ this "ensure" check, `itree_stack_push` is also used elsewhere to
simply collect some subset of the overlays, where it's only bounded by
the total number of overlays in the buffer (which can be large and thus
preferably not pre-allocated needlessly). */
- interval_stack_ensure_space (stack, stack->length + 1);
+ itree_stack_ensure_space (stack, stack->length + 1);
stack->nodes[stack->length] = make_nav (node, flag);
stack->length++;
}
static inline void
-interval_stack_push (struct interval_stack *stack, struct itree_node *node)
+itree_stack_push (struct itree_stack *stack, struct itree_node *node)
{
- interval_stack_push_flagged (stack, node, false);
+ itree_stack_push_flagged (stack, node, false);
}
static inline nodeptr_and_flag
-interval_stack_pop (struct interval_stack *stack)
+itree_stack_pop (struct itree_stack *stack)
{
if (stack->length == 0)
return make_nav (NULL, false);
@@ -241,7 +241,7 @@ interval_stack_pop (struct interval_stack *stack)
/* State used when iterating interval. */
struct itree_iterator
{
- struct interval_stack *stack;
+ struct itree_stack *stack;
ptrdiff_t begin;
ptrdiff_t end;
@@ -261,7 +261,7 @@ struct itree_iterator
static struct itree_iterator *iter = NULL;
static int
-interval_tree_max_height (const struct itree_tree *tree)
+itree_max_height (const struct itree_tree *tree)
{
return 2 * log (tree->size + 1) / log (2) + 0.5;
}
@@ -276,9 +276,9 @@ itree_iterator_create (struct itree_tree *tree)
FIXME: Since this stack only needs to be about 2*max_depth
in the worst case, we could completely pre-allocate it to something
like word-bit-size * 2 and then never worry about growing it. */
- const int size = (tree ? interval_tree_max_height (tree) : 19) + 1;
+ const int size = (tree ? itree_max_height (tree) : 19) + 1;
- g->stack = interval_stack_create (size);
+ g->stack = itree_stack_create (size);
g->running = false;
g->begin = 0;
g->end = 0;
@@ -334,7 +334,7 @@ check_subtree (struct itree_node *node,
and <= to its parent's otick.
Note: we cannot assert that (NODE.otick == NODE.parent.otick)
- implies (NODE.offset == 0) because interval_tree_inherit_offset()
+ implies (NODE.offset == 0) because itree_inherit_offset()
doesn't always update otick. It could, but it is not clear there
is a need. */
eassert (node->otick <= tree_otick);
@@ -438,7 +438,7 @@ itree_newlimit (struct itree_node *node)
/* Update NODE's limit attribute according to its children. */
static void
-interval_tree_update_limit (struct itree_node *node)
+itree_update_limit (struct itree_node *node)
{
if (node == NULL)
return;
@@ -453,7 +453,7 @@ interval_tree_update_limit (struct itree_node *node)
*/
static void
-interval_tree_inherit_offset (uintmax_t otick, struct itree_node *node)
+itree_inherit_offset (uintmax_t otick, struct itree_node *node)
{
eassert (node->parent == NULL || node->parent->otick >= node->otick);
if (node->otick == otick)
@@ -490,7 +490,7 @@ interval_tree_inherit_offset (uintmax_t otick, struct
itree_node *node)
stable, i.e. new_limit = old_limit. */
static void
-interval_tree_propagate_limit (struct itree_node *node)
+itree_propagate_limit (struct itree_node *node)
{
ptrdiff_t newlimit;
@@ -511,15 +511,15 @@ interval_tree_propagate_limit (struct itree_node *node)
}
static struct itree_node*
-interval_tree_validate (struct itree_tree *tree, struct itree_node *node)
+itree_validate (struct itree_tree *tree, struct itree_node *node)
{
if (tree->otick == node->otick || node == NULL)
return node;
if (node != tree->root)
- interval_tree_validate (tree, node->parent);
+ itree_validate (tree, node->parent);
- interval_tree_inherit_offset (tree->otick, node);
+ itree_inherit_offset (tree->otick, node);
return node;
}
@@ -550,7 +550,7 @@ ptrdiff_t
itree_node_begin (struct itree_tree *tree,
struct itree_node *node)
{
- interval_tree_validate (tree, node);
+ itree_validate (tree, node);
return node->begin;
}
@@ -560,7 +560,7 @@ ptrdiff_t
itree_node_end (struct itree_tree *tree,
struct itree_node *node)
{
- interval_tree_validate (tree, node);
+ itree_validate (tree, node);
return node->end;
}
@@ -588,7 +588,7 @@ itree_clear (struct itree_tree *tree)
/* Initialize a pre-allocated tree (presumably on the stack). */
static void
-interval_tree_init (struct itree_tree *tree)
+itree_init (struct itree_tree *tree)
{
itree_clear (tree);
}
@@ -613,15 +613,15 @@ itree_size (struct itree_tree *tree)
/* Perform the familiar left-rotation on node NODE. */
static void
-interval_tree_rotate_left (struct itree_tree *tree,
+itree_rotate_left (struct itree_tree *tree,
struct itree_node *node)
{
eassert (node->right != NULL);
struct itree_node *right = node->right;
- interval_tree_inherit_offset (tree->otick, node);
- interval_tree_inherit_offset (tree->otick, right);
+ itree_inherit_offset (tree->otick, node);
+ itree_inherit_offset (tree->otick, right);
/* Turn right's left subtree into node's right subtree. */
node->right = right->left;
@@ -649,22 +649,22 @@ interval_tree_rotate_left (struct itree_tree *tree,
node->parent = right;
/* Order matters here. */
- interval_tree_update_limit (node);
- interval_tree_update_limit (right);
+ itree_update_limit (node);
+ itree_update_limit (right);
}
/* Perform the familiar right-rotation on node NODE. */
static void
-interval_tree_rotate_right (struct itree_tree *tree,
+itree_rotate_right (struct itree_tree *tree,
struct itree_node *node)
{
eassert (tree && node && node->left != NULL);
struct itree_node *left = node->left;
- interval_tree_inherit_offset (tree->otick, node);
- interval_tree_inherit_offset (tree->otick, left);
+ itree_inherit_offset (tree->otick, node);
+ itree_inherit_offset (tree->otick, left);
node->left = left->right;
if (left->right != NULL)
@@ -686,8 +686,8 @@ interval_tree_rotate_right (struct itree_tree *tree,
if (node != NULL)
node->parent = left;
- interval_tree_update_limit (left);
- interval_tree_update_limit (node);
+ itree_update_limit (left);
+ itree_update_limit (node);
}
/* Repair the tree after an insertion.
@@ -695,7 +695,7 @@ interval_tree_rotate_right (struct itree_tree *tree,
Rebalance the parents as needed to re-establish the RB invariants. */
static void
-interval_tree_insert_fix (struct itree_tree *tree,
+itree_insert_fix (struct itree_tree *tree,
struct itree_node *node)
{
eassert (tree->root->red == false);
@@ -729,12 +729,12 @@ interval_tree_insert_fix (struct itree_tree *tree,
if (node == node->parent->right) /* case 2.a */
{
node = node->parent;
- interval_tree_rotate_left (tree, node);
+ itree_rotate_left (tree, node);
}
/* case 3.a */
node->parent->red = false;
node->parent->parent->red = true;
- interval_tree_rotate_right (tree, node->parent->parent);
+ itree_rotate_right (tree, node->parent->parent);
}
}
else
@@ -754,12 +754,12 @@ interval_tree_insert_fix (struct itree_tree *tree,
if (node == node->parent->left) /* case 2.b */
{
node = node->parent;
- interval_tree_rotate_right (tree, node);
+ itree_rotate_right (tree, node);
}
/* case 3.b */
node->parent->red = false;
node->parent->parent->red = true;
- interval_tree_rotate_left (tree, node->parent->parent);
+ itree_rotate_left (tree, node->parent->parent);
}
}
}
@@ -774,7 +774,7 @@ interval_tree_insert_fix (struct itree_tree *tree,
Note, that inserting a node twice results in undefined behavior. */
static void
-interval_tree_insert (struct itree_tree *tree, struct itree_node *node)
+itree_insert_node (struct itree_tree *tree, struct itree_node *node)
{
eassert (node && node->begin <= node->end);
/* FIXME: The assertion below fails because `delete_all_overlays`
@@ -794,7 +794,7 @@ interval_tree_insert (struct itree_tree *tree, struct
itree_node *node)
ancestors limit values. */
while (child != NULL)
{
- interval_tree_inherit_offset (otick, child);
+ itree_inherit_offset (otick, child);
parent = child;
eassert (child->offset == 0);
child->limit = max (child->limit, node->end);
@@ -827,7 +827,7 @@ interval_tree_insert (struct itree_tree *tree, struct
itree_node *node)
{
node->red = true;
eassert (check_tree (tree, false)); /* FIXME: Too expensive. */
- interval_tree_insert_fix (tree, node);
+ itree_insert_fix (tree, node);
}
}
@@ -838,7 +838,7 @@ itree_insert (struct itree_tree *tree, struct itree_node
*node,
node->begin = begin;
node->end = end;
node->otick = tree->otick;
- interval_tree_insert (tree, node);
+ itree_insert_node (tree, node);
}
/* Safely modify a node's interval. */
@@ -848,26 +848,26 @@ itree_node_set_region (struct itree_tree *tree,
struct itree_node *node,
ptrdiff_t begin, ptrdiff_t end)
{
- interval_tree_validate (tree, node);
+ itree_validate (tree, node);
if (begin != node->begin)
{
itree_remove (tree, node);
node->begin = min (begin, PTRDIFF_MAX - 1);
node->end = max (node->begin, end);
- interval_tree_insert (tree, node);
+ itree_insert_node (tree, node);
}
else if (end != node->end)
{
node->end = max (node->begin, end);
eassert (node != NULL);
- interval_tree_propagate_limit (node);
+ itree_propagate_limit (node);
}
}
/* Return true, if NODE is a member of TREE. */
static bool
-interval_tree_contains (struct itree_tree *tree, struct itree_node *node)
+itree_contains (struct itree_tree *tree, struct itree_node *node)
{
eassert (iter && node);
struct itree_node *other;
@@ -891,11 +891,11 @@ itree_limit_is_stable (struct itree_node *node)
}
static struct itree_node*
-interval_tree_subtree_min (uintmax_t otick, struct itree_node *node)
+itree_subtree_min (uintmax_t otick, struct itree_node *node)
{
if (node == NULL)
return node;
- while ((interval_tree_inherit_offset (otick, node),
+ while ((itree_inherit_offset (otick, node),
node->left != NULL))
node = node->left;
return node;
@@ -906,7 +906,7 @@ interval_tree_subtree_min (uintmax_t otick, struct
itree_node *node)
so re-balance the parents to re-establish the RB invariants. */
static void
-interval_tree_remove_fix (struct itree_tree *tree,
+itree_remove_fix (struct itree_tree *tree,
struct itree_node *node,
struct itree_node *parent)
{
@@ -927,7 +927,7 @@ interval_tree_remove_fix (struct itree_tree *tree,
{
other->red = false;
parent->red = true;
- interval_tree_rotate_left (tree, parent);
+ itree_rotate_left (tree, parent);
other = parent->right;
}
eassume (other != NULL);
@@ -946,13 +946,13 @@ interval_tree_remove_fix (struct itree_tree *tree,
{
other->left->red = false;
other->red = true;
- interval_tree_rotate_right (tree, other);
+ itree_rotate_right (tree, other);
other = parent->right;
}
other->red = parent->red; /* 4.a */
parent->red = false;
other->right->red = false;
- interval_tree_rotate_left (tree, parent);
+ itree_rotate_left (tree, parent);
node = tree->root;
parent = NULL;
}
@@ -965,7 +965,7 @@ interval_tree_remove_fix (struct itree_tree *tree,
{
other->red = false;
parent->red = true;
- interval_tree_rotate_right (tree, parent);
+ itree_rotate_right (tree, parent);
other = parent->left;
}
eassume (other != NULL);
@@ -984,14 +984,14 @@ interval_tree_remove_fix (struct itree_tree *tree,
{
other->right->red = false;
other->red = true;
- interval_tree_rotate_left (tree, other);
+ itree_rotate_left (tree, other);
other = parent->left;
}
other->red = parent->red; /* 4.b */
parent->red = false;
other->left->red = false;
- interval_tree_rotate_right (tree, parent);
+ itree_rotate_right (tree, parent);
node = tree->root;
parent = NULL;
}
@@ -1024,7 +1024,7 @@ itree_total_offset (struct itree_node *node)
unchanged. Caller is responsible for recalculation of `limit`.
Requires both nodes to be using the same effective `offset`. */
static void
-interval_tree_replace_child (struct itree_tree *tree,
+itree_replace_child (struct itree_tree *tree,
struct itree_node *source,
struct itree_node *dest)
{
@@ -1050,11 +1050,11 @@ interval_tree_replace_child (struct itree_tree *tree,
recalculation of `limit`. Requires both nodes to be using the same
effective `offset`. */
static void
-interval_tree_transplant (struct itree_tree *tree,
+itree_transplant (struct itree_tree *tree,
struct itree_node *source,
struct itree_node *dest)
{
- interval_tree_replace_child (tree, source, dest);
+ itree_replace_child (tree, source, dest);
source->left = dest->left;
if (source->left != NULL)
source->left->parent = source;
@@ -1069,17 +1069,17 @@ interval_tree_transplant (struct itree_tree *tree,
struct itree_node*
itree_remove (struct itree_tree *tree, struct itree_node *node)
{
- eassert (interval_tree_contains (tree, node));
+ eassert (itree_contains (tree, node));
eassert (check_tree (tree, true)); /* FIXME: Too expensive. */
/* Find `splice`, the leaf node to splice out of the tree. When
`node` has at most one child this is `node` itself. Otherwise,
it is the in order successor of `node`. */
- interval_tree_inherit_offset (tree->otick, node);
+ itree_inherit_offset (tree->otick, node);
struct itree_node *splice
= (node->left == NULL || node->right == NULL)
? node
- : interval_tree_subtree_min (tree->otick, node->right);
+ : itree_subtree_min (tree->otick, node->right);
/* Find `subtree`, the only child of `splice` (may be NULL). Note:
`subtree` will not be modified other than changing its parent to
@@ -1100,7 +1100,7 @@ itree_remove (struct itree_tree *tree, struct itree_node
*node)
`splice` is black, this creates a red-red violation, so remember
this now as the field can be overwritten when splice is
transplanted below. */
- interval_tree_replace_child (tree, subtree, splice);
+ itree_replace_child (tree, subtree, splice);
bool removed_black = !splice->red;
/* Replace `node` with `splice` in the tree and propagate limit
@@ -1109,18 +1109,18 @@ itree_remove (struct itree_tree *tree, struct
itree_node *node)
has a new child. */
if (splice != node)
{
- interval_tree_transplant (tree, splice, node);
- interval_tree_propagate_limit (subtree_parent);
+ itree_transplant (tree, splice, node);
+ itree_propagate_limit (subtree_parent);
if (splice != subtree_parent)
- interval_tree_update_limit (splice);
+ itree_update_limit (splice);
}
- interval_tree_propagate_limit (splice->parent);
+ itree_propagate_limit (splice->parent);
--tree->size;
/* Fix any black height violation caused by removing a black node. */
if (removed_black)
- interval_tree_remove_fix (tree, subtree, subtree_parent);
+ itree_remove_fix (tree, subtree, subtree_parent);
eassert ((tree->size == 0) == (tree->root == NULL));
eassert (check_tree (tree, true)); /* FIXME: Too expensive. */
@@ -1164,14 +1164,14 @@ itree_iterator_start (struct itree_tree *tree,
ptrdiff_t begin,
iter->end = end;
iter->otick = tree->otick;
iter->order = order;
- interval_stack_clear (iter->stack);
+ itree_stack_clear (iter->stack);
if (begin <= end && tree->root != NULL)
- interval_stack_push_flagged (iter->stack, tree->root, false);
+ itree_stack_push_flagged (iter->stack, tree->root, false);
iter->file = file;
iter->line = line;
iter->running = true;
- /* interval_stack_ensure_space (iter->stack,
- 2 * interval_tree_max_height (tree)); */
+ /* itree_stack_ensure_space (iter->stack,
+ 2 * itree_max_height (tree)); */
return iter;
}
@@ -1210,7 +1210,7 @@ itree_insert_gap (struct itree_tree *tree,
order, so we need to remove them first. This doesn't apply for
`before_markers` since in that case, all positions move identically
regardless of `front_advance` or `rear_advance`. */
- struct interval_stack *saved = interval_stack_create (0);
+ struct itree_stack *saved = itree_stack_create (0);
struct itree_node *node = NULL;
if (!before_markers)
{
@@ -1221,7 +1221,7 @@ itree_insert_gap (struct itree_tree *tree,
the overlay is empty, make sure we don't move
begin past end by pretending it's !front_advance. */
&& (node->begin != node->end || node->rear_advance))
- interval_stack_push (saved, node);
+ itree_stack_push (saved, node);
}
}
for (size_t i = 0; i < saved->length; ++i)
@@ -1231,15 +1231,15 @@ itree_insert_gap (struct itree_tree *tree,
narrow AND shift some subtree at the same time. */
if (tree->root != NULL)
{
- const int size = interval_tree_max_height (tree) + 1;
- struct interval_stack *stack = interval_stack_create (size);
- interval_stack_push (stack, tree->root);
+ const int size = itree_max_height (tree) + 1;
+ struct itree_stack *stack = itree_stack_create (size);
+ itree_stack_push (stack, tree->root);
nodeptr_and_flag nav;
- while ((nav = interval_stack_pop (stack),
+ while ((nav = itree_stack_pop (stack),
node = nav_nodeptr (nav)))
{
/* Process in pre-order. */
- interval_tree_inherit_offset (tree->otick, node);
+ itree_inherit_offset (tree->otick, node);
if (pos > node->limit)
continue;
if (node->right != NULL)
@@ -1251,10 +1251,10 @@ itree_insert_gap (struct itree_tree *tree,
++tree->otick;
}
else
- interval_stack_push (stack, node->right);
+ itree_stack_push (stack, node->right);
}
if (node->left != NULL)
- interval_stack_push (stack, node->left);
+ itree_stack_push (stack, node->left);
if (before_markers
? node->begin >= pos
@@ -1265,16 +1265,16 @@ itree_insert_gap (struct itree_tree *tree,
{
node->end += length;
eassert (node != NULL);
- interval_tree_propagate_limit (node);
+ itree_propagate_limit (node);
}
}
- interval_stack_destroy (stack);
+ itree_stack_destroy (stack);
}
/* Reinsert nodes starting at POS having front-advance. */
uintmax_t notick = tree->otick;
nodeptr_and_flag nav;
- while ((nav = interval_stack_pop (saved),
+ while ((nav = itree_stack_pop (saved),
node = nav_nodeptr (nav)))
{
eassert (node->otick == ootick);
@@ -1283,10 +1283,10 @@ itree_insert_gap (struct itree_tree *tree,
node->begin += length;
node->end += length;
node->otick = notick;
- interval_tree_insert (tree, node);
+ itree_insert_node (tree, node);
}
- interval_stack_destroy (saved);
+ itree_stack_destroy (saved);
}
/* Delete a gap at POS of length LENGTH, contracting all intervals
@@ -1303,16 +1303,16 @@ itree_delete_gap (struct itree_tree *tree,
/* Can't use the iterator here, because by decrementing begin, we
might unintentionally bring shifted nodes back into our search space. */
- const int size = interval_tree_max_height (tree) + 1;
- struct interval_stack *stack = interval_stack_create (size);
+ const int size = itree_max_height (tree) + 1;
+ struct itree_stack *stack = itree_stack_create (size);
struct itree_node *node;
- interval_stack_push (stack, tree->root);
+ itree_stack_push (stack, tree->root);
nodeptr_and_flag nav;
- while ((nav = interval_stack_pop (stack)))
+ while ((nav = itree_stack_pop (stack)))
{
node = nav_nodeptr (nav);
- interval_tree_inherit_offset (tree->otick, node);
+ itree_inherit_offset (tree->otick, node);
if (pos > node->limit)
continue;
if (node->right != NULL)
@@ -1324,10 +1324,10 @@ itree_delete_gap (struct itree_tree *tree,
++tree->otick;
}
else
- interval_stack_push (stack, node->right);
+ itree_stack_push (stack, node->right);
}
if (node->left != NULL)
- interval_stack_push (stack, node->left);
+ itree_stack_push (stack, node->left);
if (pos < node->begin)
node->begin = max (pos, node->begin - length);
@@ -1335,10 +1335,10 @@ itree_delete_gap (struct itree_tree *tree,
{
node->end = max (pos , node->end - length);
eassert (node != NULL);
- interval_tree_propagate_limit (node);
+ itree_propagate_limit (node);
}
}
- interval_stack_destroy (stack);
+ itree_stack_destroy (stack);
}
@@ -1356,7 +1356,7 @@ itree_delete_gap (struct itree_tree *tree,
a NODE2 strictly bigger than NODE1 should also be included). */
static inline bool
-interval_node_intersects (const struct itree_node *node,
+itree_node_intersects (const struct itree_node *node,
ptrdiff_t begin, ptrdiff_t end)
{
return (begin < node->end && node->begin < end)
@@ -1388,7 +1388,7 @@ itree_iterator_next (struct itree_iterator *g)
{
nodeptr_and_flag nav;
bool visited;
- while ((nav = interval_stack_pop (g->stack),
+ while ((nav = itree_stack_pop (g->stack),
node = nav_nodeptr (nav),
visited = nav_flag (nav),
node && !visited))
@@ -1396,40 +1396,40 @@ itree_iterator_next (struct itree_iterator *g)
struct itree_node *const left = node->left;
struct itree_node *const right = node->right;
- interval_tree_inherit_offset (g->otick, node);
+ itree_inherit_offset (g->otick, node);
eassert (itree_limit_is_stable (node));
switch (g->order)
{
case ITREE_ASCENDING:
if (right != null && node->begin <= g->end)
- interval_stack_push_flagged (g->stack, right, false);
- if (interval_node_intersects (node, g->begin, g->end))
- interval_stack_push_flagged (g->stack, node, true);
+ itree_stack_push_flagged (g->stack, right, false);
+ if (itree_node_intersects (node, g->begin, g->end))
+ itree_stack_push_flagged (g->stack, node, true);
/* Node's children may still be off-set and we need to add it. */
if (left != null && g->begin <= left->limit + left->offset)
- interval_stack_push_flagged (g->stack, left, false);
+ itree_stack_push_flagged (g->stack, left, false);
break;
case ITREE_DESCENDING:
if (left != null && g->begin <= left->limit + left->offset)
- interval_stack_push_flagged (g->stack, left, false);
- if (interval_node_intersects (node, g->begin, g->end))
- interval_stack_push_flagged (g->stack, node, true);
+ itree_stack_push_flagged (g->stack, left, false);
+ if (itree_node_intersects (node, g->begin, g->end))
+ itree_stack_push_flagged (g->stack, node, true);
if (right != null && node->begin <= g->end)
- interval_stack_push_flagged (g->stack, right, false);
+ itree_stack_push_flagged (g->stack, right, false);
break;
case ITREE_PRE_ORDER:
if (right != null && node->begin <= g->end)
- interval_stack_push_flagged (g->stack, right, false);
+ itree_stack_push_flagged (g->stack, right, false);
if (left != null && g->begin <= left->limit + left->offset)
- interval_stack_push_flagged (g->stack, left, false);
- if (interval_node_intersects (node, g->begin, g->end))
- interval_stack_push_flagged (g->stack, node, true);
+ itree_stack_push_flagged (g->stack, left, false);
+ if (itree_node_intersects (node, g->begin, g->end))
+ itree_stack_push_flagged (g->stack, node, true);
break;
}
}
/* Node may have been invalidated by itree_iterator_narrow
after it was pushed: Check if it still intersects. */
- } while (node && ! interval_node_intersects (node, g->begin, g->end));
+ } while (node && ! itree_node_intersects (node, g->begin, g->end));
return node;
}
diff --git a/src/nsfns.m b/src/nsfns.m
index 2699cf37a5..d793bcf13f 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -632,10 +632,19 @@ ns_set_menu_bar_lines (struct frame *f, Lisp_Object
value, Lisp_Object oldval)
void
ns_change_tab_bar_height (struct frame *f, int height)
{
- int unit = FRAME_LINE_HEIGHT (f);
- int old_height = FRAME_TAB_BAR_HEIGHT (f);
- int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ int unit, old_height, lines;
+ Lisp_Object fullscreen;
+
+ unit = FRAME_LINE_HEIGHT (f);
+ old_height = FRAME_TAB_BAR_HEIGHT (f);
+ fullscreen = get_frame_param (f, Qfullscreen);
+
+ /* This differs from the tool bar code in that the tab bar height is
+ not rounded up. Otherwise, if redisplay_tab_bar decides to grow
+ the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed,
+ leading to the tab bar height being incorrectly set upon the next
+ call to x_set_font. (bug#59285) */
+ lines = height / unit;
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
diff --git a/src/pgtkfns.c b/src/pgtkfns.c
index 9473e14f5c..f370f03978 100644
--- a/src/pgtkfns.c
+++ b/src/pgtkfns.c
@@ -473,10 +473,19 @@ pgtk_set_tab_bar_lines (struct frame *f, Lisp_Object
value, Lisp_Object oldval)
void
pgtk_change_tab_bar_height (struct frame *f, int height)
{
- int unit = FRAME_LINE_HEIGHT (f);
- int old_height = FRAME_TAB_BAR_HEIGHT (f);
- int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ int unit, old_height, lines;
+ Lisp_Object fullscreen;
+
+ unit = FRAME_LINE_HEIGHT (f);
+ old_height = FRAME_TAB_BAR_HEIGHT (f);
+ fullscreen = get_frame_param (f, Qfullscreen);
+
+ /* This differs from the tool bar code in that the tab bar height is
+ not rounded up. Otherwise, if redisplay_tab_bar decides to grow
+ the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed,
+ leading to the tab bar height being incorrectly set upon the next
+ call to x_set_font. (bug#59285) */
+ lines = height / unit;
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
diff --git a/src/w32fns.c b/src/w32fns.c
index c7eddcba6d..e441665804 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -1717,10 +1717,19 @@ w32_set_tab_bar_lines (struct frame *f, Lisp_Object
value, Lisp_Object oldval)
void
w32_change_tab_bar_height (struct frame *f, int height)
{
- int unit = FRAME_LINE_HEIGHT (f);
- int old_height = FRAME_TAB_BAR_HEIGHT (f);
- int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ int unit, old_height, lines;
+ Lisp_Object fullscreen;
+
+ unit = FRAME_LINE_HEIGHT (f);
+ old_height = FRAME_TAB_BAR_HEIGHT (f);
+ fullscreen = get_frame_param (f, Qfullscreen);
+
+ /* This differs from the tool bar code in that the tab bar height is
+ not rounded up. Otherwise, if redisplay_tab_bar decides to grow
+ the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed,
+ leading to the tab bar height being incorrectly set upon the next
+ call to x_set_font. (bug#59285) */
+ lines = height / unit;
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
diff --git a/src/xfns.c b/src/xfns.c
index 3ff7a8c286..8ee26d713a 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1750,10 +1750,19 @@ x_set_tab_bar_lines (struct frame *f, Lisp_Object
value, Lisp_Object oldval)
void
x_change_tab_bar_height (struct frame *f, int height)
{
- int unit = FRAME_LINE_HEIGHT (f);
- int old_height = FRAME_TAB_BAR_HEIGHT (f);
- int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ int unit, old_height, lines;
+ Lisp_Object fullscreen;
+
+ unit = FRAME_LINE_HEIGHT (f);
+ old_height = FRAME_TAB_BAR_HEIGHT (f);
+ fullscreen = get_frame_param (f, Qfullscreen);
+
+ /* This differs from the tool bar code in that the tab bar height is
+ not rounded up. Otherwise, if redisplay_tab_bar decides to grow
+ the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed,
+ leading to the tab bar height being incorrectly set upon the next
+ call to x_set_font. (bug#59285) */
+ lines = height / unit;
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
@@ -4506,9 +4515,11 @@ x_default_font_parameter (struct frame *f, Lisp_Object
parms)
}
if (NILP (font))
- font = !NILP (font_param) ? font_param
- : gui_display_get_arg (dpyinfo, parms, Qfont, "font", "Font",
- RES_TYPE_STRING);
+ font = (!NILP (font_param)
+ ? font_param
+ : gui_display_get_arg (dpyinfo, parms,
+ Qfont, "font", "Font",
+ RES_TYPE_STRING));
if (! FONTP (font) && ! STRINGP (font))
{
diff --git a/src/xsettings.c b/src/xsettings.c
index 15e7ff5499..1a9f1a8d5a 100644
--- a/src/xsettings.c
+++ b/src/xsettings.c
@@ -56,6 +56,7 @@ typedef unsigned int CARD32;
#ifdef USE_CAIRO
#include <fontconfig/fontconfig.h>
+#include "ftfont.h"
#elif defined HAVE_XFT
#include <X11/Xft/Xft.h>
#endif
@@ -826,6 +827,7 @@ apply_xft_settings (Display_Info *dpyinfo,
#else
FcConfigSubstitute (NULL, pat, FcMatchPattern);
options = cairo_font_options_create ();
+ ftcrfont_get_default_font_options (dpyinfo, options);
cairo_ft_font_options_substitute (options, pat);
cairo_font_options_destroy (options);
FcDefaultSubstitute (pat);
diff --git a/src/xterm.c b/src/xterm.c
index 7a1fd6086c..55252d2201 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -1134,6 +1134,7 @@ static void x_clean_failable_requests (struct
x_display_info *);
static struct frame *x_tooltip_window_to_frame (struct x_display_info *,
Window, bool *);
static Window x_get_window_below (Display *, Window, int, int, int *, int *);
+static void x_set_input_focus (struct x_display_info *, Window, Time);
#ifndef USE_TOOLKIT_SCROLL_BARS
static void x_scroll_bar_redraw (struct scroll_bar *);
@@ -27535,11 +27536,10 @@ x_ewmh_activate_frame (struct frame *f)
{
time = x_get_server_time (f);
- x_ignore_errors_for_next_request (dpyinfo);
- XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
- RevertToParent, time);
+ x_set_input_focus (FRAME_DISPLAY_INFO (f),
+ FRAME_OUTER_WINDOW (f),
+ time);
XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f));
- x_stop_ignoring_errors (dpyinfo);
return;
}
@@ -27584,6 +27584,57 @@ x_get_toplevel_parent (struct frame *f)
return parent;
}
+static void
+x_set_input_focus (struct x_display_info *dpyinfo, Window window,
+ Time time)
+{
+#ifdef HAVE_XINPUT2
+ struct xi_device_t *device;
+#endif
+
+ /* Do the equivalent of XSetInputFocus with the specified window and
+ time, but use the attachment to the device that Emacs has
+ designated the client pointer on X Input Extension builds.
+ Asynchronously trap errors around the generated XI_SetFocus or
+ SetInputFocus request, in case the device has been destroyed or
+ the window obscured.
+
+ The revert_to will be set to RevertToParent for generated
+ SetInputFocus requests. */
+
+#ifdef HAVE_XINPUT2
+ if (dpyinfo->supports_xi2
+ && dpyinfo->client_pointer_device != -1)
+ {
+ device = xi_device_from_id (dpyinfo, dpyinfo->client_pointer_device);
+
+ /* The device is a master pointer. Use its attachment, which
+ should be the master keyboard. */
+
+ if (device)
+ {
+ eassert (device->use == XIMasterPointer);
+
+ x_ignore_errors_for_next_request (dpyinfo);
+ XISetFocus (dpyinfo->display, device->attachment,
+ /* Note that the input extension
+ only supports RevertToParent-type
+ behavior. */
+ window, time);
+ x_stop_ignoring_errors (dpyinfo);
+
+ return;
+ }
+ }
+#endif
+
+ /* Otherwise, use the pointer device that the X server says is the
+ client pointer. */
+ x_ignore_errors_for_next_request (dpyinfo);
+ XSetInputFocus (dpyinfo->display, window, RevertToParent, time);
+ x_stop_ignoring_errors (dpyinfo);
+}
+
/* In certain situations, when the window manager follows a
click-to-focus policy, there seems to be no way around calling
XSetInputFocus to give another frame the input focus.
@@ -27632,8 +27683,6 @@ x_focus_frame (struct frame *f, bool noactivate)
return;
}
- /* Ignore any BadMatch error this request might result in. */
- x_ignore_errors_for_next_request (dpyinfo);
if (NILP (Vx_no_window_manager))
{
/* Use the last user time. It is invalid to use CurrentTime
@@ -27651,15 +27700,19 @@ x_focus_frame (struct frame *f, bool noactivate)
&& !dpyinfo->x_focus_frame)
time = x_get_server_time (f);
- XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
- RevertToParent, time);
+ /* Ignore any BadMatch error this request might result in.
+ A BadMatch error can occur if the window was obscured
+ after the time of the last user interaction without
+ changing the last-focus-change-time. */
+ x_set_input_focus (FRAME_DISPLAY_INFO (f), FRAME_OUTER_WINDOW (f),
+ time);
}
else
- XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
- /* But when no window manager is in use, we
- don't care. */
- RevertToParent, CurrentTime);
- x_stop_ignoring_errors (dpyinfo);
+ x_set_input_focus (FRAME_DISPLAY_INFO (f), FRAME_OUTER_WINDOW (f),
+ /* But when no window manager is in use,
+ respecting the ICCCM doesn't really
+ matter. */
+ CurrentTime);
}
}
diff --git a/src/xterm.h b/src/xterm.h
index 1124dcceb4..b6ab42e72d 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -1615,7 +1615,7 @@ extern void x_real_pos_and_offsets (struct frame *f,
int *xptr,
int *yptr,
int *outer_border);
-extern void x_default_font_parameter (struct frame* f, Lisp_Object parms);
+extern void x_default_font_parameter (struct frame *, Lisp_Object);
/* From xrdb.c. */
diff --git a/test/lisp/auth-source-pass-tests.el
b/test/lisp/auth-source-pass-tests.el
index f5147a7ce0..8bcb2739bb 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -25,7 +25,7 @@
;;; Code:
-(require 'ert)
+(require 'ert-x)
(require 'auth-source-pass)
@@ -466,7 +466,10 @@ HOSTNAME, USER and PORT are passed unchanged to
(ert-deftest auth-source-pass-can-start-from-auth-source-search ()
(auth-source-pass--with-store '(("gitlab.com" ("user" . "someone")))
(auth-source-pass-enable)
- (let ((result (car (auth-source-search :host "gitlab.com"))))
+ ;; This also asserts an aspect of traditional search behavior
+ ;; relative to `auth-source-pass-extra-query-keywords'.
+ (let* ((auth-source-pass-extra-query-keywords nil)
+ (result (car (auth-source-search :host "gitlab.com"))))
(should (equal (plist-get result :user) "someone"))
(should (equal (plist-get result :host) "gitlab.com")))))
@@ -488,6 +491,266 @@ HOSTNAME, USER and PORT are passed unchanged to
(should (auth-source-pass--have-message-matching
"found 2 entries matching \"gitlab.com\": (\"a/gitlab.com\"
\"b/gitlab.com\")"))))
+
+;;;; Option `auth-source-pass-extra-query-keywords' (bug#58985)
+
+;; No entry has the requested port, but a result is still returned.
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss-netrc ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine x.com password a
+machine x.com port 42 password b
+"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search :host "x.com" :port 22 :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "x.com" :secret "a")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss ()
+ (auth-source-pass--with-store '(("x.com" (secret . "a"))
+ ("x.com:42" (secret . "b")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "x.com" :port 22 :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "x.com" :secret "a")))))))
+
+;; One of two entries has the requested port, both returned.
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit-netrc ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine x.com password a
+machine x.com port 42 password b
+"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search :host "x.com" :port 42 :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "x.com" :secret "a")
+ (:host "x.com" :port "42" :secret "b")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit ()
+ (auth-source-pass--with-store '(("x.com" (secret . "a"))
+ ("x.com:42" (secret . "b")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "x.com" :port 42 :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "x.com" :secret "a")
+ (:host "x.com" :port 42 :secret "b")))))))
+
+;; No entry has the requested port, but :port is required, so search fails.
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine x.com password a
+machine x.com port 42 password b
+"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search
+ :host "x.com" :port 22 :require '(:port) :max 2)))
+ (should-not results))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss ()
+ (let ((auth-source-pass-extra-query-keywords t))
+ (auth-source-pass--with-store '(("x.com" (secret . "a"))
+ ("x.com:42" (secret . "b")))
+ (auth-source-pass-enable)
+ (should-not (auth-source-search
+ :host "x.com" :port 22 :require '(:port) :max 2)))))
+
+;; Specifying a :host without a :user finds a lone entry and does not
+;; include extra fields (i.e., :port nil) in the result.
+;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html
+
+(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine x.com password a
+machine disroot.org user akib password b
+machine z.com password c
+"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search :host "disroot.org" :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "disroot.org" :user "akib" :secret "b")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--akib ()
+ (auth-source-pass--with-store '(("x.com" (secret . "a"))
+ ("akib@disroot.org" (secret . "b"))
+ ("z.com" (secret . "c")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "disroot.org" :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "disroot.org" :user "akib" :secret "b")))))))
+
+;; Searches for :host are case-sensitive, and a returned host isn't
+;; normalized.
+
+(ert-deftest auth-source-pass-extra-query-keywords--netrc-host ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine libera.chat password a
+machine Libera.Chat password b
+"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search :host "Libera.Chat" :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "Libera.Chat" :secret "b")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--host ()
+ (auth-source-pass--with-store '(("libera.chat" (secret . "a"))
+ ("Libera.Chat" (secret . "b")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "Libera.Chat" :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "Libera.Chat" :secret "b")))))))
+
+
+;; A retrieved store entry mustn't be nil regardless of whether its
+;; path contains port or user components.
+
+(ert-deftest auth-source-pass-extra-query-keywords--baseline ()
+ (let ((auth-source-pass-extra-query-keywords t))
+ (auth-source-pass--with-store '(("x.com"))
+ (auth-source-pass-enable)
+ (should-not (auth-source-search :host "x.com")))))
+
+;; Output port type (int or string) matches that of input parameter.
+
+(ert-deftest auth-source-pass-extra-query-keywords--port-type ()
+ (let ((auth-source-pass-extra-query-keywords t)
+ (f (lambda (r) (setf (plist-get r :secret) (auth-info-password r)) r)))
+ (auth-source-pass--with-store '(("x.com:42" (secret . "a")))
+ (auth-source-pass-enable)
+ (should (equal (mapcar f (auth-source-search :host "x.com" :port 42))
+ '((:host "x.com" :port 42 :secret "a")))))
+ (auth-source-pass--with-store '(("x.com:42" (secret . "a")))
+ (auth-source-pass-enable)
+ (should (equal (mapcar f (auth-source-search :host "x.com" :port "42"))
+ '((:host "x.com" :port "42" :secret "a")))))))
+
+;; Match precision sometimes takes a back seat to the traversal
+;; ordering. Specifically, the :host (h1, ...) args hold greater sway
+;; over the output because they determine the first coordinate in the
+;; sequence of (host, user, port) combinations visited. (Taking a
+;; tree-wise view, these become the depth-1 nodes in a DFS.)
+
+;; Note that all trailing /user forms are demoted for the sake of
+;; predictability (see tests further below for details). This means
+;; that, in the following test, /bar is held in limbo, followed by
+;; /foo, but they both retain priority over "gnu.org", as noted above.
+
+(ert-deftest auth-source-pass-extra-query-keywords--hosts-first ()
+ (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a"))
+ ("gnu.org" (secret . "b"))
+ ("x.com" (secret . "c"))
+ ("fake.com" (secret . "d"))
+ ("x.com/foo" (secret . "e")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host '("x.com" "gnu.org") :max 3)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ ;; Notice gnu.org is never considered ^
+ '((:host "x.com" :secret "c")
+ (:host "x.com" :user "bar" :port "42" :secret "a")
+ (:host "x.com" :user "foo" :secret "e")))))))
+
+;; This is another example given in the bug thread.
+
+(ert-deftest auth-source-pass-extra-query-keywords--ambiguous-user-host ()
+ (auth-source-pass--with-store '(("foo.com/bar.org" (secret . "a"))
+ ("foo.com" (secret . "b"))
+ ("bar.org" (secret . "c"))
+ ("fake.com" (secret . "d")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "bar.org" :max 3)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "bar.org" :secret "c")))))))
+
+;; This conveys the same idea as `user-priorities', just below, but
+;; with slightly more realistic and less legible values.
+
+(ert-deftest auth-source-pass-extra-query-keywords--suffixed-user ()
+ (let ((store (sort (copy-sequence '(("x.com:42/bar" (secret . "a"))
+ ("bar@x.com" (secret . "b"))
+ ("x.com" (secret . "?"))
+ ("bar@y.org" (secret . "c"))
+ ("fake.com" (secret . "?"))
+ ("fake.com/bar" (secret . "d"))
+ ("y.org/bar" (secret . "?"))
+ ("bar@fake.com" (secret . "e"))))
+ (lambda (&rest _) (zerop (random 2))))))
+ (auth-source-pass--with-store store
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host '("x.com" "fake.com" "y.org")
+ :user "bar"
+ :require '(:user) :max 5)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "x.com" :user "bar" :secret "b")
+ (:host "x.com" :user "bar" :port "42" :secret "a")
+ (:host "fake.com" :user "bar" :secret "e")
+ (:host "fake.com" :user "bar" :secret "d")
+ (:host "y.org" :user "bar" :secret "c"))))))))
+
+;; This is a more distilled version of `suffixed-user', above. It
+;; better illustrates that search order takes precedence over "/user"
+;; demotion because otherwise * and ** would be swapped, below. It
+;; follows that omitting the :port 2, gets you {u@h:1, u@h:2, h:1/u,
+;; h:2/u, u@g:1}.
+
+(ert-deftest auth-source-pass-extra-query-keywords--user-priorities ()
+ (let ((store (sort (copy-sequence '(("h:1/u" (secret . "/"))
+ ("h:2/u" (secret . "/"))
+ ("u@h:1" (secret . "@"))
+ ("u@h:2" (secret . "@"))
+ ("g:1/u" (secret . "/"))
+ ("g:2/u" (secret . "/"))
+ ("u@g:1" (secret . "@"))
+ ("u@g:2" (secret . "@"))))
+ (lambda (&rest _) (zerop (random 2))))))
+ (auth-source-pass--with-store store
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host '("h" "g")
+ :port 2
+ :max 5)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "h" :user "u" :port 2 :secret "@")
+ (:host "h" :user "u" :port 2 :secret "/") ; *
+ (:host "g" :user "u" :port 2 :secret "@") ; **
+ (:host "g" :user "u" :port 2 :secret "/"))))))))
+
(provide 'auth-source-pass-tests)
;;; auth-source-pass-tests.el ends here
diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el
index 8645d7f104..74cbb7d947 100644
--- a/test/lisp/erc/erc-dcc-tests.el
+++ b/test/lisp/erc/erc-dcc-tests.el
@@ -167,7 +167,8 @@
(defun erc-dcc-tests--pcomplete-common (test-fn)
(with-current-buffer (get-buffer-create "*erc-dcc-do-GET-command*")
- (let* ((proc (start-process "fake" (current-buffer) "sleep" "10"))
+ (let* ((inhibit-message noninteractive)
+ (proc (start-process "fake" (current-buffer) "sleep" "10"))
(elt (list :nick "tester!~tester@fake.irc"
:type 'GET
:peer nil
diff --git a/test/lisp/erc/erc-networks-tests.el
b/test/lisp/erc/erc-networks-tests.el
index 32bdfa11ff..fc12bf7ce3 100644
--- a/test/lisp/erc/erc-networks-tests.el
+++ b/test/lisp/erc/erc-networks-tests.el
@@ -1704,4 +1704,21 @@
(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))))
+
;;; erc-networks-tests.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-reconnect.el
b/test/lisp/erc/erc-scenarios-base-reconnect.el
index 49298dc594..8762f33b30 100644
--- a/test/lisp/erc/erc-scenarios-base-reconnect.el
+++ b/test/lisp/erc/erc-scenarios-base-reconnect.el
@@ -224,4 +224,50 @@
(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-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 2 "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
diff --git a/test/lisp/erc/erc-scenarios-misc.el
b/test/lisp/erc/erc-scenarios-misc.el
index ded620ccc1..8557a77906 100644
--- a/test/lisp/erc/erc-scenarios-misc.el
+++ b/test/lisp/erc/erc-scenarios-misc.el
@@ -177,4 +177,32 @@
(erc-scenarios-common-say "Hi")
(funcall expect 10 "Hola")))))
+(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")))))
+
;;; erc-scenarios-misc.el ends here
diff --git a/test/lisp/erc/erc-services-tests.el
b/test/lisp/erc/erc-services-tests.el
index c22d4cf75e..7ff2e36e77 100644
--- a/test/lisp/erc/erc-services-tests.el
+++ b/test/lisp/erc/erc-services-tests.el
@@ -474,7 +474,6 @@
("GNU.chat:irc/#chan" (secret . "foo"))))
(ert-deftest erc--auth-source-search--pass-standard ()
- (ert-skip "Pass backend not yet supported")
(let ((store erc-join-tests--auth-source-pass-entries)
(auth-sources '(password-store))
(auth-source-do-cache nil))
@@ -487,7 +486,6 @@
(erc-services-tests--auth-source-standard #'erc-auth-source-search))))
(ert-deftest erc--auth-source-search--pass-announced ()
- (ert-skip "Pass backend not yet supported")
(let ((store erc-join-tests--auth-source-pass-entries)
(auth-sources '(password-store))
(auth-source-do-cache nil))
@@ -500,7 +498,6 @@
(erc-services-tests--auth-source-announced #'erc-auth-source-search))))
(ert-deftest erc--auth-source-search--pass-overrides ()
- (ert-skip "Pass backend not yet supported")
(let ((store
`(,@erc-join-tests--auth-source-pass-entries
("GNU.chat:6697/#chan" (secret . "spam"))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index c88dd9888d..a5100ec155 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -953,4 +953,229 @@
(kill-buffer "ExampleNet")
(kill-buffer "#chan")))
+(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-select-read-args ()
+
+ (ert-info ("Defaults to TLS")
+ (should (equal (ert-simulate-keys "\r\r\r\r"
+ (erc-select-read-args))
+ (list :server "irc.libera.chat"
+ :port 6697
+ :nick (user-login-name)
+ :password nil))))
+
+ (ert-info ("Override default TLS")
+ (should (equal (ert-simulate-keys "irc://irc.libera.chat\r\r\r\r"
+ (erc-select-read-args))
+ (list :server "irc.libera.chat"
+ :port 6667
+ :nick (user-login-name)
+ :password nil))))
+
+ (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"
+ :password nil))))
+
+ (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"
+ :password nil))))
+
+ (ert-info ("Addresss includes nick and password")
+ (should (equal (ert-simulate-keys "nick:sesame@localhost:6667\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)
+ :password nil))))
+
+ (ert-info ("IPv6 address with port")
+ (should (equal (ert-simulate-keys "[::1]:6667\r\r\r"
+ (erc-select-read-args))
+ (list :server "[::1]"
+ :port 6667
+ :nick (user-login-name)
+ :password nil))))
+
+ (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"
+ :password nil)))))
+
+(ert-deftest erc-tls ()
+ (let (calls)
+ (cl-letf (((symbol-function 'user-login-name)
+ (lambda (&optional _) "tester"))
+ ((symbol-function 'erc-open)
+ (lambda (&rest r) (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))))
+
+ (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))))
+
+ ;; 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)))))))
+
+(defun erc-tests--make-server-buf (name)
+ (with-current-buffer (get-buffer-create name)
+ (erc-mode)
+ (setq erc-server-process (start-process "sleep" (current-buffer)
+ "sleep" "1")
+ erc-session-server (concat "irc." name ".org")
+ erc-session-port 6667
+ erc-network (intern name))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (current-buffer)))
+
+(defun erc-tests--make-client-buf (server name)
+ (unless (bufferp server)
+ (setq server (get-buffer server)))
+ (with-current-buffer (get-buffer-create name)
+ (erc-mode)
+ (setq erc--target (erc--target-from-string name))
+ (dolist (v '(erc-server-process
+ erc-session-server
+ erc-session-port
+ erc-network))
+ (set v (buffer-local-value v server)))
+ (current-buffer)))
+
+(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--make-server-buf "foonet")
+ (setq rvbuf (current-buffer)))
+ (erc-tests--make-server-buf "barnet")
+ (erc-tests--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")
+ (erc-tests--make-client-buf "foonet" "#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--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
+ (kill-buffer "foonet")
+ (kill-buffer "barnet")
+ (kill-buffer "baznet")
+ (kill-buffer "#chan")))
+
;;; erc-tests.el ends here
diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el
b/test/lisp/erc/resources/erc-d/erc-d-tests.el
index a4befd96b5..8dd5cef7aa 100644
--- a/test/lisp/erc/resources/erc-d/erc-d-tests.el
+++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el
@@ -562,6 +562,7 @@ DUMB-SERVER-VAR are bound accordingly in BODY."
;;
(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"))
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el
b/test/lisp/erc/resources/erc-scenarios-common.el
index bc2cb68cd8..ef65125241 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -73,7 +73,7 @@
(require 'erc-d-t)
(require 'erc-d)))
-(require 'erc-backend)
+(require 'erc)
(eval-when-compile (require 'erc-join)
(require 'erc-services))
@@ -125,6 +125,7 @@
(erc-auth-source-parameters-join-function nil)
(erc-autojoin-channels-alist nil)
(erc-server-auto-reconnect nil)
+ (erc-after-connect nil)
(erc-d-linger-secs 10)
,@bindings)))
diff --git a/test/lisp/erc/resources/join/legacy/foonet.eld
b/test/lisp/erc/resources/join/legacy/foonet.eld
index 344ba7c1da..4025094a59 100644
--- a/test/lisp/erc/resources/join/legacy/foonet.eld
+++ b/test/lisp/erc/resources/join/legacy/foonet.eld
@@ -1,5 +1,5 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
+((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")
diff --git a/test/lisp/net/browse-url-tests.el
b/test/lisp/net/browse-url-tests.el
index 1c993958b8..dc81976821 100644
--- a/test/lisp/net/browse-url-tests.el
+++ b/test/lisp/net/browse-url-tests.el
@@ -56,6 +56,15 @@
'browse-url--man))
(should-not (browse-url-select-handler "man:ls" 'external)))
+(ert-deftest browse-url-tests-select-handler-irc ()
+ (should (eq (browse-url-select-handler "irc://localhost" 'internal)
+ 'browse-url--irc))
+ (should-not (browse-url-select-handler "irc://localhost" 'external))
+ (should (eq (browse-url-select-handler "irc6://localhost")
+ 'browse-url--irc))
+ (should (eq (browse-url-select-handler "ircs://tester@irc.gnu.org/#chan")
+ 'browse-url--irc)))
+
(ert-deftest browse-url-tests-select-handler-file ()
(should (eq (browse-url-select-handler "file://foo.txt")
'browse-url-emacs))
diff --git a/test/lisp/server-tests.el b/test/lisp/server-tests.el
new file mode 100644
index 0000000000..351b8ef8d1
--- /dev/null
+++ b/test/lisp/server-tests.el
@@ -0,0 +1,41 @@
+;;; server-tests.el --- Emacs server test suite -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 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)
+(require 'server)
+
+;;; Tests:
+
+(ert-deftest server-test/server-start-sets-minor-mode ()
+ "Ensure that calling `server-start' also sets `server-mode' properly."
+ (server-start)
+ (unwind-protect
+ (progn
+ ;; Make sure starting the server activates the minor mode.
+ (should (eq server-mode t))
+ (should (memq 'server-mode global-minor-modes)))
+ ;; Always stop the server, even if the above checks fail.
+ (server-start t))
+ ;; Make sure stopping the server deactivates the minor mode.
+ (should (eq server-mode nil))
+ (should-not (memq 'server-mode global-minor-modes)))
+
+;;; server-tests.el ends here
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 3fc52eaf8b..0e6d717cbb 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -42,7 +42,6 @@ recorded calls conveniently."
overlay
hooks-property
(list (lambda (ov &rest args)
- (message " %S called on %S with args %S" hooks-property ov args)
(should inhibit-modification-hooks)
(should (eq ov overlay))
(push (list hooks-property args)
@@ -175,47 +174,41 @@ properties."
(t 1 2 0))
(insert-behind-hooks
(t 1 2 0)))))))
- (message "BEGIN overlay-modification-hooks test-case %S" test-case)
-
- ;; All three hooks ignore the overlay's `front-advance' and
- ;; `rear-advance' option, so test both ways while expecting the same
- ;; result.
- (dolist (advance '(nil t))
- (message " advance is %S" advance)
- (let-alist test-case
- (with-temp-buffer
- ;; Set up the temporary buffer and overlay as specified by
- ;; the test case.
- (insert (or .buffer-text "1234"))
- (let ((overlay (make-overlay
- (or .overlay-beg 2)
- (or .overlay-end 4)
- nil
- advance advance)))
- (message " (buffer-string) is %S" (buffer-string))
- (message " overlay is %S" overlay)
- (overlay-tests-start-recording-modification-hooks overlay)
-
- ;; Modify the buffer, possibly inducing calls to the
- ;; overlay's modification hooks.
- (should (or .insert-at .replace))
- (when .insert-at
- (goto-char .insert-at)
- (insert "x")
- (message " inserted \"x\" at %S, buffer-string now %S"
- .insert-at (buffer-string)))
- (when .replace
- (goto-char (point-min))
- (search-forward .replace)
- (replace-match "x")
- (message " replaced %S with \"x\"" .replace))
-
- ;; Verify that the expected and actual modification hook
- ;; calls match.
- (should (equal
- .expected-calls
- (overlay-tests-get-recorded-modification-hooks
- overlay)))))))))
+ (ert-info ((format "test-case: %S" test-case))
+ ;; All three hooks ignore the overlay's `front-advance' and
+ ;; `rear-advance' option, so test both ways while expecting the same
+ ;; result.
+ (dolist (advance '(nil t))
+ (ert-info ((format "advance is %S" advance))
+ (let-alist test-case
+ (with-temp-buffer
+ ;; Set up the temporary buffer and overlay as specified by
+ ;; the test case.
+ (insert (or .buffer-text "1234"))
+ (let ((overlay (make-overlay
+ (or .overlay-beg 2)
+ (or .overlay-end 4)
+ nil
+ advance advance)))
+ (overlay-tests-start-recording-modification-hooks overlay)
+
+ ;; Modify the buffer, possibly inducing calls to the
+ ;; overlay's modification hooks.
+ (should (or .insert-at .replace))
+ (when .insert-at
+ (goto-char .insert-at)
+ (insert "x"))
+ (when .replace
+ (goto-char (point-min))
+ (search-forward .replace)
+ (replace-match "x"))
+
+ ;; Verify that the expected and actual modification hook
+ ;; calls match.
+ (should (equal
+ .expected-calls
+ (overlay-tests-get-recorded-modification-hooks
+ overlay)))))))))))
(ert-deftest overlay-modification-hooks-message-other-buf ()
"Test for bug#21824.
@@ -8429,7 +8422,7 @@ Finally, kill the buffer and its temporary file."
(insert "foo\n")
(should buffer-auto-save-file-name)
(setq auto-save buffer-auto-save-file-name)
- (do-auto-save)
+ (do-auto-save t)
(should (file-exists-p auto-save))
(kill-buffer (current-buffer))
(should (file-exists-p auto-save)))))))
@@ -8444,7 +8437,7 @@ Finally, kill the buffer and its temporary file."
(insert "foo\n")
(should buffer-auto-save-file-name)
(setq auto-save buffer-auto-save-file-name)
- (do-auto-save)
+ (do-auto-save t)
(should (file-exists-p auto-save))
;; This should delete the auto-save file.
(kill-buffer (current-buffer))
@@ -8460,7 +8453,7 @@ Finally, kill the buffer and its temporary file."
(insert "foo\n")
(should buffer-auto-save-file-name)
(setq auto-save buffer-auto-save-file-name)
- (do-auto-save)
+ (do-auto-save t)
(should (file-exists-p auto-save))
;; This should not delete the auto-save file.
(kill-buffer (current-buffer))
@@ -8475,7 +8468,7 @@ Finally, kill the buffer and its temporary file."
(insert "foo")
(should (buffer-modified-p))
(should-not (eq (buffer-modified-p) 'autosaved))
- (do-auto-save nil t)
+ (do-auto-save t t)
(should (eq (buffer-modified-p) 'autosaved))
(with-silent-modifications
(put-text-property 1 3 'face 'bold))
@@ -8499,7 +8492,7 @@ Finally, kill the buffer and its temporary file."
(restore-buffer-modified-p nil)
(should-not (buffer-modified-p))
(insert "bar")
- (do-auto-save nil t)
+ (do-auto-save t t)
(should (eq (buffer-modified-p) 'autosaved))
(insert "zot")
(restore-buffer-modified-p 'autosaved)